A Web app. that creates Haskel computations from user questions, that store, retrieve and execute them? It´s easy

I have a very strong requirement for my Web application: The user must create haskell procedures by means of web page formularies. The procedures must be created from the menu resposes. They must be stored in pesisten storage , retrieved and executed later when the user need it.

Of course I dont want to permit the creation of arbitrary computations, but to constrain the user freedon trough a web navigation with a restricted set of options. Tha´s because the user is not a programmer and because the created computation is domain specific.

This is one of tme most complex requirements I may think of for an interactive application. To do so I need:

• To create a DSL
• An interpreter of the DSL
• A serializer and deserializer of the DSL
• A set of Web forms 
• And a logic that maps the Web navigation with the options  of the DSL 

What if I say that I can do it all in a single procedure, with the addition that the generated computation will run at compiled speeds? That would be magic, but this is the power of monads. Actually, the DSL, the interpreter, the serializer-deserializer and the set of menus have the same sematic, with the same set of repetitions, conditionals and sequences. Why not define this abstract semantics  in a independent way and left the details for whatever needed to the underlying monads that navigate the arrows of this semantic definition? Once defined this navigation, you "only" need a monad that ask to the user, store the response, retrieve it and interpret it to assemble the different steps to generate the resulting computation.

This approach has been proved to work fine in the example of an applicative serializer-deserializer that I presented in my previous post (see below "parseLets")

The Workflow monad transformer brings automatic serlialization and deserialization of the intermediate results of a computation. If I store the user answers to a set of interactive menus, I can return a function made with the responses of these menus. But I don´t want to ask the user everytime, I want to store the responses and return the function with these stored responses when they are stored, and ask for them when they are not.

But that is what Workflow does. An already executed workflow , when  re-executed, will ever return the same final result, composed with the stored intermediate results.

For example, this program will ask your name the first time that it is executed. The rest of the executions it will say hello to you and exit (unless the log is deleted)

module Main where import Control.Workflow main = getName >>= putStrLn getName= exec1nc "test" $ do name <- step $ do putStrLn "your name?" getLine return $ "hello " ++ name

>runghc hello
your name?
Alberto
hello Alberto

>runghc hello
hello Alberto

>runghc hello
hello Alberto

The magic is in the step monad transformer in getName , that stores the getLine response. When it is executed for a second time,  step will read the response from the storage instead of asking again, so getName will do nothing but to return the "hello yourname" string 

This is is the log of execution of getName located at ./TCacheData/Workflow/Stat/test/void :

83 2 [ "() " , "\"Alberto\" " ] Stat "test/void" 2 ( Nothing ) 0

There are other intruder here: exec1nc  (line 6) is the command that execute the workflow. This variant does not delete the log upon finalization neither deletes the workflow from the list of active workflows. That is what we need, because the workflow scheduler will find this procedure unfinished and will   recover its execution state. because everything has been executed already, exec1nc just return the result. 

The first parameter of exec1nc is an identifier for the workflow in persistent storage.

MFlow is a library that add web interfaces to workflows. Well, actually MFlow it is a Web application server that run stateful server procedures, that may or may not be in the workflow monad and offers a set of user-interface combinators that produce type safe responses. Because an MFlow process can be stateful and persistent,  we can ask to the user, in a web browser, a set of questions  in a single computation.

Here below is a complete menu-driven definition of a simple function. Just install MFlow from hackage, runghc the program and in the browser go to http://localhost.

Almost all of a MFlow procedure is problem specific. There is very little plumbing, so  I´m sure that you will get it:

{-# OPTIONS -XDeriveDataTypeable #-} module Main where import Data.Typeable import MFlow.Wai.XHtml.All import Control.Concurrent main= do addMessageFlows [("",runFlow ops)] forkIO $ run 80 waiMessageFlow adminLoop ops= do i <- ask $ p << ("Enter a number. This number will be the parameter for a function\n" ++ "that will be defined by menu if it has not been defined previously") ++> getInt Nothing f <- runFlowIn "fun" getf ask $ p << ("The result is: " ++ show (f i)) ++> wlink () (bold << "next") ops where getf = do op <- step . ask $ p << "let define the function: which operation?" ++> getSelect( setOption Plus (bold << "+") <|> setOption Times (bold << "*")) <** submitButton "submit" num <- step . ask $ p << "give me another number" ++> getInt Nothing return $ case op of Plus -> (+ num) Times -> (* num) data Ops= Plus | Times deriving (Read, Show, Typeable)

In the line 18. runFlowIn is the equivalent of exec1nd for web flows. The flow getf ask for a binary operation (either + or *) in the lines 26-27. After that it ask for a number (line 30). It returns a function with a single argument, either ( + num) or (* num) .

Once the dialogs of getf are executed, the user will not be asked again, even if you stop and restart the program.  So in successive executions, the program will just ask for a number (line 14) and will show the result of the application of the function (line 20).

The function returned is not interpreted, it is "compiled" by the MFlow process

It is easy to see that any kind of expression can be defined with the appropriate web form navigation.

And now, what kind of computations my aplication must compose by web menus?  They are workflows in the workflow monad! So my flows will create workflows. There is no problem with this, since this approach could be used to compose not just functions but any monadic computation.

ANNOUNCE MFlow 0.1.5 Web app server for stateful processes with safe, composable user interfaces.

http://hackage.haskell.org/package/MFlow-0.1.5.3

MFlow is a is a Web framework with some unique, and I mean unique,characteristics that I find exciting:

- It is a Web application server that start and restart on-demand stateful web server processes (not request.-response). This means that all the page navigation can be coded in a single procedure. This increases readability of the programmer code. I woul call it a anti-node.js.  Buit usual request-response (stateless) server processes are also allowed

- When the process is invoqued as result of an URL request, the Web app server not only restart the process but also recover its execution state. The enclosing Workflow monad provides the thread state persistence. There are state timeouts and process timeouts defined by the programmer. Processes with no persistent state (transient) are possible.

- The user interface is made of widgets. They are  formlets with added formatting,   attributes, validations, modifiers and callbacks, that are composable, so the pieces are reusable and return type safe responses to the calling process. Even the links are part of widgets and return back type safe inputs at compile time to the calling server process. Tho glue these components, ordinary applicative combinators and other extra combinators are used.

- The widgets and the communication don´t make assumptions about the architecture, so it can be adapted to non-web environments. This versions has interface for WAI-warp, Hack, Text.XHtml (xhtml) , and Haskell Server Pages.

- The widget rendering can be converted to ByteStrings automatically with special combinators. A mix of widgets with different formats can be combined in the same source file. For example Text.Html and HSP (Haskell server pages)

-These widgets can be cached, to avoid widget rendering on every interaction.

-To handle the back button in web browsers, and because the processes are stateful, they can run backwards until the response match. This is transparent for the programmer, thanks to the embedded FlowM monad.

-All the programmer coding in pure Haskell. No deployment, special scripts, formats etc are necessary.

-Besides automatic state persistence, TCache provides transactions and user data persistence, that can be configured for SQL databases. Default persistence in files permit very rapid prototyping. Just code and run it with runghc.

-Has AJAX support

All of this sounds very complicated, but really it is simple!. Most of these things are transparent. The resulting code is quite readable and has very little plumbing!

There is a non trivial example that some of these functionalities embedded here that you can run:

 http://hackage.haskell.org/packages/archive/MFlow/0.1.5.3/doc/html/MFlow-Forms.html

Take a look and tell me your opinion.  I hope that you find it as exciting as me.

Although still it is experimental, it is being used in at least on future commercial project. So I have te commitment to continue its development. There are many examples in the documentation and in the package.

 I´m looking for people  to collaborate in the development of MFlow. You are welcome!.

This is the example:

{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} 

module Main where
 import MFlow.Wai.XHtml.All
 import Data.TCache
 import Control.Monad.Trans
 import Data.Typeable
 import Control.Concurrent
 import Control.Exception as E
 import qualified Data.ByteString.Char8 as SB
 import qualified Data.Vector as V
 import Data.Maybe

 data Ops= Ints | Strings | Actions | Ajax | Opt deriving(Typeable,Read, Show)
 main= do
    setFilesPath ""
    addFileServerWF
    addMessageFlows [(""  ,transient $ runFlow mainf)
                    ,("shop"    ,runFlow shopCart)]
    forkIO $ run 80 waiMessageFlow
    adminLoop

 stdheader c= p << "you can press the back button to go to the menu"+++ c

 mainf=   do
        setHeader stdheader
        r <- ask $   wlink Ints (bold << "increase an Int")
                <|>  br ++> wlink Strings (bold << "increase a String")
                <|>  br ++> wlink Actions (bold << "Example of a string widget with an action")
                <|>  br ++> wlink Ajax (bold << "Simple AJAX example")
                <|>  br ++> wlink Opt (bold << "select options")
                <++ (br +++ linkShop) -- this is an ordinary XHtml link

        case r of
          Ints    ->  clickn 0
          Strings ->  clicks "1"
          Actions ->  actions 1
          Ajax    ->  ajaxsample
          Opt     ->  options
        mainf
     where
     linkShop= toHtml $ hotlink  "shop" << "shopping"

 options= do
    r <- ask $ getSelect (setOption "blue" (bold << "blue")   <|>
                          setSelectedOption "Red"  (bold << "red")  ) <! dosummit
    ask $ p << (r ++ " selected") ++> wlink () (p<< " menu")
    breturn()
    where
    dosummit= [("onchange","this.form.submit()")]

 clickn (n :: Int)= do
    setHeader stdheader
    r <- ask $  wlink "menu" (p << "menu")
            |+| getInt (Just n) <* submitButton "submit"
    case r of
     (Just _,_) -> breturn ()
     (_, Just n') -> clickn $ n'+1


 clicks s= do
    setHeader stdheader
    s' <- ask $ (getString (Just s)
              <* submitButton "submit")
              `validate` (\s -> return $ if length s   > 5 then Just "length must be < 5" else Nothing )
    clicks $ s'++ "1"


 ajaxheader html= thehtml << ajaxHead << p << "click the box" +++ html

 ajaxsample= do
    setHeader ajaxheader
    ajaxc <- ajaxCommand "document.getElementById('text1').value"
                         (\n ->  return $ "document.getElementById('text1').value='"++show(read  n +1)++"'")
    ask $ (getInt (Just 0) <! [("id","text1"),("onclick", ajaxc)])
    breturn()

 actions n=do
   ask $ wlink () (p << "exit from action")
      <**((getInt (Just (n+1)) <** submitButton "submit" ) `waction` actions )
   breturn ()

 -- A persistent flow  (uses step). The process is killed after 10 seconds of inactivity
 -- but it is restarted automatically. if you restart the program, it remember the shopping cart
 -- defines a table with links enclosed that return ints and a link to the menu, that abandon this flow.
 shopCart  = do
    setTimeouts 10 0
    shopCart1 (V.fromList [0,0,0:: Int])
    where
    shopCart1 cart=  do
      i <- step . ask $
              table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"]
              <<< caption << "choose an item"
              ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"]
              ++> (tbody
                   <<<  tr ! [rowspan 2] << td << linkHome
                   ++> (tr <<< td <<< wlink  0 (bold <<"iphone") <++  td << ( bold << show ( cart V.! 0))
                   <|>  tr <<< td <<< wlink  1 (bold <<"ipad")   <++  td << ( bold << show ( cart V.! 1))
                   <|>  tr <<< td <<< wlink  2 (bold <<"ipod")   <++  td << ( bold << show ( cart V.! 2)))
                   <++  tr << td << linkHome
                   )

      let newCart= cart V.// [(i, cart V.! i + 1 )]
      shopCart1 newCart
     where
     linkHome= (toHtml $ hotlink  noScript << bold << "home")

Parselets :: safe, single expression parser/pretty-printer serializer/deserializer

I want to express  the parse and pretty-print of a data structure with a single, declarative expression. I also want to make the syntax general enough to adapt to any serialization/deserialization format, binary or textual, and for any string format.

The first is done. I used the idea of Formlets and applied it to parse-print. This is the resulting expression for an  example datatype:

data P = I {getInt :: Int} | S {getString :: String} deriving (Show)

This is the instance of  Parselet for P to parse/print from/to Strings (see the class definition below)  :

instance ParseLet P String where

    parse mpx  =   I <$> (str "I" *> pString (sel getInt mpx ))
              <|>  S <$> (str "S" *> pString (sel getString mpx ))

The single expression produces the text serialization and deserialization:

main =  do
   putStrLn . serial $ S "hi"
   print (deserial "I 2" :: Maybe P )

This is the output:

e>runghc demos\parselets.hs
S {getString="hi"}
Just (I 2)


To do this,I  coded some applicative instance that wraps both a non monadic parser and a non-monadic serializer. I also found a way to express  conditional serialization as an Alternative expression within an Applicative expression (sel), so that it mimic the shape of an applicative parser expression


Because there is a single expression for serialization and deserializartion,  it can be guaranteed  that the first will produce a result that will be read without errors by the second:

This is the complete source of parselets.hs:

{-# LANGUAGE ScopedTypeVariables ,TypeSynonymInstances ,FlexibleInstances ,MultiParamTypeClasses #-} import Control.Applicative import Data.Monoid import System.IO.Unsafe import Control.Exception as CE import Data.List(isPrefixOf) import Data.Maybe import Debug.Trace (!>)= flip trace data RS v a= RS v (Maybe a) newtype RSView v a= RSView{runRSView :: (v -> (RS v a,v))} instance Functor (RSView v) where fmap f (RSView p)=RSView $ \v -> let (RS v1 x, r)= p v in (RS v1 (fmap f x),r) instance Monoid v => Applicative( RSView v) where pure a = RSView ( \v -> (RS mempty $ Just a,v)) RSView f <*> RSView g= RSView ( \v -> let (RS v1 k,r) = f v (RS v2 x,r2) = g r in (RS (mappend v1 v2) (k <*> x),r2)) instance Monoid v => Alternative (RSView v) where empty= RSView $ \v -> (RS mempty Nothing, v) RSView f <|> RSView g= RSView ( \v -> let rs@(RS v1 k,r) = f v in case k of Just _ -> rs Nothing -> g v ) class Monoid v => ParseLet a v where parse :: Maybe a -> RSView v a -- must not use pattern match serial :: ParseLet a v => a -> v serial x = getSerial $ (runRSView $ parse (Just x)) mempty where getSerial (RS v _,_)= v deserial :: ParseLet a v => v -> Maybe a deserial str= getDeserial ( (runRSView ( parse Nothing)) str) where getDeserial (RS _ x,_)= x sel f mpx= unsafePerformIO $ CE.handle (\(e:: SomeException) -> return Nothing) $ let x= f $ fromJust mpx in x `seq` return (Just x) pString :: (Read a, Show a)=> Maybe a -> RSView String a pString (Just fpx)= RSView $ \str -> (RS (show$ fpx) (Just fpx),str) pString Nothing = RSView $ \str -> case readsPrec 1 str of [] -> (RS " " Nothing, str) (x,r):_ -> (RS " " (Just x), r) --str :: String -> RSView String () str s= RSView ( \st -> let readit= if isPrefixOf s st then Just() else Nothing in (RS (s++" ") readit , drop (length s) st)) data P = I Int | S String deriving (Read, Show) instance ParseLet P String where parse mpx = I <$> (str "I" *> pString (sel (\(I x) -> x) mpx )) <|> S <$> (str "S" *> pString (sel (\(S s) -> s) mpx )) main = do putStrLn . serial $ S "hi" print (deserial "I 2" :: Maybe P )