Sunday, December 30, 2012

On the "spirit" of MFlow. Anatomy of a Widget

TCache, RefSerialize, Workflow and MFlow are packages created in the process of building a system for massive workflows in the Web. It could be used for electronic democracy among other applications. MFlow  has been designed to program Web applications at a high level that I need by sacrificyng stability, completeness and some simplicity. It is also based of the idea of self contained code, composability and to encapsulate as much "magic" as I can.

Haskell can do a lot of magic in MFlow: It can express a web navigation flow in a way that in Java would need a configuration file. it can run a web server procedure backward to respond to a previous page in case the browser back button was pressed.  It can free resources by killing a process on timeout, because it can restart the server process when necessary and recover the computation state. It can get rid of database storage  and data storage definitions because all is re-created from simple events. It can compose statically typed pages including links and scripts. All these are unique characteristics that are unique in MFlow, but also it is possible a classical stateless application, with data storage defined by the user in a database.

Since the workflow concept need a way to checkpoint events,  The Workflow package has a monad that store the internal and external events, and restore its state from them without the need for an additional snapshoot of the  current state, which  indeed would need an additional data definition beside the definition of the events. That is what is called "event sourcing".

MFlow uses the hability of Workflow to store and rebuild the state of the data from the events, in this case, produced by user interactions in the Web. This means that there has no need for a data layer if you don´t want it. Just the automatically generated log of events is enough. This advantage becomes a necessity when a data definition of the current state is not only redundant but impossible without an additional interpreted DSL. For example I want to use MFlow for a functionality in which the user define processes by means of a wizard-like interaction, with some questions asked to the user. The generated description is a program that has no direct data serialization except by means of a interpreted DSL that would be painfully complicated, and would not add any additional functionality except the intended persistence of the current state. Instead,  this programming overhead can be avoided by using event sourcing. See here.

RefSerialize is a serialization library that reduces the size of the event log by referencing multiple repeated events to a single description in the log file. TCache gives transactionality and read/write caching, so that log writing and reading is done in bursts according with the cache write policy, and in coherence with other kind of non-event data that may be used by the application.

As I said before, the requisite of self contained-ness for the creation of components is very important for me. It means that the habitual mess of configuration files, heterogeneous dscriptions, templatings, scripts, all of them in different files that make necessary a deployment step and a complete manual for reusing it is avoided. You can still have your separate  header-footer thenplate in a different file, codified using XML,  but this is not imposed. You can have all of this in the same file.

Here below is an example of a reusable widget in MFlow. A widget is an active component. It ever return something statically typed, verified at compilation time. The output may be the result of a click in a link, a form submit or a script. It can have Ajax interactions.  It can use/contain other widgets or combinations of widgets that interact with the server server trough ajax.It uses Ajax to call 'prependWidget', that insert a new empty widget of type 'a' on top of the list. The widget 'requires' the installation of  a short 'ajaxScript' that is inline, and the jquery file that is referenced by the URL. When jquery is loaded, a online script,  'installevents' is called and install the ajax event.

wEditList :: (Typeable a,Read a
             ,FormInput view
             ,Functor m,MonadIO m, Executable m)
          => (view ->view)
          -> (Maybe String -> View view Identity a)
          -> [String] -> View view m  [a]
wEditList holderview w xs = do

    let ws=  map (w . Just) xs
        wn=  w Nothing
    id1<- genNewId
    let sel= "$('#"<>  B.pack id1 <> "')"
    callAjax <- ajax . const $ prependWidget sel wn
    let installevents= "$(document).ready(function(){\
              \$('#wEditListAdd').click(function(){"++callAjax "''"++"});})"

    requires [JScript ajaxScript, JScriptFile jqueryScript [installevents] ]

    ws' <- getEdited sel

    r <-  (holderview  <<< (manyOf $ ws' ++ map changeMonad ws)) <! [("id",id1)]

    delEdited sel ws'

    return  r

'prependWidget' stores the added widgets in the edited list, that is accessed with 'getEdited'.  This last is a shorhand for 'getSessionData'', which stores and retrieves user-defined data in the session, in this case the inserted widgets, by means of a map indexed by data type. In this way the user don´t need to pass its application data by parameters, neither it need to create its own state monad. 'getEdited' just uses its own type for storing widgets.

Finally, the value returned by the widget  is 'manyOf' the widgets added "ws'" and the initial widgets, "ws".  'manyOf' return only the validated widgets of the list. 'holderview' is the tag that encloses the list of edited widgets. the operator  '<<<'  add an encloser tag to the widget, and the operator '<!' gives atributes to the topmost tag of the widget, so the tag 'holderview' get assigned the  tag identifier 'id1'.  id1 is a name automatically generated. This is necessary for 'prependWidget' to add a new widget to 'id1' because his first parameter, the selector 'sel'  points to 'id1'.

Because the edited widgets are internally cached with 'wcached'  they must be in the Identity monad. to switch to the 'm' monad, 'changeMonad' is used. In the future, probably I will use IO only and disallow the use an arbitrary monad, since the user can store in session arbitrary data thanks to 'setSessionData' so there is no need for an arbitrary monad. That would make the types in MFlow less intimidating for beginners, and reflect the effort on simplicity without sacrificing power.

Finally the Edited list is deleted.before returning the result.

This widget is used in "demos/demos-blaze.hs" and is part of the MFlow release. I´m programming reusable active widgets general enough to be used in any kind of application. 'prependWidget' is an example of server-side control within the widget, to add dynamic behaviour. There is a 'ajaxSend' primitive that permits to send/receive many ajax messages during the same ajax procedure. It is intended that with this kind of server-side control, a single page with widgets coordinated in this way can present complex behaviours to the user.

The result is that the programmer can define general widgets at a level equal or higher than  ASP.NET server side controls or the JavaServer Faces with type safety. The price of the deep-first approach for accumulating levels of programming as fast as possible is the lack of stability (in fact the code above has changed) but the benefit is that the design updates will not be based on artificial tests, as a result of some assumptions, but in the use of  real application with real users.
In the next post I will show some usage examples of this widget 
This example uses the last version of MFlow at
It uses the last version of  Workflow

Wednesday, November 14, 2012

MFlow now supports blaze-html

MFlow now supports blaze.html.

This example  uses Blaze.Html . It is almost identical to the Text.XHtml version.

It show almost all of the functionalities of MFlow, so it has a lot of imports. Here the header and the main function is displayed:

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveDataTypeable, NoMonomorphismRestriction #-}
module Main where
import MFlow.Hack  -- hiding (ask)
import Hack.Handler.SimpleServer
import MFlow.Forms.Blaze.Html
import MFlow.Forms.Widgets
import MFlow.Forms.Ajax
import Text.Blaze.Html5 as El
import Text.Blaze.Html5.Attributes as At hiding (step)
import Text.Blaze.Internal(text)
import Data.String
--import MFlow.Forms.Test
import MFlow
import MFlow.FileServer
import MFlow.Forms.Ajax
import MFlow.Forms.Admin
import MFlow.Forms
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
import Data.Monoid

--test= runTest [(15,"shop")]

main= do
   syncWrite SyncManual
   setFilesPath ""
   addMessageFlows [(""  ,transient $ runFlow mainf),
                    ("shop"    ,runFlow shopCart)]
   run 80 hackMessageFlow


stdheader c= html << body << (p << text "You can press the back button" <> c)

data Options= CountI | CountS | TextEdit |Shop | Action | Ajax | Select deriving (Bounded, Enum,Read, Show,Typeable)

mainf=   do
       setHeader stdheader
       r <- ask="ask" br="br" nbsp="nbsp"> wlink TextEdit (b << text "Content Management")
               <|>  br ++> wlink Shop (b << text "example of transfer to another flow (shopping)")
               <|>  br ++> wlink CountI (b << text "increase an Int")
               <|>  br ++> wlink CountS (b << text "increase a String")
               <|>  br ++> wlink Action (b << text "Example of a string widget with an action")
               <|>  br ++> wlink Ajax (b << text "Simple AJAX example")
               <|>  br ++> wlink Select (b << text "select options")
               <++ (br <> linkShop) -- this is an ordinary XHtml link

       case r of
             CountI    ->  clickn 0
             CountS    ->  clicks "1"
             Action    ->  actions 1
             Ajax      ->  ajaxsample
             Select    ->  options
             TextEdit  ->  textEdit
             Shop      ->  transfer "shop"

       linkShop= a ! href  "shop" << text "shopping"

This example uses the last version of MFlow at
It uses the last version of  Workflow

MFlow: now the widgets can express requirements

A widget can need the installation of a client script, a CSS or download them. Also it can need a server process installed. But other widgets in the same page could need the same script. To avoid duplications, and to make easy the development of separated widgets maintaining the modularity, I added requirements.

type Script= String
type OnLoadScript= String
type File= String
data WebRequirement= CSSFile String
                   | CSS Script
                   | JScriptFile File [OnLoadScript]
                   | JScript Script
                   | ServerProc (String, Token -> Workflow IO ())

[OnLoadScript] are scripts called when the script file is loaded.

The syntax is as such:

ask $  requires[WebRequirement
    >> rest of the page

here >> is the monadic operator

For example this widget show set of options in from data from the serves via AJAX,  is defined in MFlow.Forms.Widgets, insert two javascript files, a CSS file and  a script. It can be combined with other widgets that require also these scripts, but the page creation process will just insert a single script tag or css link. The programmer no longer has to care about the requirements of each widget

selectAutocomplete serverproc = do 
    requires [JScript ajaxScript 
             ,JScriptFile jqueryScript [events]
             ,CSSFile jqueryCSS
             ,JScriptFile jqueryUi []]
    ajaxc <- ajaxcommand="ajaxcommand" attr="attr" font="font" text1="text1" value="value">
                         $ \u -> do
                                 r <- font="font" serverproc="serverproc" u="u">
                                 return $ jaddtoautocomp r

      (thediv ! [strAttr "id" "users"] <<< noWidget )
      <++ input ![thetype "text"
                 ,value "select users"
                 ,strAttr "id" "text1"
                 ,strAttr "oninput" ajaxc
                 ,strAttr "autocomplete" "off"]

This example uses the last version of MFlow at
It uses the last version of  Workflow

Monday, November 12, 2012

Content management in MFlow

I Just added some templating/content management to MFlow that IMHO is more flexible and simple than proper templating or content management approaches.

tFieldEd key html

is a widget that display the content of  html as is, But if logged as administrator, it permits to edit this chunk of html in place. So the editor could see the real appearance of what he write in the page while editing. When the administrator double click in the paragraph, the content is saved and identified by the key. Then, from now on the users will see the content of the saved paragraph, not the original one in the code.

The content is saved in a file by default ("texts" in this versions), but there is a configurable version (tFieldGen). The html content and his formating is cached in memory, so the display is very fast.

In case that the content has been fiixed and it don´t need further editions, 

 tField key

just read and present the edited content. tFieldEd is not longer needed.

There are also multilingual content management primitives mField and mFieldEd 

This demo shows in four steps how a typical process of content edition would work.

textEdit= do
    setHeader $ \html -> thehtml << body << html

    let first=  p << italics << 

                   (thespan << "this is a page with"
                   +++ bold << " two " +++ thespan << "paragraphs") 
        second= p << italics << "This is the original text. This is the second paragraph"
        pageEditable =  (tFieldEd "first"  first)
                    **> (tFieldEd "second" second)
    ask $   first
        ++> second
        ++> wlink () (p << "click here to edit it")
    setAdminUser "admin" "admin"
    ask $ p << "Please login with admin/admin to edit it"
            ++> userWidget (Just "admin") userLogin
    ask $   p << "now you can click the field and edit them"
        ++> p << bold << "to save the edited field, double click on it"
        ++> pageEditable
        **> wlink () (p << "click here to see it as a normal user")
    ask $   p << "the user sees the edited content. He can not edit it"
        ++> pageEditable   
        **> wlink () (p << "click to continue")
    ask $   p << "When text are fixed,the edit facility and the original texts can be removed. The content is indexed by the field key"
        ++> tField "first" 
        **> tField "second" 
        **> p << "End of edit field demo" ++> wlink () (p << "click here to go to menu")


This example uses the last version of MFlow at
It uses the last version of  Workflow

Tuesday, October 09, 2012

Testing MFlow applications

MFlow is a web application server for stateful type safe interactions with Web users. Because the interaction is done trough a single primitive, ask,  It is possible to replace this primitive by a injector of user inputs with the same name. Because the ask channel is typed, I can define a generator. The result is a very simple simulation of user sessions that can be used to generate different load conditions, to discover bottlenecks, bugs etc.

I define the class Response that generate valid responses for a type a :

class Response a where
  response :: IO a

I use the  Random instance of Int as the generator

instance Response a => Response (Maybe a) where
   response= do
     b <- randomRIO(0,1 :: Int)
     case b of 0 -> response >>= return . Just ; _ -> return Nothing

instance  Response String where
   response= replicateM 5  $ randomRIO ('a','z')
instance Response Int where
   response= randomRIO(1,1000)

instance Response Integer where
   response= randomRIO(1,1000)

instance (Response a, Response b) => Response (a,b) where
  response= fmap (,) response `ap` response

For enumerable types I use Bounded and Enum.

instance (Bounded a, Enum a) => Response a where
    response= mx
     mx= do
          let x= typeOfIO mx

          n <- randomRIO ( fromEnum $ minBound `asTypeOf` x
                         , fromEnum $ maxBound `asTypeOf` x)
          return $ toEnum n
          typeOfIO :: IO a -> a
          typeOfIO = error $ "typeOfIO not defined"

With these instances I can redefine ask, which takes a widget in the View applicative and generates a response in the FlowM monad:

ask :: (Response a) => View v m a -> FlowM v m a
ask w = do
     w  `MFlow.Forms.wmodify` (\v x -> consume v >> return (v,x))
     `seq` rest
     consume= liftIO . B.writeFile "dev/null" . B.concat . map  toByteString
     rest= do       
        bool <- liftIO $ response
        case bool of
              False -> fail ""
              True -> do
                b <- liftIO response
                r <- liftIO response
                case  (b,r)  of
                    (True,x)  -> breturn x
                    _         -> ask w
It executes the widget rendering code and simulate the conplete pass trough a ByteString channel by sending the result to /dev/null.  Then he uses the Response instance to return a result to the flow. Simulation of the back button is possible (by fail)  and also failed validations are simulated, which invokes ask again (at the end)

There are however callbacks and modifiers that do something with re result before returning to the main flow. To take care of it, waction and wmodify have also tweaks that can simulate valid entry values for them.

The resulting code is here: MFlow.Forms.Test

Let's use it . This example below creates 15 thread and invoke the shopCart procedure, which is persistent (it remenber the state when it restart, it is a nice feature of MFlow).

runTest is the primitive that spawn the threads and invoke the flows:

test= do
   addMessageFlows [("shop"    ,runFlow shopCart)]
   runTest [(15, "shop")]

data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum,Read, Show, Typeable)

-- 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 an user defined type.
shopCart  = do
   setTimeouts 10 0
   shopCart1 (V.fromList [0,0,0:: Int])
   shopCart1 cart=  do
     o <- 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 IPhone (bold <<"iphone") <++  td << ( bold << show ( cart V.! 0))
                  <|>  tr <<< td <<< wlink IPad (bold <<"ipad")   <++  td << ( bold << show ( cart V.! 1))
                  <|>  tr <<< td <<< wlink IPod (bold <<"ipod")   <++  td << ( bold << show ( cart V.! 2)))
     let i =fromEnum o
     let newCart= cart V.// [(i, cart V.!  i + 1 )]
     shopCart1 newCart
    linkHome= (toHtml $ hotlink  noScript << bold << "home")

When executed properly this example iterates to fill a simple shopping cart from the user input. But with the test we can check the application in different load conditions, so we can discover bottlenecks, bugs, performance issues and other interesting things.

The complete code of the example is at the demos.hs in the Git repository.

This is a (reduced) flow log of one of these 15 threads:

3729 178                                        
 [ "()   "
 , "B IPad   " 
 , "G  " 
 , "B IPad   " 
 , "G  " 
 , "G  " 
 , "B IPod   " 
 , "G  " 
 , "G  " 
 , "B IPad   " 
 , "G  " 
 , "B IPhone   " 
 , "G  " 
 , "B IPad   " 
 , "B IPhone   " 
 Stat "pkpvo/void"  178  ( Nothing ) 0  

"G "  means that the generator has selected the back button.

To summarize, the stateful , typed nature and the simplicity of the MFlow user interface makes the test infrastructure very simple and powerful.  And this is the beginning.

Sunday, September 23, 2012

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?"
    return $ "hello " ++ name

>runghc hello
your name?
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

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")
  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.

Tuesday, September 18, 2012

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

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:

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 ""
    addMessageFlows [(""  ,transient $ runFlow mainf)
                    ,("shop"    ,runFlow shopCart)]
    forkIO $ run 80 waiMessageFlow

 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
     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")
    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)])

 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])
    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
     linkHome= (toHtml $ hotlink  noScript << bold << "home")