packages feed

MFlow 0.4.5.4 → 0.4.5.5

raw patch · 58 files changed

+4629/−1728 lines, 58 filesdep +MFlowdep +acid-statedep +awsdep ~basedep ~stmnew-component:exe:demos-blaze

Dependencies added: MFlow, acid-state, aws, hamlet, hscolour, http-conduit, monad-logger, network, persistent, persistent-sqlite, persistent-template, pwstore-fast, resourcet, safecopy, shakespeare, tcache-AWS, wai-extra

Dependency ranges changed: base, stm

Files

+ Demos/AcidState.hs view
@@ -0,0 +1,77 @@+-- Modified From: https://github.com/acid-state/acid-state/blob/master/examples/HelloDatabase.hs
+-- Aistis Raulinaitis
+{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TemplateHaskell #-}
+{-# OPTIONS -XCPP #-}
+module AcidState (
+acidState, initAcid
+) where
+
+import Data.Acid
+
+import Control.Monad.State                   ( get, put )
+import Control.Monad.Reader                  ( ask )
+import Data.SafeCopy
+
+-- #define ALONE
+
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+
+main = do
+  db <- initAcid
+  runNavigation "" . step $ acidState db
+
+#else
+
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu  hiding (Database)
+
+#endif
+
+
+
+type Message = String
+data Database = Database [Message]
+
+
+initAcid= openLocalStateFrom "Demos/db/" (Database [])
+
+addMessage :: Message -> Update Database ()
+addMessage msg = do
+  Database messages <- get
+  put $ Database (msg:messages)
+
+viewMessages :: Int -> Query Database [Message]
+viewMessages limit = do
+  Database messages <- Control.Monad.Reader.ask
+  return $ take limit messages
+
+$(deriveSafeCopy 0 'Data.SafeCopy.base ''Database)
+$(makeAcidic ''Database ['addMessage, 'viewMessages])
+
+
+getLast10 :: AcidState (EventState AddMessage) -> IO String
+getLast10 database = do
+  messages <- query database (ViewMessages 10)
+  return $ concat [ message ++ "  " | message <- messages ]
+
+addMsg :: AcidState (EventState AddMessage) -> Message -> IO ()
+addMsg database msg = update database (AddMessage msg)
+
+
+
+
+acidState db= do
+  r <- page $ h3 << "Persistent message demo."
+          ++> getString Nothing
+          <** submitButton "OK"
+
+  liftIO $ addMsg db r
+
+  last10 <- liftIO $ getLast10 db
+
+  page $ b
+    << ("You typed: "++ r ++ ", it has been added to the acid state db.")
+    ++> p << ("Here are the last 10 things in the db: " ++ last10)
+    ++> wlink () << p << "next"
+  acidState db
+ Demos/Actions.hs view
@@ -0,0 +1,17 @@+
+module Actions (actions) where
+
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+
+actions = do
+  r<- page  $   p << b <<  "Two  boxes with one action each one"
+          ++> getString (Just "widget1") `waction` action
+          <+> getString (Just "widget2") `waction` action
+          <** submitButton "submit"
+  page  $ p << ( show r ++ " returned")  ++> wlink ()  << p <<  " menu"
+  where
+  action n=  page  $ getString (Just $ n ++ " action")<** submitButton "submit action"
+
+-- to run it alone, change page by ask and uncomment this:
+--main= runNavigation "" $ transientNav actions
+ Demos/AjaxSample.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS -XCPP #-} 
+
+module AjaxSample ( ajaxsample) where
+
+import Data.Monoid
+import Data.ByteString.Lazy.Char8 as B
+-- #define ALONE
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav ajaxsample
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+ajaxsample= do
+   r <- page  $   p << b <<  "Ajax example that increment the value in a box"
+            ++> do
+                 let elemval= "document.getElementById('text1').value"
+                 ajaxc <- ajax $ \n -> return . B.pack $ elemval <> "='" <> show(read  n +1) <>  "'"
+                 b <<  "click the box "
+                   ++> getInt (Just 0) <! [("id","text1"),("onclick", ajaxc  elemval)] <** submitButton "submit"
+   page  $ p << ( show r ++ " returned")  ++> wlink ()  << p <<  " menu"
+
+ Demos/AutoCompList.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS -XCPP #-} 
+module AutoCompList ( autocompList) where
+import Data.List
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav autocompList
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+
+autocompList= do
+   r <- page  $ pageFlow "autoc" $
+            p <<  "Autocomplete with a list of selected entries"
+            ++> p <<  "enter  and press enter"
+            ++> p <<  "when submit is pressed, the entries are returned"
+            ++> wautocompleteList "red,green,blue" filter1 ["red"]
+            <** submitButton "submit"
+   page  $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
+
+   where
+   filter1 s = return $ filter (isPrefixOf s) ["red","red rose","green","green grass","blue","blues"]
+
+-- to run it alone, change page by ask and uncomment this:
+--main= runNavigation "" $ transientNav autocompList
+ Demos/AutoComplete.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS -XCPP #-} 
+module AutoComplete ( autocomplete1) where
+import Data.List
+
+-- #define ALONE
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav autocomplete1
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+autocomplete1= do
+   r <- page $   pageFlow "auto"
+             $   p <<  "Autocomplete "
+             ++> p <<  "when submit is pressed, the box value  is returned"
+             ++> wautocomplete Nothing filter1 <! hint "red, green or blue"
+             <** submitButton "submit"
+   page  $ p << (show r ++ " selected")  ++> wlink () (p <<  " menu")
+
+   where
+   filter1 s = return $ filter (isPrefixOf s)
+                        ["red","red rose","green","green grass","blue","blues"]
+
+hint s= [("placeholder",s)]
+
+ Demos/CheckBoxes.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS -XCPP #-} 
+module CheckBoxes ( checkBoxes) where
+
+import Data.Monoid
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav checkBoxes
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+checkBoxes= do
+   r <- page  $ getCheckBoxes((setCheckBox False "Red"   <++ b <<  "red")
+                           <> (setCheckBox False "Green" <++ b <<  "green")
+                           <> (setCheckBox False "blue"  <++ b <<  "blue"))
+              <** submitButton "submit"
+
+
+   page  $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
+
+ Demos/Combination.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS -XCPP #-} 
+module Combination ( combination, wlogin1) where
+import Counter(counterWidget)
+import Data.String
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav combination
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+text= fromString
+
+combination =  page $ 
+     p << "Three active widgets in the same page with autoRefresh. Each widget refresh itself"
+     ++> p << "with Ajax. If Ajax is not active, they will refresh by sending a new page."
+     ++> hr 
+     ++> p << "Login widget (use admin/admin)" ++>  pageFlow  "r" (autoRefresh wlogin1)  <++ hr
+     **> p << "Counter widget" ++> pageFlow "c" (autoRefresh $ counterWidget 0 )  <++ hr
+     **> p << "Dynamic form widget" ++> pageFlow "f" (autoRefresh formWidget) <++ hr
+     **> wlink () << b << "exit"
+
+formWidget :: View Html IO ()
+formWidget=   do
+      (n,s) <- (,) <$> p << "Who are you?"
+                   ++> getString Nothing <! hint "name"     <++ br
+                   <*> getString Nothing <! hint "surname"  <++ br
+                   <** submitButton "ok" <++ br
+
+      flag <- b << "Do you " ++> getRadio[radiob "work?",radiob "study?"] <++ br
+
+      r<- case flag of
+         "work?" -> pageFlow "l"
+                     $ Left  <$> b << "do you enjoy your work? "
+                             ++> getBool True "yes" "no"
+                             <** submitButton "ok" <++ br
+
+         "study?"-> pageFlow "r"
+                     $ Right <$> b << "do you study in "
+                             ++> getRadio[radiob "University"
+                                         ,radiob "High School"]
+      u <-  getCurrentUser
+      p << ("You are "++n++" "++s)
+        ++> p << ("And your user is: "++ u)
+        ++> case r of
+             Left fl ->   p << ("You work and it is " ++ show fl ++ " that you enjoy your work")
+                            ++> noWidget
+
+             Right stu -> p << ("You study at the " ++ stu)
+                            ++> noWidget
+
+
+
+hint s= [("placeholder",s)]
+onClickSubmit= [("onclick","if(window.jQuery){\n"++
+                                  "$(this).parent().submit();}\n"++
+                           "else {this.form.submit()}")]
+radiob s n= wlabel (text s) $ setRadio s n <! onClickSubmit
+
+
+
+-- | If not logged, it present a page flow which page  for the user name, then the password if not logged
+--
+-- If logged, it present the user name and a link to logout
+--
+-- normally to be used with autoRefresh and pageFlow when used with other widgets.
+wlogin1 :: View Html IO ()
+wlogin1 =  do
+   username <- getCurrentUser
+   if username /= anonymous
+         then return username
+         else do
+          name <- getString Nothing <! hint "username" <++ br
+          pass <- getPassword <! hint "password" <** submitButton "login" <++ br
+          val  <- userValidate (name,pass)
+          case val of
+            Just msg -> notValid msg
+            Nothing  -> login name >> return name
+       
+   `wcallback` (\name -> b << ("logged as " ++ name)
+                     ++> p << "navigate away of this page before logging out"
+                     ++>  wlink "logout"  << b << " logout")
+   `wcallback`  const (logout >> wlogin1)
+
+focus = [("onload","this.focus()")]
+
+
+ Demos/ContentManagement.hs view
@@ -0,0 +1,55 @@+{-# OPTIONS -XCPP #-} 
+module ContentManagement ( textEdit) where
+
+import Text.Blaze.Html5 as El
+import Text.Blaze.Html5.Attributes as At hiding (step)
+import Data.Monoid
+import Data.TCache.Memoization
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav testEdit
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+
+
+editUser= "edituser"
+
+textEdit= do
+    userRegister editUser editUser
+    let first=  p << i <<
+                   (El.span <<  "this is a page with"
+                   <> b <<  " two " <> El.span <<  "paragraphs. this is the first")
+
+        second= p << i <<  "This is the original  of the second paragraph"
+
+    page  $   p << b <<  "An example of content management"
+        ++> first
+        ++> second
+        ++> wlink ()  << p <<  "click here to edit it"
+    
+    page  $   p <<  "Please login with edituser/edituser to edit it"
+        ++> userWidget (Just editUser) userLogin
+     
+    page  $   p <<  "Now you can click the fields and edit them"
+        ++> p << b <<  "to save an edited field, press the save icon in the left"
+        ++> tFieldEd editUser "first"  first
+        **> tFieldEd editUser "second" second
+        **> wlink ()  << p <<  "click here to see it as a normal user"
+
+    logout
+   
+    page  $   p <<  "the user sees the edited content. He can not edit"
+        ++> tFieldEd editUser "first"  first
+        **> tFieldEd editUser "second" second
+        **> wlink "a"  << p <<  "click to continue"
+
+    page  $   p <<  "When texts 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"
+
+ Demos/Counter.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS -XCPP -XDeriveDataTypeable #-} 
+module Counter ( counter, counterWidget) where
+import Data.Monoid
+import Data.String
+import Data.Typeable
+
+-- #define ALONE -- to execute it alone, uncomment this
+
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ step counter
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+attr= fromString 
+text= fromString
+
+counter= do
+   page  $ explain
+       ++> pageFlow "c" (counterWidget 0)
+       <++ br
+       <|> wlink () << p << "exit"
+   where
+   explain= do   -- using the blaze-html monad
+        p << "This example emulates the"
+        a ! href (attr "http://www.seaside.st/about/examples/counter") << "seaside counter example"
+        p << "This widget uses a \"callback\" that permit an independent"
+        text " execution flow for each widget. "
+        a ! href (attr "/noscript/multicounter") << "Multicounter"
+        text " instantiate various counter widgets"
+        p << "But while the seaside case the callback update the widget object, in this case"
+        p << "the callback recursively generates a new copy of the counter with the value modified."
+
+counterWidget n=
+      (h2 << show n
+       ++> wlink "i" << b << " ++ "
+       <|> wlink "d" << b << " -- ")
+      `wcallback`
+        \op -> case op  of
+          "i" -> counterWidget (n + 1)
+          "d" -> counterWidget (n - 1)
+ Demos/Database.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards
+           , OverloadedStrings, StandaloneDeriving
+           , ScopedTypeVariables, CPP #-}
+module Database where
+
+import Data.Typeable
+import Data.TCache.IndexQuery
+import Data.TCache.DefaultPersistence
+import Data.TCache.AWS
+import Data.Monoid
+import qualified Data.Text as T
+import Data.String
+import Data.ByteString.Lazy.Char8 hiding (index)
+
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= do
+  syncWrite  $ Asyncronous 120 defaultCheck  1000
+  index idnumber
+  runNavigation "" $ transientNav grid
+#else
+import MFlow.Wai.Blaze.Html.All hiding(select, page)
+import Menu
+#endif
+
+
+
+-- to run it alone,  remove Menu.hs and uncomment this:
+
+--askm= ask
+--
+--main= do
+--  syncWrite  $ Asyncronous 120 defaultCheck  1000
+--  index idnumber
+--  runNavigation "" $ step database
+
+data  MyData= MyData{idnumber :: Int, textdata :: T.Text} deriving (Typeable, Read, Show)  -- that is enough for file persistence
+instance Indexable MyData where
+   key=  show . idnumber    -- the key of the register
+
+
+domain= "mflowdemo"
+
+instance  Serializable MyData where
+  serialize=  pack . show
+  deserialize=  read . unpack
+  setPersist =  const . Just $ amazonS3Persist domain -- False
+ 
+data Options= NewText | Exit deriving (Show, Typeable)
+
+
+     
+database= do
+     liftIO $ index idnumber
+     database'
+
+
+database'= do
+     all <- allTexts
+
+     r <- page $ listtexts all
+
+     case r of
+         NewText -> do
+              text <- page $   p "Insert the text"
+                           ++> htmlEdit ["bold","italic"] ""  -- rich text editor with bold and italic buttons
+                                        (getMultilineText "" <! [("rows","3"),("cols","80")]) <++ br
+                           <** submitButton "enter"
+
+              addtext all text  -- store the name in the cache (later will be written to disk automatically)
+              database' 
+
+         Exit -> return ()
+     where
+     menu= wlink NewText   << p "enter a new text" <|>
+           wlink Exit      << p "exit to the home page"
+
+     listtexts all  =  do
+           h3 "list of all texts"
+           ++> mconcat[p $ preEscapedToHtml t >> hr | t <- all]
+           ++> menu
+           <++ b "or press the back button or enter the  URL any other page in the web site"
+
+     addtext all text= liftIO . atomically . newDBRef $ MyData (Prelude.length all) text
+     allTexts= liftIO . atomically . select textdata $ idnumber .>=. (0 :: Int)
+
+ Demos/Dialog.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS  -XCPP #-}
+module Dialog (wdialog1) where
+
+-- #define ALONE -- to execute it alone, uncomment this
+
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav wdialog1
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+wdialog1= do
+   page   wdialogw
+   page  (wlink () << "out of the page flow, press here to go to the menu")
+
+wdialogw= pageFlow "diag" $ do
+   r <- p << "please enter your name" ++> getString (Just "your name") <** submitButton "ok"
+   wdialog "({modal: true})" "Question"  $ 
+           p << ("Do your name is \""++r++"\"?") ++> getBool True "yes" "no" <** submitButton "ok"
+
+  `wcallback` \q -> if not q
+                      then wdialogw
+                      else  wlink () << b << "thanks, press here to exit from the page Flow"
+
+ Demos/GenerateForm.hs view
@@ -0,0 +1,182 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  GenerateForm
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ExistentialQuantification #-}
+module GenerateForm (
+genForm
+) where
+import MFlow.Wai.Blaze.Html.All
+import MFlow.Forms.Internals
+import Control.Monad.State
+import Data.Typeable
+import Data.Monoid
+import Prelude hiding (div)
+import Text.Blaze.Html5.Attributes as At hiding (step,span)
+import Data.List(nub)
+
+
+
+main=do
+ userRegister "edituser" "edituser"
+ runNavigation "nav" . step $ genForm
+
+
+-- page with header
+hpage w = page $ tFieldEd "editor"  "genFormHeader.html" "header" **> w
+
+genForm= do
+    id <- getSessionId
+    let title= "generateForm/"++id ++ "/form.html"
+    initFormTemplate title
+
+    desc <-  hpage $ createForm title
+
+    r <- hpage $ b "This is the form created, asking for input"
+           ++> hr
+           ++> generateForm title desc
+           <++ br
+           <** pageFlow "button" (submitButton "submit")
+
+    hpage $  h3 "results of the form:" ++> p << show r ++> noWidget
+    return()
+
+type Template= String
+data WType = Intv | Stringv | TextArea |OptionBox[String]
+           | WCheckBoxes [String] | Form Template [WType] deriving (Typeable,Read,Show)
+
+initFormTemplate title= do
+  liftIO $ writetField title $
+      p  "( delete this line. Press the save button to save the edits)"
+
+  setSessionData ([] :: [WType])
+  setSessionData $ Seq 0
+
+
+data Result = forall a.(Typeable a, Show a) => Result a deriving (Typeable)
+
+instance Show Result where
+  show (Result x)= show x
+
+genElem  Intv= Result <$> getInt Nothing
+genElem  Stringv=  Result <$> getString Nothing
+genElem TextArea=  Result <$> getMultilineText  ""
+genElem (OptionBox xs) =
+    Result <$> getSelect (setSelectedOption ""(p   "select a option") <|>
+               firstOf[setOption op  (fromStr  op) | op <- xs])
+
+genElem (WCheckBoxes xs) =
+    Result <$> getCheckBoxes(mconcat[setCheckBox False x <++ (fromStr x) | x <- xs])
+
+genElem (Form temp desc)= Result <$> generateForm temp desc
+
+generateForm title xs=
+   input ! At.type_ "hidden" ! name "p0" ! value "()"
+   ++>  template title
+   (pageFlow "" $ allOf $ map genElem xs )
+
+
+createForm  title= do
+ divmenu <<<  (  wlogin
+  **>
+      do br ++> wlink ("save" :: String) << b  "Save the form and continue"
+            <++ br <> "(when finished)"
+         getSessionData `onNothing` return []
+  <** do
+       wdesc <- chooseWidget <++ hr
+       desc <- getSessionData `onNothing` return []
+       setSessionData $ mappend desc [wdesc]
+       content <- liftIO $ readtField  mempty title
+       fieldview <- generateView  wdesc
+       liftIO . writetField title $ content <> br <> fieldview
+       )
+  <** divbody <<<  wform (edTemplate "edituser" title (return ()) )
+
+divbody= div ! At.style "float:right;width:65%"
+divmenu= div ! At.style "background-color:#EEEEEE;float:left;margin-left:10px;margin-right:10px;overflow:auto;"
+
+
+newtype Seq= Seq Int deriving (Typeable)
+
+generateView desc= View $ do
+    Seq n <- getSessionData `onNothing` return (Seq 0)
+    s <- get
+    let n'= if n== 0 then 1 else n
+    put s{mfSequence= n'}
+    FormElm render _ <- runView $ genElem desc
+    n'' <- gets mfSequence
+    setSessionData $ Seq n''
+    return $ FormElm mempty $ Just ( br <> br <> render :: Html)
+
+
+
+chooseWidget=
+       (p $ a ! At.href "/" $ "home/reset") ++>
+
+       (p <<< do wlink ("text":: String)  "text field"
+                 ul <<<(li <<< wlink Intv "returning Int"
+                    <|> li <<< wlink Stringv  "returning string"))
+
+       <|> p <<< do wlink TextArea "text area"
+
+       <|> p <<< do
+              wlink ("check" :: String)  "checkBoxes"
+              ul <<<  getOptions "comb"
+
+       <|> p <<< do
+              wlink ("options" :: String)  "options"
+              ul <<<  getOptions "opt"
+
+
+
+
+
+
+getOptions pf =
+     do
+      r <- wform $ submitButton "create" <|> submitButton "clear"
+
+      case r of
+        "create" -> do
+          ops <- getSessionData
+          case ops of
+            Nothing -> stop
+            Just elem -> return elem
+        "clear" -> do
+           delSessionData (undefined :: WType)
+           stop
+
+    <** do
+        op <- wform $ getString Nothing <! [("size","8")
+                                   ,("placeholder","option")]
+                       <** submitButton "add" <++ br
+
+        mops <- getSessionData
+        ops' <- case (mops,pf) of
+           (Nothing, "comb") -> do setSessionData $ WCheckBoxes [op] ; return [op]
+           (Nothing, "opt")  -> do setSessionData $ OptionBox [op] ; return [op]
+           (Just (OptionBox _), "comb") -> do setSessionData $ WCheckBoxes [op] ; return [op]
+           (Just (WCheckBoxes _),"opt") -> do setSessionData $ OptionBox [op] ; return [op]
+           (Just (WCheckBoxes ops),"comb") -> do
+               let ops'= nub $ op:ops
+               setSessionData . WCheckBoxes $ ops'
+               return ops'
+           (Just (OptionBox ops),"opt") ->  do
+               let ops'= nub $ op:ops
+               setSessionData . OptionBox $ ops'
+               return ops'
+        wraw $ mconcat [p << op | op <- ops']
+
+
+
+
+--delParam par=  modify  $ \s -> s{mfEnv=filter ( (par /=) . fst) $ mfEnv s}
+ Demos/GenerateFormUndo.hs view
@@ -0,0 +1,192 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  GenerateForm
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ExistentialQuantification #-}
+module GenerateFormUndo (
+genFormUndo
+) where
+import MFlow.Wai.Blaze.Html.All
+import MFlow.Forms.Internals
+import Control.Monad.State
+import Data.Typeable
+import Data.Monoid
+import Prelude hiding (div)
+import Text.Blaze.Html5.Attributes as At hiding (step,span)
+import Data.List(nub)
+import Control.Monad
+
+
+main=do
+ userRegister "edituser" "edituser"
+ runNavigation "nav" . step $ genFormUndo
+
+
+-- page with header
+hpage w = page $ tFieldEd "editor"  "genFormUndoHeader.html" "header" **> w
+
+
+genFormUndo= do
+    id <- getSessionId
+    let title= "generateForm/"++id ++ "/form.html"
+    initFormTemplate title
+
+    desc <-  createForm 0 title
+
+    r <- hpage $ b "This is the form created, asking for input"
+           ++> hr
+           ++> generateForm title desc
+           <++ br
+           <** pageFlow "button" (submitButton "submit")
+
+    hpage $  h3 "results of the form:" ++> p << show r ++> noWidget
+    return()
+
+type Template= String
+data WType = Intv | Stringv | TextArea |OptionBox[String]
+           | WCheckBoxes [String] | Form Template [WType] deriving (Typeable,Read,Show)
+
+initFormTemplate title= do
+  liftIO $ writetField (title ++ show 1) $
+      p  "( delete this line. Press the save button to save the edits)"
+
+  setSessionData ([] :: [WType])
+  setSessionData $ Seq 0
+
+
+data Result = forall a.(Typeable a, Show a) => Result a deriving (Typeable)
+
+instance Show Result where
+  show (Result x)= show x
+
+genElem  Intv= Result <$> getInt Nothing
+genElem  Stringv=  Result <$> getString Nothing
+genElem TextArea=  Result <$> getMultilineText  ""
+genElem (OptionBox xs) =
+    Result <$> getSelect (setSelectedOption ""(p   "select a option") <|>
+               firstOf[setOption op  (fromStr  op) | op <- xs])
+
+genElem (WCheckBoxes xs) =
+    Result <$> getCheckBoxes(mconcat[setCheckBox False x <++ (fromStr x) | x <- xs])
+
+genElem (Form temp desc)= Result <$> generateForm temp desc
+
+generateForm title xs=
+   input ! At.type_ "hidden" ! name "p0" ! value "()"
+   ++>  template title
+   (pageFlow "" $ allOf $ map genElem xs )
+
+
+createForm n title= do
+ desc <- getSessionData `onNothing` return []
+ Seq seq <- getSessionData `onNothing` return (Seq 0)
+
+ r <- hpage $ do
+    divmenu <<<(wlogin
+       **> do
+             br ++> wlink ("save" :: String) << b  "Save the form and continue"
+                <++ br <> "(when finished)"
+             content <- liftIO $ readtField  (mempty :: Html) (title ++ show n)
+             liftIO . writetField title $ content
+             liftIO $ forM_ [1 .. n] $ \n -> writetField (title ++ show n)  ("" :: Html)
+             Just <$> getSessionData `onNothing` return []
+       <|> do
+             wdesc <- chooseWidget <++ hr
+             setSessionData $ mappend desc [wdesc]
+             content <- liftIO $ readtField  mempty (title ++ show n)
+             fieldview <- generateView  wdesc seq
+             liftIO . writetField (title ++ show (n+1)) $ content <> br <> fieldview
+             return Nothing
+           )
+     <** divbody <<<  wform (edTemplate "edituser" (title ++ show n) (return ()) )
+ case r of
+   Just desc -> breturn desc
+   Nothing -> createForm (n+1) title
+
+divbody= div ! At.style "float:right;width:65%"
+divmenu= div ! At.style "background-color:#EEEEEE;float:left;margin-left:10px;margin-right:10px;overflow:auto;"
+
+
+newtype Seq= Seq Int deriving (Typeable)
+
+generateView desc n= View $ do
+    s <- get
+    let n'= if n== 0 then 1 else n
+    put s{mfSequence= n'}
+    FormElm render _ <- runView $ genElem desc
+    n'' <- gets mfSequence
+    setSessionData $ Seq n''
+    return $ FormElm mempty $ Just ( br <> br <> render :: Html)
+
+
+
+chooseWidget=
+       (p $ a ! At.href "/" $ "home") ++>
+       (p <<< absLink ("" :: String) "reset") **>
+       (p <<< do wlink ("text":: String)  "text field"
+                 ul <<<(li <<< wlink Intv "returning Int"
+                    <|> li <<< wlink Stringv  "returning string"))
+
+       <|> p <<< do wlink TextArea "text area"
+
+       <|> p <<< do
+              wlink ("check" :: String)  "checkBoxes"
+              ul <<<  getOptions "comb"
+
+       <|> p <<< do
+              wlink ("options" :: String)  "options"
+              ul <<<  getOptions "opt"
+
+
+
+
+
+
+getOptions pf =
+     do
+      r <- wform $ submitButton "create" <|> submitButton "clear"
+
+      case r of
+        "create" -> do
+          ops <- getSessionData
+          case ops of
+            Nothing -> stop
+            Just elem -> return elem
+        "clear" -> do
+           delSessionData (undefined :: WType)
+           stop
+
+    <** do
+        op <- wform $ getString Nothing <! [("size","8")
+                                   ,("placeholder","option")]
+                       <** submitButton "add" <++ br
+
+        mops <- getSessionData
+        ops' <- case (mops,pf) of
+           (Nothing, "comb") -> do setSessionData $ WCheckBoxes [op] ; return [op]
+           (Nothing, "opt")  -> do setSessionData $ OptionBox [op] ; return [op]
+           (Just (OptionBox _), "comb") -> do setSessionData $ WCheckBoxes [op] ; return [op]
+           (Just (WCheckBoxes _),"opt") -> do setSessionData $ OptionBox [op] ; return [op]
+           (Just (WCheckBoxes ops),"comb") -> do
+               let ops'= nub $ op:ops
+               setSessionData . WCheckBoxes $ ops'
+               return ops'
+           (Just (OptionBox ops),"opt") ->  do
+               let ops'= nub $ op:ops
+               setSessionData . OptionBox $ ops'
+               return ops'
+        wraw $ mconcat [p << op | op <- ops']
+
+
+
+
+--delParam par=  modify  $ \s -> s{mfEnv=filter ( (par /=) . fst) $ mfEnv s}
+ Demos/GenerateFormUndoMsg.hs view
@@ -0,0 +1,224 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  GenerateForm
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings,  ScopedTypeVariables, ExistentialQuantification #-}
+module GenerateFormUndoMsg (
+genFormUndoMsg
+) where
+import MFlow.Wai.Blaze.Html.All
+import MFlow.Forms.Internals
+import Control.Monad.State
+import Data.Typeable
+import Data.Monoid
+import Prelude hiding (div)
+import Text.Blaze.Html5.Attributes as At hiding (step,span,form)
+import Data.List(nub)
+import Control.Monad
+import Data.List((\\))
+--import Debug.Trace
+--(!>)= flip trace
+
+main=do
+ userRegister "edituser" "edituser"
+ runNavigation "nav" . step $ genFormUndoMsg
+
+
+-- page with header
+hpage w = page $ tFieldEd "editor"  "genFormUndoMsgHeader.html"  "HEADER EMPTY!" **> w
+
+
+
+
+genFormUndoMsg= do
+    id <- getSessionId
+    let title= "generateForm/"++id ++ "/form.html"
+    initFormTemplate title
+
+    desc <-  createForm 0 title
+
+
+    hpage $  b "This is the form created. Test it"
+           ++> hr
+           ++> generateForm title  desc
+           **> wlink () "home/reset"
+
+
+
+    return()
+
+type Template= String
+data WType = Intv | Stringv | TextArea |OptionBox[String]
+           | WCheckBoxes [String] | ShowResults
+           | Form Template [WType] deriving (Typeable,Read,Show,Eq)
+
+initFormTemplate title= do
+  liftIO $ writetField (title ++ show 1) $
+      p  "( delete this line. Press the save button to save the edits)"
+
+  setSessionData ([] :: [WType])
+  setSessionData $ Seq 0
+
+
+data Result = forall a.(Typeable a, Show a) => Result a deriving (Typeable)
+
+instance Show Result where
+  show (Result x)= show x
+
+genElem  Intv   =  Result <$> dField (getInt Nothing)
+genElem  Stringv=  Result <$> dField (getString Nothing)
+genElem TextArea=  Result <$> getMultilineText  ""
+genElem (OptionBox xs) =
+    Result <$> getSelect (setSelectedOption ""(p   "select a option") <|>
+               firstOf[setOption op  (fromStr  op) | op <- xs])
+
+genElem (WCheckBoxes xs) =
+    Result <$> getCheckBoxes(mconcat[setCheckBox False x <++ (fromStr x) | x <- xs])
+
+genElem ShowResults = Result <$> do
+      xs <- getSessionData `onNothing` return []
+      pageFlow "" (allOf (map genElem (xs \\ [ShowResults]))) <|> return []
+    `wcallback` (\r ->  pageFlow "button" $
+      submitButton "submit"
+      **> h2 "Result:"
+      ++> dField(wraw $ b << show r)
+      **> return ())
+
+
+
+genElem (Form temp desc)= Result <$> generateForm temp desc
+
+generateForm title xs=
+   input ! At.type_ "hidden" ! name "p0" ! value "()"
+
+   ++> (div ! At.id "p0"
+   <<< input ! type_ "hidden" ! name "p0" ! value"()"
+   ++> ( template title . pageFlow "" . witerate . pageFlow "" . allOf $ map genElem xs))
+
+
+-- n carries out the version number
+createForm n title= do
+ desc    <- getSessionData `onNothing` return []
+ Seq seq <- getSessionData `onNothing` return (Seq 0)
+
+ r <- hpage $ do
+    divmenu <<<(wlogin
+       **> do
+             br ++> wlink ("save" :: String) << b  "Save the form and continue"
+                <++ br <> "(when finished)"
+             content <- liftIO $ readtField  (mempty :: Html) (title ++ show n)
+             liftIO . writetField title $ content
+             liftIO $ forM_ [1 .. n] $ \n -> writetField (title ++ show n)  ("" :: Html) -- delete
+             desc' <- getSessionData `onNothing` return []
+             desc  <- addResults title desc'
+             return $ Just desc
+       <|> do
+             wdesc <- chooseWidget <++ hr
+             addElem (title ++ show n) (title ++ show (n+1))  wdesc
+             setSessionData $ mappend desc [wdesc]
+             return Nothing
+           )
+     <** divbody <<< (edTemplate "edituser" (title ++ show n) (return ()) )
+ case r of
+   Just desc -> breturn desc
+   Nothing -> createForm (n+1) title
+
+-- add a "show results" element to the form if it is not already there
+addResults title desc = do
+    if (null $ filter (== ShowResults) desc)
+         then do
+           addElem title title ShowResults
+           return $ desc ++ [ShowResults]
+         else  return desc
+
+-- add a form elem to the page being edited
+addElem title title2 wdesc = do
+     Seq seq <- getSessionData `onNothing` return (Seq 0)
+     content <- liftIO $ readtField  mempty title
+     fieldview <- generateView  wdesc seq
+     liftIO . writetField title2  $ content <> br <> fieldview
+
+
+divbody= div ! At.style "float:right;width:65%"
+divmenu= div ! At.style "background-color:#EEEEEE;float:left;margin-left:10px;margin-right:10px;overflow:auto;"
+
+
+newtype Seq= Seq Int deriving (Typeable)
+
+generateView desc n= View $ do
+    s <- get
+    let n'= if n== 0 then 1 else n
+    put s{mfSequence= n'}
+    FormElm render mr <- runView $ genElem desc
+    n'' <- gets mfSequence
+    setSessionData $ Seq n''
+    return $ FormElm mempty $ Just ( br <> br <>  render :: Html)
+
+
+nrlink x v= wlink x v <! noAutoRefresh
+
+chooseWidget=  pageFlow "" $ autoRefresh $
+       (p $ a ! At.class_ "_noAutoRefresh" ! At.href "/" $ "home")
+       ++>(p <<< absLink ("" ::String) "reset" <! noAutoRefresh)
+       **> p <<< do
+              wlink ("text":: String)  "text field"
+              ul <<<(li <<< nrlink Intv "returning Int"
+                 <|> li <<< nrlink Stringv  "returning string")
+
+       <|> p <<< do nrlink TextArea "text area"
+
+       <|> p <<< do
+              wlink ("check" :: String)  "checkBoxes"
+              ul <<<  getOptions "comb"
+
+       <|> p <<< do
+              wlink ("options" :: String)  "options"
+              ul <<<  getOptions "opt"
+
+       <|> p <<< nrlink ShowResults "Show Form Results"
+
+
+
+
+getOptions pf =  autoRefresh  . wform $
+     do
+        noCache
+        (op,_) <- (,)<$> getString Nothing <! [("size","8"),("placeholder","option")]
+                     <*> submitButton "add"
+                     <** submitButton "clear" `waction` const (delSessionData (undefined :: WType))
+
+        mops <- getSessionData
+        ops' <- case (mops,pf) of
+               (Nothing, "comb") -> do setSessionData $ WCheckBoxes [op] ; return [op]
+               (Nothing, "opt")  -> do setSessionData $ OptionBox [op] ; return [op]
+               (Just (OptionBox _), "comb") -> do setSessionData $ WCheckBoxes [op] ; return [op]
+               (Just (WCheckBoxes _),"opt") -> do setSessionData $ OptionBox [op] ; return [op]
+               (Just (WCheckBoxes ops),"comb") -> do
+                   let ops'= nub $ op:ops
+                   setSessionData . WCheckBoxes $ ops'
+                   return ops'
+               (Just (OptionBox ops),"opt") ->  do
+                   let ops'= nub $ op:ops
+                   setSessionData . OptionBox $ ops'
+                   return ops'
+        wraw $ mconcat [p << op | op <- ops']
+
+    **> do
+        r   <- submitButton "create" <! noAutoRefresh
+        ops <- getSessionData
+        case ops of
+            Nothing -> stop
+            Just elem -> do
+              delSessionData (undefined :: WType)
+              return elem
+
+
+ Demos/Grid.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS  -XCPP #-}
+module Grid ( grid) where
+
+import Data.String
+import Text.Blaze.Html5.Attributes as At hiding (step)
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav grid
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+attr= fromString
+
+grid = do
+  r <- page  $ pageFlow "grid"
+             $ addLink
+           ++> wEditList table  row ["",""] "wEditListAdd"
+           <** submitButton "submit"
+           
+  page  $ p << (show r ++ " returned")
+      ++> wlink () (p <<  " back to menu")
+      
+  where
+  row _= tr <<< ( (,) <$> tdborder <<< getInt (Just 0)
+                          <*> tdborder <<< getTextBox (Just "")
+                          <++ tdborder << delLink)
+                          
+  addLink= a ! href (attr "#")
+             ! At.id (attr "wEditListAdd")
+             <<  "add"
+             
+  delLink= a ! href (attr "#")
+             ! onclick (attr "this.parentNode.parentNode.parentNode.removeChild(this.parentNode.parentNode)")
+             <<  "delete"
+             
+  tdborder= td ! At.style  (attr "border: solid 1px")
+
+ Demos/IncreaseInt.hs view
@@ -0,0 +1,25 @@+{-# OPTIONS -XCPP #-}
+module IncreaseInt ( clickn) where
+
+-- #define ALONE
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All 
+main= runNavigation "" . transientNav $ clickn 0
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+-- |+| add a widget before and after another and return both results.
+-- in this case, a link wraps a form field
+
+clickn :: Int -> FlowM Html IO ()
+clickn n= do
+   r <- page  $ p << b <<  "increase an Int"
+            ++> wlink "menu"  << p <<  "menu"      
+            |+| getInt (Just n)  <* submitButton "submit"
+
+   case r of
+    (Just _,_) -> return ()  --  page  $ wlink () << p << "thanks"
+    (_, Just n') -> clickn $ n'+1
+
+ Demos/IncreaseString.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS  -XCPP #-}
+module IncreaseString ( clicks) where
+
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav grid
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+clicks s= do
+   s' <- page  $  p << b <<  "increase a String"
+             ++> p << b <<  "press the back button to go back to the menu"
+             ++>(getString (Just s)
+             <* submitButton "submit")
+             `validate` (\s -> return $ if length s   > 5 then Just (b << "length must be < 5") else Nothing )
+   clicks $ s'++ "1"
+
+ Demos/InitialConfig.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE  CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+
+
+module InitialConfig (initialConfig) where
+import Data.Typeable
+import Data.String(fromString)
+
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All as MF
+main= runNavigation "" initialConfig
+#else
+import MFlow.Wai.Blaze.Html.All as MF hiding(retry, page)
+import Menu
+#endif
+
+data Skin= Normal |  Blue | Red deriving (Read,Show,Typeable, Bounded, Enum)
+
+initialConfig= do
+   mskin <-  getSessionData
+   skin <- case mskin of
+    Nothing -> do
+     s <- step . page $ p << "choose skin"
+                    ++> wlink Normal  << p << "normal"
+                    <|> wlink Blue    << p << "blue"
+                    <|> wlink Red     << p << "red"
+     setSessionData s
+     return s
+    Just sk -> return sk
+   step $ restOfTheFlow skin
+
+   where
+   restOfTheFlow skin = do
+        r  <- page  $ p << ("skin chosen so far: "++ show skin)
+                  ++> p << ("you choosen the skin " ++ show skin)
+                  ++> wlink "change" << MF.div << "Change the skin"
+                  <++ br
+                  <|> wlink "doOther" << p << "other things"
+        case r of
+           "change" -> breturn ()
+           _ ->do
+                  page  $ p << ("skin chosen so far: "++ show skin)
+                      ++> p << "other things"
+                      ++> a ! href (fromString "http://www.google.com") << p << "google"
+                      ++> br
+                      ++> wlink() << p << "press here to return to the salutation"
+                  restOfTheFlow  skin
+
+
+ Demos/LazyLoad.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-}
+module LazyLoad (lazyLoad) where
+import Data.Typeable
+import Data.String
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "lazy" . transientNav $ do
+    setHeader $ docTypeHtml . body
+    lazyLoad
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+data Opts=  Sequence | Recursive deriving(Show, Typeable)
+
+lazyLoad=  do
+    r <- page  $ wlink Sequence  << p "Lazy present the 20 numbers"
+             <|> wlink Recursive << p "present 20 numbers lazily recursive"
+    n <- case r of
+       Sequence  -> page $ pageFlow "lazy" $ lazyPresent  (0 :: Int) 20
+       Recursive -> page $ pageFlow "lazy" $ lazyPresentR (0 :: Int) 20
+    page $ wlink () << p << (show n ++ " selected. Go to home" )
+
+lazyPresent i n=  firstOf[lazy  spinner (wlink i $ p << (show i) ) | i <- [i..n :: Int]]
+
+lazyPresentR i n
+   | i == n= noWidget
+   | otherwise= wlink i << p << (show i) <|> lazy spinner (lazyPresentR (i+1) n)
+
+spinner= img ! src (fromString spinnerurl)
+ where
+ spinnerurl=  getConfig "spinner" "//ganglia.wikimedia.org/latest/img/spinner.gif"
+
+ Demos/ListEdit.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings, CPP #-}
+module ListEdit ( wlistEd) where
+
+import Text.Blaze.Html5 as El
+import Text.Blaze.Html5.Attributes as At hiding (step)
+import Data.String
+-- #define ALONE
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav wlistEd
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+
+
+
+wlistEd= do
+   r <-  page   $ pageFlow "listed" $
+              addLink
+              ++> br
+              ++> (wEditList El.div getString1   ["hi", "how are you"] "wEditListAdd")
+              <++ br
+              <** submitButton "send"
+
+   page  $   p << (show r ++ " returned")
+       ++> wlink () (p " back to menu")
+
+
+   where
+   addLink = a ! At.id  "wEditListAdd"
+               ! href  "#"
+               $ b "add"
+   delBox  =  input ! type_    "checkbox"
+                    ! checked  ""
+                    ! onclick  "this.parentNode.parentNode.removeChild(this.parentNode)"
+   getString1 mx= El.div  <<< delBox ++> getString  mx <++ br
+
+-- to run it alone, change page by ask and uncomment this:
+--main= runNavigation "" $ transientNav wListEd
+
+ Demos/LoginSample.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS -XCPP #-} 
+module LoginSample ( loginSample) where
+
+import Data.Monoid
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runSecureNavigation "" $ transientNav loginSample
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+loginSample= do
+    userRegister "user" "user"
+    r <- page  $   p <<  "Please login with user/user"
+               ++> userWidget Nothing userLogin
+               <|> wlink "exit" << p << "or exit"
+        
+    if r == "exit" then return () else do
+        user <- getCurrentUser
+    
+        r <- page  $   b <<  ("user logged as " <>  user)
+                   ++> wlink True  << p <<  "logout"
+                   <|> wlink False << p <<  "or exit"
+
+        if r
+          then do
+             logout
+             page  $ p << "logged out" ++> wlink () << "press here to exit"
+          else return ()
+  
+
+
+ Demos/MCounter.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS  -XCPP #-}
+module MCounter (
+mcounter
+) where
+import Data.Monoid
+import Data.String
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav grid
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+
+
+
+mcounter  = do 
+ (op,n) <- step . page $ do
+              n <- getSessionData  `onNothing` return (0 :: Int) -- get Int data from the session
+              op <- h2 << show n    
+                     ++> wlink "i" << b << " ++ "
+                     <|> wlink "d" << b << " -- "
+
+              return(op,n)  -- unlike in the case of the shopping example where the shopcart is not logged
+                            -- here the state is smaller (the Int counter) anc can be logged      
+ case op  of
+          "i" -> setSessionData  (n + 1)                     
+          "d" -> setSessionData  (n - 1)
+
+ mcounter
+
+ Demos/MFlowPersistent.hs view
@@ -0,0 +1,89 @@+-- This example ilustrate the use of MFlow with Persistent
+-- The code is taken from http://www.yesodweb.com/book/persistent by modifying the first example
+--
+-- The example has a navigation of four pages and you can go forward and backward
+-- Note how little additions are necessary to change a console oriented application to a Web
+-- application with MFlow. While the flow looks like an ordinary imperative program, yo can go
+-- back and forth and to introduce any bookmark without producing navigation errors.
+--
+-- You can press the back button, change the form input and see how the responses match
+-- the expected register values.
+
+{-# LANGUAGE EmptyDataDecls    #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE GADTs             #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE CPP #-}
+
+module MFlowPersistent
+
+where
+
+
+import           Control.Monad.IO.Class  (liftIO)
+import           Database.Persist
+import           Database.Persist.Sqlite
+import           Database.Persist.TH
+
+import           System.IO.Unsafe
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav mFlowPersistent
+#else
+import MFlow.Wai.Blaze.Html.All hiding(select, page)
+import Menu
+#endif
+
+
+
+
+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+Person
+    name String
+    age Int Maybe
+    deriving Show
+BlogPost
+    title String
+    authorId PersonId
+    deriving Show
+|]
+
+
+
+pool= unsafePerformIO $ createSqlitePool ":memory:" 10
+
+runSQL sql= liftIO $  runSqlPersistMPool sql pool
+
+migratesqlite= runSQL $ runMigration migrateAll
+
+mFlowPersistent :: FlowM Html IO ()
+mFlowPersistent = do
+    migratesqlite              -- should be outside of the flow, in Main
+    (name, age) <- page $ (,)
+                         <$> getString Nothing <! hint "your name" <++ br
+                         <*> getInt    Nothing <! hint "your age"
+                         <** br
+                         ++> submitButton "enter"
+
+    userId <- runSQL  $ insert $ Person name $ Just age
+
+    post <- page $ getString Nothing <! hint "your post" <** submitButton "enter"
+    runSQL  $ insert $ BlogPost post userId
+
+    oneUserPost <- runSQL  $ selectList [BlogPostAuthorId ==. userId] [LimitTo 1]
+
+    page $ b << show (oneUserPost :: [Entity BlogPost]) ++> br ++> wlink () << b  "click here"
+
+    user <- runSQL  $ get userId
+
+    page $ b << show (user :: Maybe Person) ++> br ++> wlink ()  << b  "click here"
+    where
+    hint h=  [("placeholder",h)]
+
+
+ Demos/Menu.hs view
@@ -0,0 +1,460 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  Menu
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- | This is the menu shared by all the demo modules of demos-blaze.hs
+--
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings , QuasiQuotes #-}
+module Menu where
+import Data.Typeable
+import MFlow.Wai.Blaze.Html.All hiding (article, source,page,ask)
+import qualified MFlow.Wai.Blaze.Html.All as MF(page,ask)
+import Text.Blaze.Html5 as El hiding (article, source)
+import Text.Blaze.Html5.Attributes as At hiding (step)
+import Data.Monoid
+import Data.String
+import Data.TCache.Memoization
+import Data.TCache.IndexQuery
+import Data.List(isPrefixOf)
+import Language.Haskell.HsColour
+import Language.Haskell.HsColour.Colourise
+import Text.Hamlet
+import System.IO.Unsafe
+
+
+--import Debug.Trace
+--(!>) = flip trace
+
+newtype Filename= Filename String deriving Typeable
+
+adminname= getConfig "cadmin" "admin"
+edadmin= getConfig "edadmin" "editor"
+
+-- present the widget w decorated with the main menu on the left and the source code at the bottom
+page w= MF.ask $ do
+    us <- getCurrentUser
+    if us == anonymous then public else private 
+    filename <- getSessionData
+    tFieldEd edadmin "head" "set Header"
+       **> (El.div ! At.style "float:right" <<<   wlogin )
+       <++ hr
+       **> (divmenu <<< br ++>  retry  mainMenu)
+       **> (El.div ! At.style "float:right;width:65%;overflow:auto;"
+            <<< (insertForm $ widgetAndSource filename w))
+  
+divmenu= El.div
+     ! At.style ("background-color:#EEEEEE;float:left\
+                 \;width:30%;margin-left:10px;margin-right:10px;overflow:auto;")
+
+--topLogin= El.div ! At.style "float:right;top:5px;left:5px"
+--              <<< autoRefresh (pageFlow "login"  wlogin)
+
+
+ask= page
+
+
+data Options= Wiki | CountI | CountS | Radio
+            | Login | TextEdit |Grid | Autocomp | AutocompList
+            | ListEdit |Shop | Action | Ajax | Select 
+            | CheckBoxes | PreventBack | Multicounter
+            | Combination | ShopCart | MCounter   | InitialConfig  | SearchCart
+            | FViewMonad | Counter | WDialog |Push |PushDec |Trace | RESTNav
+            | Database |  MFlowPersist   | AcidState
+            | DatabaseSamples |PushSamples | ErrorTraces | Flows
+            | BasicWidgets | MonadicWidgets | DynamicWidgets | LoginLogout
+            | Templates | RuntimeTemplates | LoginWidget | CacheDataset
+            | ComplexThings | GenerateForm | GenerateFormUndo | GenerateFormUndoMsg
+            | LazyLoad
+            deriving (Bounded, Enum,Read, Show,Typeable)
+
+
+auto w= autoRefresh $ public >> maxAge 300 >> w 
+
+mainMenu :: View Html IO Options
+mainMenu= pageFlow "menu" $      
+  ul<<<(li << a ! href "/" << b "HOME"
+   ++> tFieldEd "editor" "othermenu"  "Other menu options"
+   **> (li <<<  (absLink Wiki << b "Wiki") )
+   <|> li << (b "About this menu" <> article cascade <> article menuarticle)
+   ++> hr
+   ++> ((auto $ li <<< do
+          absLink BasicWidgets << b "Basic Widgets"
+          ul <<<        
+           (hr
+           ++>(li <<< (absLink CountI << b "Increase an Int") <! noAutoRefresh
+                       <++ b " A loop that increases the Int value of a text box"
+                                   
+           <|> li <<< (absLink CountS << b "Increase a String") <! noAutoRefresh
+                       <++ b " A loop that concatenate text in a text box"
+                                   
+           <|> li <<< (absLink Select << b "Select options") <! noAutoRefresh
+                       <++ b " A combo box"
+                                   
+           <|> li <<< (absLink CheckBoxes << b "Checkboxes") <! noAutoRefresh
+           
+           <|> li <<< (absLink Radio << b "Radio buttons") <! noAutoRefresh
+           <++ hr)))
+
+   <|> (auto $ li <<<   do
+          absLink DynamicWidgets << b "Dynamic Widgets"
+             <++ " Widgets with Ajax and containers of other widgets"
+          ul <<<
+           (hr
+           ++>(li <<< (absLink Ajax         << b  "AJAX example")  <! noAutoRefresh
+                 <++  " A onclick event in a text box invokes a server procedure that \
+                          \increment the integer value"
+                 <> article ajaxl
+
+           <|> li <<< (absLink Autocomp     << b  "autocomplete")  <! noAutoRefresh
+                 <++  " Example of autocomplete, a widget which takes the suggested values from a \
+                 \ server procedure"  
+
+           <|> li <<< (absLink AutocompList << b  "autocomplete List")   <! noAutoRefresh
+                 <++  " Example of a widget that generates a set of return values, suggested by a \
+                 \ autocomplete input box"
+                 <> article editList
+
+           <|> li <<< (absLink ListEdit     << b  "list edition")    <! noAutoRefresh
+                 <++  " Example of a widget that edit, update and delete a list of user-defined \
+                 \ widgets"
+
+           <|> li <<< (absLink Grid         << b  "grid")    <! noAutoRefresh
+                 <++  " Example of the same widget In this case, containing a row of two fields,\
+                 \ aranged in a table"
+                 <> article gridl
+           <> hr)))
+
+   <|> (auto $ li <<<   do
+          absLink MonadicWidgets << b  "Monadic widgets, actions and callbacks"
+             <++ " autoRefresh, page flows, dialogs etc"
+          ul <<<                   
+            (hr
+            ++>(li <<< (absLink Action      << b  "Example of action") <! noAutoRefresh
+                <++ " executed when a widget is validated"
+
+            <|> li <<< (absLink FViewMonad   << b  "in page flow: sum of three numbers") <! noAutoRefresh
+                 <++ " Page flows are monadic widgets that modifies themselves in the page"
+                 <> article pageflow
+
+            <|> li <<< (absLink Counter      << b  "Counter")  <! noAutoRefresh
+                 <++ " A page flow which increases a counter by using a callback"
+                 <> article callbacks
+
+            <|> li <<< (absLink Multicounter << b  "Multicounter")  <! noAutoRefresh
+                 <++ " Page flow with many independent counters with autoRefresh, so they modify themselves in-place"
+                 <> article  callbacks
+
+            <|> li <<< (absLink Combination  << b  "Combination of three dynamic widgets") <! noAutoRefresh
+                 <++ " Combination of autoRefreshe'd widgets in the same page, with\
+                          \ different behaviours"
+                 <> article combinationl
+
+            <|> li <<< (absLink WDialog      << b  "Modal dialog")   <! noAutoRefresh
+                 <++ " A modal Dialog box with a form within a page flow"
+            <> hr)))
+
+   <|> (auto $ li <<< do
+          absLink DatabaseSamples << b  "Database examples"
+             <++ " with different backends"
+          ul <<<
+           (hr
+           ++>(li <<< (absLink SearchCart <<  b  "Shopping with data tier, queries and full text search") <! noAutoRefresh
+                <++  " The shopping example completed with a dynamic catalog stored using TCache"
+                <> article searchcart
+
+           <|> li <<< (absLink MFlowPersist <<  b "Persistent")  <! noAutoRefresh
+                     <++ do -- blaze-html monad
+                        " illustrates the use of MFlow with "
+                        a  "Persistent" ! href yesodweb
+                        " (In this example sqlite backend is used) "
+                        article persistentarticle
+
+           <|> li <<< (absLink Database << b  "Database") <! noAutoRefresh
+                     <++ " Create, Store and retrieve lines of text from Amazon SimpleDB \
+                            \ storage "
+                     <> article amazonarticle
+           <|> li <<< (absLink AcidState << b  "Acid State") <! noAutoRefresh
+                     <++ do  -- blaze-html monad
+                        " Create, Store and retrieve lines of text from "
+                        a ! href "http://hackage.haskell.org/package/acid-state" $ "Acid State"
+                        hr)))
+
+   <|> (auto $ li <<<   do
+          absLink PushSamples << b  "Push Samples"
+             <++ " using long polling"
+          ul <<<
+           (hr
+           ++>(li <<< (absLink Push << b  "Push example") <! noAutoRefresh
+                     <++ " A push widget in append mode receives input from \
+                             \a text box with autorefresh"
+                     <> article pushl
+                     
+           <|>   li <<< (absLink PushDec << b  "A push counter") <! noAutoRefresh
+                     <++ " Show a countdown. Then goes to the main menu"
+                     <> article pushdec
+                     <> hr)))
+
+   <|> (auto $ li <<<   do
+          absLink ErrorTraces << b  "Error Traces"
+          ul <<<
+            (hr
+            ++>(li <<< (absLink Trace << b  " Execution traces for errors") <! noAutoRefresh
+                 <++ " produces an error and show the complete execution trace"
+                 <> article errorTrace
+                 <> hr)))
+                 
+   <|> (auto $ li <<<   do
+          absLink Flows << b  "Different kinds of flows"
+          ul <<< 
+           (hr
+           ++>(li <<< (absLink RESTNav  << b  " REST navigation") <! noAutoRefresh
+                <++ " Navigates trough  menus and a sucession of GET pages"
+                <> article navigation
+
+
+           <|> li <<< (absLink ShopCart <<  b  "Stateful persistent flow: shopping") <! noAutoRefresh
+                <++ " Add articles to a persistent shopping cart stored in the session log."
+                <> i " getSessionData is read in the View monad to get the most recent shopping cart\
+                            \even when the back button has been pressed"
+                <> article stateful
+
+           <|> li <<< (absLink SearchCart <<  b  "Shopping with data tier, queries and full text search") <! noAutoRefresh
+                <++ " The shopping example completed with a dynamic catalog stored using TCache"
+                <> article searchcart
+
+           <|> li <<< (absLink MCounter << b  "Persistent stateful flow: Counter") <! noAutoRefresh
+                <++ " a persistent counter. It uses the same mechanism than shopping, but it is\
+                      \a more simple example"
+
+           <|> li <<< (absLink PreventBack  << b "Prevent going back after a transaction") <! noAutoRefresh
+                 <++ " Control backtracking to avoid navigating back to undo something that can not be undone\
+                          \. For example, a payment"
+                 <> article preventbackl
+
+           <|> li <<< (absLink InitialConfig  $ b "Initial Configuration in session parameters") <! noAutoRefresh
+                 <++ " the user is asked for some questions initially that never will be asked again \
+                       \ unless he likes to change them (all in session parameters)"
+
+                 <> hr)))
+
+  
+   <|> (auto $ li <<< do
+          absLink Templates << b "Runtime templates"
+             <++ " Templates and content management modifiable at runtime"
+          ul <<<
+           (hr
+           ++>(li <<< (absLink RuntimeTemplates << b "Runtime templates") <! noAutoRefresh
+                  <++ " Example of form templates and result templates modified at runtime"
+           <|> li <<< (absLink TextEdit << b "Content Management") <! noAutoRefresh
+                  <++ " Example of content management primitives defined in MFlow.Forms.Widgets"
+                  <> hr)))
+
+   <|> (auto $ li <<< do
+          absLink LoginLogout << b "Login/logout"
+          ul <<< (hr ++> (li <<< (absLink Login << b  "login/logout")  <! noAutoRefresh
+                             <++ " Example of using the login and/or logout"
+                             <>  hr)))
+
+   <|> (li <<< (absLink CacheDataset << b "HTTP caching")
+           <++ " Navigating an infinite dataset in the browser by caching javascript programs\
+               \ using the new composable caching directives")
+
+   <|> li <<< absLink LazyLoad << b "Lazy loading of widgets, html, images etc"
+
+   <|> (auto $ li <<< do 
+          absLink ComplexThings << b "Really complex things" <++ " Reference impementations for GUI-like apps"
+          ul <<< (hr
+                 ++> (li <<< (absLink GenerateForm << b  "A form generator and editor")   <! noAutoRefresh
+                             <++ " Add widgets and edit the layout. Execute the generated form and see the results")
+                 <|> (li <<< (absLink GenerateFormUndo << b "Form generator with undo") <! noAutoRefresh
+                             <++ " The same above application with undo edits thanks to the backtracking mechanism of MFlow")
+
+                 <|> (li <<< (absLink GenerateFormUndoMsg << b "Form generator with no page refreshes") <! noAutoRefresh
+                             <++ " The same above application with no page refresh for menu options. The form page show\
+                                   \ validation errors and results via Ajax using witerate/dField"
+
+                             <>  hr) ))
+
+   <++ li << (a ! href "/noscript/wiki/webservices" $ b "Web Services"))
+                    
+   <|> (El.div ! At.style "display:none" <<< mainMenu1))
+
+
+ -- for compatibility with older paths published that did not have two-step cascaded menus
+ -- so that /noscript/databasesampes/mflowpersist and /noscript/mflowpersist produce the same page
+
+mainMenu1 :: View Html IO Options
+mainMenu1= wcached "menu" 0 $
+ wlink MFlowPersist     mempty
+   <|> wlink Database   mempty
+   <|> wlink Push       mempty
+   <|> wlink PushDec    mempty
+   <|> wlink Trace      mempty
+   <|> wlink RESTNav    mempty
+   <|> wlink ShopCart   mempty
+   <|> wlink MCounter   mempty
+   <|> wlink CountI       mempty                           
+   <|> wlink CountS       mempty                     
+   <|> wlink Select       mempty                      
+   <|> wlink CheckBoxes   mempty
+   <|> wlink Radio        mempty      
+   <|> wlink Action       mempty
+   <|> wlink FViewMonad   mempty
+   <|> wlink Counter      mempty
+   <|> wlink Multicounter mempty
+   <|> wlink Combination  mempty
+   <|> wlink WDialog      mempty
+   <|> wlink Ajax         mempty
+   <|> wlink Autocomp     mempty
+   <|> wlink AutocompList mempty
+   <|> wlink ListEdit     mempty
+   <|>  wlink Grid         << b "grid"
+   <|>  wlink TextEdit     << b "Content Management"
+   <|>  wlink Login        << b "login/logout"
+   <|>  wlink PreventBack  << b "Prevent going back after a transaction"
+
+
+article link=  " " <> a ! At.class_ "_noAutoRefresh"  ! href link <<  i "(article)"
+
+searchcart= "http://haskell-web.blogspot.com.es/2013/04/mflow-what-about-data-tier-adding-it-to.html"
+persistentarticle= "http://haskell-web.blogspot.com.es/2013/08/mflow-using-persistent-with-sqlite.html"
+yesodweb= "http://www.yesodweb.com/book/persistent"
+amazonarticle= "http://haskell-web.blogspot.com.es/2013/08/using-amazon-web-services-with-tcache.html"
+pushdec= "http://haskell-web.blogspot.com.es/2013/07/maxwell-smart-push-counter.html"
+pushl= "http://haskell-web.blogspot.com.es/2013/07/new-push-widgets-for-presentation-of.html"
+errorTrace= "http://haskell-web.blogspot.com.es/2013/07/automatic-error-trace-generation-in.html"
+navigation= "http://haskell-web.blogspot.com.es/2013/07/the-web-navigation-monad.html"
+combinationl= "http://haskell-web.blogspot.com.es/2013/06/and-finally-widget-auto-refreshing.html"
+pageflow= "http://haskell-web.blogspot.com.es/2013/06/the-promising-land-of-monadic-formlets.html"
+callbacks= "http://haskell-web.blogspot.com.es/2013/06/callbacks-in-mflow.html"
+gridl= "http://haskell-web.blogspot.com.es/2013/01/now-example-of-use-of-active-widget.html"
+editList= "http://haskell-web.blogspot.com.es/2012/12/on-spirit-of-mflow-anatomy-of-widget.html"
+stateful= "http://haskell-web.blogspot.com.es/2013/04/more-on-session-management-in-mflow.html"
+preventbackl= "http://haskell-web.blogspot.com.es/2013/04/controlling-backtracking-in-mflow.html"
+ajaxl= "http://hackage.haskell.org/packages/archive/MFlow/0.3.1.0/doc/html/MFlow-Forms.html#g:17"
+menuarticle= "http://haskell-web.blogspot.com.es/2013/08/how-to-handle-menus-and-other.html"
+cascade="http://haskell-web.blogspot.com.es/2013/10/a-cascade-menu-coded-in-pure.html"
+
+widgetAndSource Nothing w = w
+widgetAndSource (Just(Filename filename)) w = do
+      source <- getSource filename
+      El.div <<<  tFieldEd edadmin (filename ++ "top") "top text"
+             <++ hr
+             **> h1 "Running example"
+             ++> "(in the light red box):"
+             ++> (divsample <<< w)
+--             <** tFieldEd edadmin (filename ++ "bottom") "botom text"
+             <++ do -- Blaze-html monad
+                  br
+                  hr
+                  h1 $ "Source code:"
+                  source
+                  hr
+                  disquscript
+                     
+
+      where
+      host = "mflowdemo.herokuapp.com/"
+      path = "http://" <> host <> "source/" <> filename
+      download path= p $  "download " <> a ! href  path << filename
+
+      sty=  "float:bottom\
+                \;width:100%\
+                \;margin-left:5px;margin-right:10px;overflow:auto;"
+
+divsample= El.div ! At.style ( "background-color:#FFEEEE;")
+
+stdheader  c= docTypeHtml $ do
+   El.head $ do
+     El.title "MFlow examples"
+     El.meta ! content "text/html; charset=UTF-8" ! httpEquiv "Content-Type"
+
+ 
+     El.style $ "body {\n\
+            \font-family: \"rebuchet MS\", \"Helvetica\", \"Arial\",  \"Verdana\", \"sans-serif\";\n\
+            \font-size: 90.5%;}\n\
+            \a:link {text-decoration:none;}\
+            \a:visited {text-decoration:none;}\
+            \a:hover {text-decoration:underline;}\
+            \a:active {text-decoration:underline;}"
+            
+   body  $ do
+      [shamlet|
+         <script>
+          (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+          (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+          m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+          })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+
+          ga('create', 'UA-95693-6', 'mflowdemo.herokuapp.com');
+          ga('send', 'pageview');
+
+      |]
+
+      c
+
+   where
+   sty=  "float:left\
+                \;width:100%\
+                \;margin-left:5px;margin-right:10px;overflow:auto;"
+
+showSource w filename = do
+   setSessionData $ Filename filename
+   w
+
+
+getSource file = liftIO $ cachedByKey file 0 $ do
+   source <- readFile $ "Demos/" ++ file
+   return . preEscapedToHtml
+                $  "<font size=2>"
+                ++ hscolour HTML colourPrefs False True file False source
+                ++ "</font>"
+                
+colourPrefs= unsafePerformIO readColourPrefs
+
+wiki =  page $ do+    public >> maxAge 400 >> sMaxAge 300+    pagname <- restp <|> return "index"
+    h1 ! At.style "text-align:center" <<<  tFieldEd "editor" (wikip ++pagname ++ "title.html")+                      (fromString pagname)
+        **> tFieldEd "editor" (wikip ++ pagname ++ "body.html") "Enter the body"+        <++ do+           hr+           disquscript
+
+  
+
+  
+wikip="wiki/"
+
+disquscript= [shamlet|
+    <div id="disqus_thread">
+    <script type="text/javascript">
+        /* * * CONFIGURATION VARIABLES: EDIT BEFORE PASTING INTO YOUR WEBPAGE * * */
+        var disqus_shortname = 'mflow'; // required: replace example with your forum shortname
+
+        /* * * DON'T EDIT BELOW THIS LINE * * */
+        (function() {
+            var dsq = document.createElement('script'); dsq.type = 'text/javascript'; dsq.async = true;
+            dsq.src = '//' + disqus_shortname + '.disqus.com/embed.js';
+            (document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(dsq);
+        })();
+
+    <noscript>Please enable JavaScript to view the <a href="http://disqus.com/?ref_noscript">comments powered by Disqus.
+    <a href="http://disqus.com" class="dsq-brlink">comments powered by <span class="logo-disqus">Disqus
+
+    |]
+
+
+
+wikientries= return .
+ filter (isPrefixOf "lmth.eltit"  . reverse . fst) .
+ filter  (isPrefixOf wikip . fst)  =<< indexOf tfieldKey
+
+ Demos/Multicounter.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS -XCPP #-} 
+module Multicounter ( multicounter) where
+
+import Data.Monoid 
+import Data.String
+import Counter(counterWidget)
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav multicounter
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+text= fromString
+attr= fromString
+
+multicounter= page .  pageFlow "m" $ explain
+     ++> firstOf [autoRefresh $ pageFlow (show i) (counterWidget 0) <++ hr | i <- [1..4]]
+     **> wlink () << p << "exit"
+
+ where
+ explain= do
+       p << "This example emulates the"
+       a ! href (attr "http://www.seaside.st/about/examples/multicounter")
+                << " seaside example"
+       p << "It uses various copies of the " <> a ! href (attr "/noscript/counter") << "counter widget "
+       text "instantiated in the same page. This is an example of how it is possible to "
+       text "compose widgets with independent behaviours"
+ 
+
+
+ Demos/Options.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS -XCPP #-} 
+module Options (options) where
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav options
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+options= do
+   r <- page  $ getSelect (setSelectedOption ""  (p <<  "select a option") <|>
+                         setOption "red"  (b <<  "red")                  <|>
+                         setOption "blue" (b <<  "blue")                 <|>
+                         setOption "Green"  (b <<  "Green")  )
+                         <! dosummit
+   page  $ p << (r ++ " selected") ++> wlink () (p <<  " menu")
+
+
+   where
+   dosummit= [("onchange","this.form.submit()")]
+
+-- to run it alone, change page by ask and uncomment this:
+--main= runNavigation "" $ transientNav options
+ Demos/PreventGoingBack.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS -XCPP #-} 
+module PreventGoingBack ( preventBack) where
+import System.IO.Unsafe
+import Control.Concurrent.MVar
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav preventBack
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+rpaid= unsafePerformIO $ newMVar (0 :: Int)
+
+
+preventBack= do
+    page  $ wlink "don't care" << b << "press here to pay 100000 $ "
+    payIt
+    paid  <- liftIO $ readMVar rpaid
+    preventGoingBack . page  $ p << "You already paid 100000 before"
+                           ++> p << "you can not go back until the end of the buy process"
+                           ++> wlink () << p << "Please press here to continue"
+                           
+    page  $   p << ("you paid "++ show paid)
+        ++> wlink () << p << "Press here to go to the menu or press the back button to verify that you can not pay again"
+    where
+    payIt= liftIO $ do
+      print "paying"
+      paid <- takeMVar  rpaid
+      putMVar rpaid $ paid + 100000
+
+-- to run it alone, change page by ask and uncomment this:
+--main= runNavigation "" $ transientNav preventBack
+ Demos/PushDecrease.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS -XQuasiQuotes  -XCPP #-}
+module PushDecrease ( pushDecrease) where
+
+import Control.Concurrent.STM
+import Text.Hamlet
+import Control.Concurrent
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav pushDecrease
+#else
+import MFlow.Wai.Blaze.Html.All hiding(page)
+import Menu
+#endif
+
+
+atomic= liftIO . atomically
+
+pushDecrease= do
+ tv <- liftIO $ newTVarIO 10
+
+ page $
+      [shamlet|
+       <div>
+           <h2> Maxwell Smart push counter
+           <p>  This example shows a reverse counter
+           <p>  To avoid unnecessary load, the push process will be killed when reaching 0
+           <p>  The last push message will be an script that will redirect to the menu"
+           <h3> This message will be autodestroyed within ...
+
+      |] ++> counter tv <++  b << "seconds"
+
+ where
+ counter tv = pageFlow "push" . push Html 0 $ do
+      setTimeouts 2 0     -- kill  the thread after 2 s of incactivity, when count finish
+      n <- atomic $ readTVar tv
+      if (n== -1)
+        then  do
+          script << "window.location='/'" ++> noWidget
+        else do
+          atomic $ writeTVar tv $ n - 1
+          liftIO $ threadDelay 1000000
+          h1 << (show n) ++> noWidget
+
+
+ Demos/PushSample.hs view
@@ -0,0 +1,54 @@+{-# OPTIONS   -XCPP #-}
+module PushSample (pushSample) where
+
+import Control.Concurrent.STM
+import System.IO.Unsafe
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav pushSample
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+
+
+lastLine = unsafePerformIO $ newTVarIO $ "The content will be appended here"
+  
+pushSample=  do
+  last <- liftIO $ newTVarIO ""
+  page  $ h2 << "Basic Chat as a push example"
+       ++> hr
+       ++> pageFlow "push" (push Append 1000 (disp last ) <** input )
+       **> br
+       ++> br
+       ++> wlink () << b << "exit"
+
+  where
+  -- the widget being pushed:
+  disp last = do
+      setTimeouts 100 0  -- after 100 seconds of inactivity , kill itself, but restart if needed
+      line <- tget last
+      p <<  line ++> noWidget
+
+  input = autoRefresh  $ do
+      line <- getString Nothing <** submitButton "Enter"
+      tput lastLine line
+
+
+  tput tv x = atomic $ writeTVar  tv  x
+
+  tget last = atomic $ do
+      msg <- readTVar lastLine
+      lastmsg <- readTVar last
+      case lastmsg == msg of
+         False ->  do
+            writeTVar last msg
+            return msg
+         True -> retry
+           
+
+atomic= liftIO . atomically
+
+ Demos/Radio.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS  -XCPP #-}
+module Radio ( radio) where
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav grid
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+radio = do
+   r <- page $   p << b <<  "Radio buttons"
+            ++> getRadio [\n -> fromStr v ++> setRadioActive v n | v <- ["red","green","blue"]]
+
+   page $ p << ( show r ++ " selected")  ++> wlink ()  << p <<  " menu"
+
+-- to run it alone, change page by ask and uncomment this:
+--main= runNavigation "" $ transientNav radio
+ Demos/RuntimeTemplates.hs view
@@ -0,0 +1,132 @@+-- | example of runtime templates, storage and query by using tcache
+{-# OPTIONS -XDeriveDataTypeable -XNoMonomorphismRestriction  -XCPP #-}
+module RuntimeTemplates where
+import Data.TCache.DefaultPersistence
+import Data.TCache.IndexQuery
+import Control.Workflow.Configuration
+import Data.Typeable
+import Data.Monoid
+import Data.ByteString.Lazy.Char8 as BS hiding (index)
+import Control.Exception(SomeException)
+import Control.Monad (when)
+
+-- #define ALONE -- to execute it alone, uncomment this
+
+-- Note:  there are static links in templates in the main menu. unless they
+-- are updated using  witerate/dField, the main menu of this example will not
+-- work when the app run alone since the expected paths are different.
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All  hiding(name,select,base)
+import Debug.Trace
+(!>) = flip trace
+main= runNavigation "" $ transientNav runtimeTemplates
+#else
+import MFlow.Wai.Blaze.Html.All hiding(name,select,base, page)
+import Menu
+#endif
+
+
+
+data  MyData= MyData{name :: String} deriving (Typeable,Read, Show)  
+
+instance Indexable MyData where  key=  name     -- just to notify what is the key of the register
+
+instance Serializable MyData where    -- default persistence
+   serialize=  pack . show
+   deserialize=   read . unpack
+   setPersist =   \_ -> Just filePersist      --  in files
+
+data Options= NewName | ListNames  | Exit deriving (Show, Typeable,Eq)
+
+newtype NextReg = NextReg Int deriving Typeable
+
+runtimeTemplates= do
+     -- runConfiguration is usedd to create some example registers
+     liftIO $ runConfiguration "createDataforTemplates" $ do
+             ever $ index name  -- index the name field, so I can query  for it later
+                                -- better, should put this sentence in main
+
+             -- create ['a'..'z'] entries. Only the first time
+             -- runConfiguration prevent the execution of this again
+             once $ atomically $ mapM_ (newDBRef . MyData . return) ['a'..'z']
+     process
+
+process= do
+     setSessionData $ NextReg 0  
+     r <- page  $  edTemplate "edituser" "menuallnames" 
+                $ wlink NewName   << p << "enter a new name"
+              <|> wlink ListNames << p << "List names"
+              <|> wlink Exit      << p << "Exit to the home page"
+
+     case r of
+         Exit -> return()
+         NewName -> do
+              page  $ edTemplate "edituser" "enterallnames"
+                    $ pageFlow "enter"
+                    $ witerate (
+                            do  noCache
+                                name <- dField (getString Nothing `validate` jsval)
+                                        <** submitButton "ok" <++ br
+                                -- store the register in the cache
+                                -- Later will be written by the default persistence automatically
+                                liftIO . atomically . newDBRef $ MyData name   
+                        **> do
+                             n <- countRegisters
+                             dField (wraw $ b << show n) <++ fromStr " registers added ")
+                   **> wlink () << b << "exit"
+
+         ListNames -> do
+              -- query for all the names stored in all the registers
+              allnames <- getAllNames
+
+              let len= Prelude.length allnames
+
+              page $ pageFlow "iter" $ iterateResults allnames len
+                 **> wlink "templ" << p << "click here to show the result within a runtime template"
+
+              setSessionData $ NextReg 0
+              page $ edTemplate "edituser" "listallnames"
+                   $ pageFlow "iter" $ iterateResults allnames len
+                 **> wlink "scroll" << p << "click here to present the results as a on-demand-filled scroll list"
+
+              setSessionData $ NextReg 0
+              page $ pageFlow "upd" $ appendUpdate ( do
+                          NextReg ind <- getSessionData `onNothing` return (NextReg 0)
+                          getData ind     len allnames <++ br
+                          getData (ind+1) len allnames <++ br
+                          getData (ind+2) len allnames <++ br
+                          getData (ind+3) len allnames <++ br
+                          setSessionData . NextReg $ next ind len
+                          wlink "more" << b << "more" <++ br)
+
+                  **> wlink () << p << "click here to go to the menu"
+
+     if r == Exit then return() else process
+
+     where
+     getAllNames= liftIO . atomically $ select name $ name .>.  ""
+
+     countRegisters= (getAllNames >>= return . Prelude.length)
+
+
+     iterateResults allnames len = witerate $ do
+          maxAge 300
+          NextReg ind <- getSessionData `onNothing` return (NextReg 0)
+          dField(getData  ind    len allnames) <++ br
+          dField(getData (ind+1) len allnames) <++ br
+          dField(getData (ind+2) len allnames) <++ br
+          dField(getData (ind+3) len allnames) <++ br
+          r <-    dField (wlink (next ind len) << b << "next" ) <++ fromStr " "
+              <|> dField (wlink (prev ind len) << b << "prev")
+              <|> restp
+          setSessionData $ NextReg r
+
+
+     getData i len all=  wraw . fromStr $ if i >= len || i < 0 then "" else all !! i
+     next i len = case i > len  of  True -> 0 ; _ -> i + 4
+     prev i len = case i < 0 of True -> len; _ -> i - 4
+
+     jsval s=
+         if Prelude.length s > 10 then do
+           return $ Just  $ b << "length must be less than 10 chars"
+         else return Nothing
+ Demos/SearchCart.hs view
@@ -0,0 +1,122 @@+{-# OPTIONS   -XCPP -XDeriveDataTypeable #-}
+module SearchCart (
+ searchCart
+) where
+import Data.TCache.DefaultPersistence
+import Data.TCache.DefaultPersistence
+import Data.TCache.IndexQuery as Q
+import Data.TCache.IndexText
+import Data.Maybe
+import qualified Data.Map as M
+import Control.Workflow.Configuration
+import Control.Workflow (Workflow)
+import qualified Data.Text.Lazy as T
+import Data.ByteString.Lazy.Char8
+import Data.Typeable
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" searchCart
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+type ProductName= String
+type Quantity= Int
+type Price= Float
+
+type Cart= M.Map ProductName (Quantity, Price)
+
+showCart :: Cart -> String
+showCart = show
+
+
+data Product= Product{ namep :: String
+                     , typep :: [String]
+                     , descriptionp :: String
+                     , pricep :: Price
+                     , stock :: Int}
+              deriving (Read,Show,Typeable)
+
+instance Indexable Product where
+   key prod= "Prod "++ namep prod
+
+instance Serializable Product where
+  serialize= pack . show
+  deserialize= read . unpack
+  setPersist= const $ Just filePersist
+
+createProducts= atomically $ mapM newDBRef
+    [ Product "ipad 3G"   ["gadget","pad"]   "ipad 8GB RAM, 3G"       400 200
+    , Product "ipad"      ["gadget","pad"]   "ipad 8 GB RAM"           300 300
+    , Product "iphone 3"  ["gadget","phone"] "iphone 3 nice and beatiful"  200 100
+    ]
+
+searchCart :: FlowM Html (Workflow IO) ()
+searchCart = do
+   liftIO $ runConfiguration "createprods" $ do  -- better put this in main
+        ever $ Q.index namep
+        ever $ indexList typep (Prelude.map T.pack)
+        ever $ indexText descriptionp T.pack
+        once createProducts
+   catalog
+   where
+   catalog = do
+       bought <-  step  buyProduct
+       shoppingCart bought
+       catalog
+
+
+
+   buyProduct :: FlowM Html  IO ProductName
+   buyProduct =  do
+        ttypes   <-  atomic $ allElemsOf typep
+        let types= Prelude.map T.unpack ttypes
+        r  <- page $   h1 << "Product catalog"
+                  ++> p << "search" ++> (Left <$> getString Nothing)
+                  <|> p << "or choose product types" ++>  (Right <$> showList types)
+
+        prods <- case r of
+          Left str           -> atomic $ Q.select namep $ descriptionp `contains` str
+          Right (Just type1) -> atomic $ Q.select namep $ typep `containsElem` type1
+          Right Nothing      -> return []
+
+        if Prelude.null prods
+         then do
+             page $ b << "no match " ++> wlink () << b << "search again"
+             buyProduct
+         else do
+            let search= case r of
+                            Left str ->              "for search of the term " ++ str
+                            Right (Just type1) ->    "of the type "++ type1
+
+            r <- page $ h1 << ("Products " ++ search) ++> showList prods
+            case r of
+              Nothing   -> buyProduct
+              Just prod -> breturn prod
+
+   shoppingCart bought= do
+       cart <- getSessionData `onNothing` return (M.empty :: Cart)
+       let (n,price) = fromMaybe (0,undefined) $ M.lookup  bought cart
+       (n,price) <- step $ do
+                   if n /= 0 then return (n,price) else do
+                    [price] <- atomic $ Q.select pricep $ namep .==. bought
+                    return (n, price)
+       setSessionData $ M.insert  bought (n+1,price) cart
+       step $ do
+         r <- page $  do
+              cart <- getSessionData `onNothing` return (M.empty :: Cart)
+              h1 << "Shopping cart:"
+                ++> p << showCart cart
+                ++> wlink True  << b << "continue shopping"
+                <|> wlink False << p << "proceed to buy"
+
+         if not r then page $ wlink () << "not implemented, click here"
+              else breturn ()
+
+
+   atomic= liftIO . atomically
+   showList []= wlink Nothing << p << "no results"
+   showList xs= Just <$> firstOf [wlink  x << p <<  x | x <- xs]
+ Demos/ShopCart.hs view
@@ -0,0 +1,69 @@+{-# OPTIONS  -XDeriveDataTypeable -XCPP #-}
+module ShopCart ( shopCart) where
+import Data.Typeable
+import qualified Data.Vector as V
+import Text.Blaze.Html5 as El
+import Text.Blaze.Html5.Attributes as At hiding (step)
+import Data.Monoid
+import Data.String
+import Data.Typeable+-- #define ALONE -- to execute it alone, uncomment this+#ifdef ALONE+import MFlow.Wai.Blaze.Html.All+main= runNavigation "" $ transientNav grid+#else+import MFlow.Wai.Blaze.Html.All hiding(retry, page)+import Menu+#endif+
+data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum, Show,Read , Typeable)
+
+newtype Cart= Cart (V.Vector Int) deriving Typeable+
+emptyCart= Cart $ V.fromList [0,0,0]
++shopCart= shopCart1+
+shopCart1  =  do+--     setHeader  stdheader 
+--     setTimeouts 200 $ 60*60   
+     prod <-+        step . page $ do
+             Cart cart <- getSessionData `onNothing` return  emptyCart
+
+             moreexplain
+              ++> 
+              (table ! At.style (attr "border:1;width:20%;margin-left:auto;margin-right:auto")
+              <<< caption <<  "choose an item"
+              ++> thead << tr << ( th << b <<   "item" <> th << b <<  "times chosen")
+              ++> (tbody
+                  <<< tr ! rowspan (attr "2") << td << linkHome
+                  ++> (tr <<< td <<< wlink  IPhone (b <<  "iphone")+                          <++  tdc << ( b <<  show ( cart V.! 0))
+                  <|>  tr <<< td <<< wlink  IPod   (b <<  "ipod")+                          <++  tdc << ( b <<  show ( cart V.! 1))
+                  <|>  tr <<< td <<< wlink  IPad   (b <<  "ipad")+                          <++  tdc << ( b <<  show ( cart V.! 2)))
+                  <++  tr << td <<  linkHome
+                  ))++                  
+     let i = fromEnum prod+     Cart cart <- getSessionData `onNothing` return  emptyCart
+     setSessionData . Cart $ cart V.// [(i, cart V.!  i + 1 )]
+     shopCart1
+
+    where+    tdc= td ! At.style (attr "text-align:center")
+    linkHome= a ! href  (attr $ "/" ++ noScript) << b <<  "home"
+    attr= fromString+    moreexplain= do+     p $ El.span <<(
+         "A persistent flow  (uses step). The process is killed after the timeout set by setTimeouts "++
+         "but it is restarted automatically. Event If you restart the whole server, it remember the shopping cart "+++         " The shopping cart is not logged, just the products bought returned by step are logged. The shopping cart "+++         " is rebuild from the events (that is an example of event sourcing."++
+         " .Defines a table with links that return ints and a link to the menu, that abandon this flow. "++
+         " .The cart state is not stored, Only the history of events is saved. The cart is recreated by running the history of events.")
++     p << "The second parameter of \"setTimeout\" is the time during which the cart is recorded"
+ Demos/SumView.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS  -XCPP #-}
+module SumView (sumInView) where
+
+-- #define ALONE -- to execute it alone, uncomment this
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $ transientNav grid
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+sumInView= page $ p << "ask for three numbers in the same page and display the result."
+              ++> p << "It is possible to modify the inputs and the sum will reflect it"
+              ++> sumWidget
+               
+sumWidget=   pageFlow "sum" $ do
+      n <- do
+           n1 <- p << "Enter first number"  ++> getInt Nothing <++ br
+           n2 <- p << "Enter second number" ++> getInt Nothing <++ br
+           n3 <- p << "Enter third number"  ++> getInt Nothing <++ br
+           return (n1+ n2 + n3)
+
+          -- factoring out the button
+          <**  br ++> pageFlow "button" (submitButton "submit")
+           
+      p <<  ("The result is: "++show n)  ++>  wlink () << b << " menu"
+      <++ p << "you can change the numbers in the boxes to see how the result changes"
+
+-- to run it alone, replace page by ask and uncomment the following line
+--main= runNavigation "" $ transientNav sumWidget
+ Demos/TestREST.hs view
@@ -0,0 +1,60 @@+{-# OPTIONS  -XCPP #-}
+module TestREST(testREST) where
+import Data.Monoid
+import Data.String
+
+
+
+-- to execute it alone, uncomment this
+-- #define ALONE
+#ifdef ALONE
+import MFlow.Wai.Blaze.Html.All
+main= runNavigation "" $  transientNav testREST
+#else
+import MFlow.Wai.Blaze.Html.All hiding(retry, page)
+import Menu
+#endif
+
+-- A menu with two branches, each one is a sucession of pages
+
+-- 9 pages , each page has a restful link (pagem = ask)
+
+-- to run it alone,  delete "import Menu" and uncomment the next lines
+
+-- main= runNavigation "" $ transientNav testREST
+
+-- pagem= page
+
+
+testREST= do
+  option <- page options
+
+  case option  of
+    "1" -> do
+          page $ wlink "2" << contentFor "1" 
+          page $ wlink "3" << contentFor "2"
+          page $ wlink "4" << contentFor "3"
+          page $ optionsorexit
+          return () 
+     
+    "a" -> do
+          page $ wlink "b" << contentFor "a"
+          page $ wlink "c" << contentFor "b"
+          page $ wlink "d" << contentFor "c"
+          page $ optionsorexit
+          return ()
+
+options= h2 << "Choose between:"
+         ++> absLink "a" << b << "letters " <++ i << " or "
+         <|> absLink "1" << b << "numbers"
+
+optionsorexit= options <|> wlink "home" << p << " or go to home"
+          -- if home is pressed, will return(). Otherwise, it will backtrack to one of the
+          -- two options since they are abslinks.
+
+contentFor x= do
+        p << "page for"
+        b << x
+        p << "goto next page"
+        p << "or press the back button for the previous page"
+
+ Demos/TraceSample.hs view
@@ -0,0 +1,29 @@+{-# OPTIONS -F -pgmF MonadLoc #-}
+module TraceSample ( traceSample) where
+
+import MFlow.Wai.Blaze.Html.All hiding (page)
+import Control.Monad.Loc
+
+import Menu
+-- to run it alone, remove import menu and uncomment the following line
+--main= runNavigation "" $ transientNav traceSample
+
+
+traceSample= do
+  page $  h2 << "Error trace example"
+       ++> p << "MFlow now produces execution traces in case of error by making use of the backtracking mechanism"
+       ++> p << "It is more detailed than a call stack"
+       ++> p << "this example has a deliberate error"
+       ++> br
+       ++> p << "You must be logged as admin to see the trace"
+       ++> wlink () << p << "pres here"
+
+  page $   p <<  "Please login with admin/admin"
+        ++> userWidget (Just "admin") userLogin
+
+  u <- getCurrentUser
+  page $   p << "The trace will appear after you press the link. press one of the options available at the bottom of the pagem"
+        ++> p << ("user="++ u) ++> br
+        ++> wlink () << "press here"
+  page $   error $ "this is the error"
+
+ Demos/WebService.hs view
@@ -0,0 +1,61 @@+
+module WebService where
+
+import MFlow.Wai.Blaze.Html.All
+import MFlow.Forms.WebApi
+
+import Debug.Trace
+
+
+
+-- mainRest= runNavigation "apirest" . step $ ask $
+restService :: View Html IO ()
+restService= do
+     op    <- getRestParam
+     term1 <- getRestParam
+     term2 <- getRestParam
+     case (op, term1,term2) of
+       (Just  "sum", Just x, Just y) ->  wrender (x + y :: Int) **> stop
+       (Just "prod", Just x, Just y) ->  wrender (x * y) **> stop
+       _  ->do -- blaze Html
+                 h1 << "ERROR. API usage:"
+                 h3 << "http://server/apirest/sum/[Int]/[Int]"
+                 h3 << "http://server/apirest/prod/[Int]/[Int]"
+              ++> stop
+
+
+--mainService= runNavigation "apikv" . step $ ask $
+keyValueService :: View Html IO ()
+keyValueService= do
+     op <- getRestParam
+     term1 <- getKeyValueParam "t1"
+     term2 <- getKeyValueParam "t2"
+     case (op, term1,term2) of
+       (Just  "sum", Just x, Just y) ->  wrender (x + y :: Int) **> stop
+       (Just "prod", Just x, Just y) ->  wrender (x * y) **> stop
+       _  ->do -- blaze Html
+                 h1 << "ERROR. API usage:"
+                 h3 << "http://server/apikv/sum?t1=[Int]&t2=[Int]"
+                 h3 << "http://server/apikv/prod?t1=[Int]&t2=[Int]"
+              ++> stop
+
+--mainParser  = runNavigation "apiparser" . step . asks $
+-- or
+--mainParser =do
+--  addMessageFlows[("apiparser",wstateless  parserService)]
+--  wait $ run 80 waiMessageFlow
+
+parserService :: View Html IO ()
+parserService=
+         do rest "sum"  ; disp $ (+) <$> wint "t1" <*> wint "t2"
+     <|> do rest "prod" ; disp $ (*) <$> wint "t1" <*> wint "t2"
+     <?> do -- blaze Html
+            h1 << "ERROR. API usage:"
+            h3 << "http://server/apiparser/sum?t1=[Int]&t2=[Int]"
+            h3 << "http://server/apiparser/prod?t1=[Int]&t2=[Int]"
+    where
+    asks w= ask $ w >> stop
+    wint p= wparam p :: View Html IO Int
+
+
+
+ Demos/demos-blaze.hs view
@@ -0,0 +1,145 @@+{-# OPTIONS  -XDeriveDataTypeable -XQuasiQuotes -XOverloadedStrings #-}
+module Main where
+import MFlow.Wai.Blaze.Html.All hiding (name)
+import Text.Blaze.Html5 as El
+import Text.Blaze.Html5.Attributes as At hiding (step,name)
+import Data.TCache.IndexQuery
+import Data.Typeable
+
+
+import Data.Monoid
+import Data.String
+import Text.Hamlet
+
+-- For error traces
+import Control.Monad.Loc
+
+import Menu   hiding (page)
+import TestREST
+import Actions
+import IncreaseInt
+import ShopCart
+import AjaxSample
+import IncreaseString
+import AutoCompList
+import ListEdit
+import AutoComplete
+import LoginSample
+import CheckBoxes
+import Multicounter
+import Combination
+import Options
+import ContentManagement
+import PreventGoingBack
+import Counter
+import PushDecrease
+import Dialog
+import PushSample
+import Grid
+import Radio
+import SumView
+import MCounter
+import Database
+import MFlowPersistent
+import RuntimeTemplates
+import TraceSample
+import AcidState
+import SearchCart
+import InitialConfig
+import GenerateForm
+import GenerateFormUndo
+import GenerateFormUndoMsg
+import WebService
+import CachingDataset
+import LazyLoad
+import Data.TCache.DefaultPersistence
+
+import Data.ByteString.Lazy.Char8 hiding (index)
+
+
+--import Debug.Trace
+--(!>)= flip trace
+
+
+instance Serializable Int where
+  serialize= pack . show
+  deserialize= read . unpack
+
+
+spinner= img ! src (fromString spinnerurl)
+ where
+ spinnerurl=  getConfig "spinner" "//ganglia.wikimedia.org/latest/img/spinner.gif"
+
+
+main= do
+   index tfieldKey
+
+   setAdminUser adminname  adminname
+   userRegister edadmin    edadmin
+   userRegister "edituser" "edituser"
+   syncWrite  $ Asyncronous 120 defaultCheck  1000
+   db <- initAcid
+   setFilesPath  $ getConfig "filesPath" "Demos/"
+   addMessageFlows[
+       -- Web Services --
+       ("apirest", wstateless restService),
+       ("apikv"  , wstateless keyValueService),
+       ("apiparser", wstateless  parserService)]
+   runNavigation "" $ do
+
+       setHeader $ stdheader 
+       setTimeouts 400 $ 60 * 60
+       r <- step . page $ do
+                       us <- getCurrentUser
+                       if us == anonymous then public else private
+                       tFieldEd edadmin "head" "set Header" <++ hr
+                       **> (El.div ! At.style "float:right" <<<   wlogin)
+                       **> (divmenu  <<< br ++>  mainMenu) 
+                       <** (El.div ! At.style "float:right;width:65%;overflow:auto;"
+                            <<< (tFieldEd edadmin "intro" "enter intro text"
+                            <**  tFieldEd edadmin "moreintro" "more intro text") 
+                            <++ do
+                                hr
+                                disquscript
+                                )
+ 
+
+       case r of
+             Wiki      ->    delSessionData (Filename "") >> transientNav  wiki                 
+             CountI    ->     transientNav  (clickn 0)           `showSource`  "IncreaseInt.hs"
+             CountS    ->     transientNav  (clicks "1")         `showSource`  "IncreaseString.hs"
+             Action    ->     transientNav  actions              `showSource`  "Actions.hs"
+             Ajax      ->     transientNav  ajaxsample           `showSource`  "AjaxSample.hs"
+             Select    ->     transientNav  options              `showSource`  "Options.hs"
+             CheckBoxes ->    transientNav  checkBoxes           `showSource`  "CheckBoxes.hs"
+             TextEdit  ->     transientNav  textEdit             `showSource`  "ContentManagement.hs"
+             Grid      ->     transientNav  grid                 `showSource`  "Grid.hs"
+             Autocomp  ->     transientNav  autocomplete1        `showSource`  "AutoComplete.hs"
+             AutocompList ->  transientNav  autocompList         `showSource`  "AutoCompList.hs"
+             ListEdit  ->     transientNav  wlistEd              `showSource`  "ListEdit.hs"
+             Radio     ->     transientNav  radio                `showSource`  "Radio.hs"
+             Login     ->     transientNav  loginSample          `showSource`  "LoginSample.hs"
+             PreventBack ->   transientNav  preventBack          `showSource`  "PreventGoingBack.hs"
+             Multicounter->   transientNav  multicounter         `showSource`  "Multicounter.hs"
+             FViewMonad  ->   transientNav  sumInView            `showSource`  "SumView.hs"
+             Counter     ->   transientNav  counter              `showSource`  "Counter.hs"
+             Combination ->   transientNav  combination          `showSource`  "Combination.hs"
+             WDialog     ->   transientNav  wdialog1             `showSource`  "Dialog.hs"
+             Push        ->   transientNav  pushSample           `showSource`  "PushSample.hs"
+             PushDec     ->   transientNav  pushDecrease         `showSource`  "PushDecrease.hs"
+             Trace       ->   transientNav  traceSample          `showSource`  "TraceSample.hs"
+             RESTNav     ->   transientNav  testREST             `showSource`  "TestREST.hs"
+             Database    ->   transientNav  database             `showSource`  "Database.hs"
+             ShopCart    ->   shopCart                           `showSource`  "ShopCart.hs"
+             MCounter    ->   mcounter                           `showSource`  "MCounter.hs"
+             MFlowPersist ->  transientNav mFlowPersistent       `showSource`  "MFlowPersistent.hs"
+             RuntimeTemplates -> transientNav runtimeTemplates   `showSource`  "RuntimeTemplates.hs"
+             AcidState        -> transientNav (acidState db)     `showSource`  "AcidState.hs"
+             InitialConfig -> initialConfig                      `showSource`  "InitialConfig.hs"
+             SearchCart    -> searchCart                         `showSource`  "SearchCart.hs"
+             GenerateForm  -> transientNav genForm
+             GenerateFormUndo -> transientNav genFormUndo
+             GenerateFormUndoMsg -> transientNav genFormUndoMsg
+             CacheDataset -> transientNav cachingDataset         `showSource` "CachingDataset.hs"
+             LazyLoad     -> transientNav lazyLoad               `showSource` "LazyLoad.hs"
+
LICENSE view
@@ -1,27 +1,27 @@-Copyright (c) Alberto Gómez Corona 2008--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright-   notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright-   notice, this list of conditions and the following disclaimer in the-   documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.+Copyright (c) Alberto Gómez Corona 2008
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
MFlow.cabal view
@@ -1,145 +1,145 @@-name: MFlow-version: 0.4.5.4-cabal-version: >=1.8-build-type: Simple-license: BSD3-license-file: LICENSE-maintainer: agocorona@gmail.com-stability: experimental-bug-reports: https://github.com/agocorona/MFlow/issues-synopsis: stateful, RESTful web framework-description: MFlow is a Web Framework that turns Web programing back into just ordinary programming by automating all the extra-             complexities.-             .-             The goals of MFlow are:-             .-             -To invert back the inversion of control of web applications and turn web programming into ordinary, intuitive, imperative-like, programming as seen by the programmer.-             .-             -At the same time, to maintain, for the user, all the freedom that it has in web applications.-             -For scalability-sensitive applications, to avoid the fat state snapshots that continuation based frameworks need to cope with these two previous requirements. State replication and Horizontal scalability must be possible.-             .-             -For REST advocates, to maintain the elegant notation of REST urls and the statelessness of GET requests.-             .-             -For expert haskell programmers, to reuse the already existent web libraries and techniques.-             .-             -For beginner programmers and for Software Enginners, to provide with a high level DSL of reusable, self contained widgets for the user interface, and multipage procedures that can work together provided that they statically typecheck, with zero configuration.-             .-             -For highly interactive applications, to give dynamic widgets that have their own dynamic behaviors in the page, and communicate themselves without the need of explicit  JavaScript programming.-             .-             -No deployment, in order to speed up the development process. see <http://haskell-web.blogspot.com.es/2013/05/a-web-application-in-tweet.html>-             .-             MFlow try to solve the first requirements using a different approach. The routes are expressed as normal, monadic haskell code in the FlowM monad. Local links point to alternative routes within this monadic computation just like a textual menu in a console application. Any GET page is directly reachable by means of a RESTful URL.-             .-             At any moment the flow can respond to the back button or to any RESTful path that the user may paste in the navigation bar. If the procedure is waiting for another different page, the FlowM monad backtrack until the path partially match. From this position on, the execution goes forward until the rest of the path match.  Thus, no matter the previous state of the server process, it recover the state of execution appropriate for the request. This way the server process is virtually stateless for any GET request. However, it is possible to store a session state, which may backtrack or not when the navigation goes back and forth. It is up to the programmer. Synchronization between server state and web browser state is supported out-of-the-box.-             .-             When the state matters, and user interactions can last for long, such are shopping carts etc. It uses a log for thread state persistence. The server process shut itself down after a programmer defined timeout. Once a new request of the same user arrive, the log is used to recover the process state. There is no need to store a snapshot of every continuation, just the result of each step.-             .-             State consistence and transactions are given by the TCache package. It is data cache within the STM monad (Software Transactional Memory).  Serialization and deserialization of data is programmer defined, so it can adapt it to any database, although any other database interface can be used. Default persistence in files comes out of the box for rapid development purposes.-             .-             The processes interact trough widgets, that are an extension of formlets with additional applicative combinators , formatting, link management, callbacks, modifiers, caching and AJAX. All is coded in pure haskell. Each widget return statically typed data. They can dynamically modify themselves using AJAX internally (ust prefix it with autorefresh). They are auto-contained: they may include their own JavaScript code, server code and client code in a single pure Haskell procedure that can be combined with other widgets with no other configuration.-             .-             To combine widgets, applicative combinators are used. Widgets with dynamic behaviours can use the monadic syntax and callbacks.-             .-             The interfaces and communications are abstract, but there are bindings for blaze-html, HSP, Text.XHtml and byteString, Hack and WAI but it can be extended to non Web based architectures.-             .-             Bindings for hack, and hsp >= 0.8,  are not compiled by Hackage, and do not appear, but are included in the package files. To use them, add then to the exported modules and execute cabal install-             .-             The version 0.4.5.4 add compatibility with ghc 7.8-             .-             The version 0.4.5 composable HTTP caching, lazy load, caching datasets in the browser HTTP cache-             .-             The version 0.4.0 add encrypted cookies, secure sessions, add REST web services, fixes UTF8 errors, pageFlow fixes, add onBacktrack, compensate-             .-             The version 0.3.3 run with wai 2.0-             .-             The version 0.3.2 add runtime templates. It also add witerate and dField, two modifiers for single page-             development. dField creates a placeholder for a widget that is updated via implicit AJAX by witerate.-             http://haskell-web.blogspot.com.es/2013/11/more-composable-elements-for-single.html-             .-             The version 0.3.1 included:-             .-             - Push widgets: 'http://haskell-web.blogspot.com.es/2013/07/maxwell-smart-push-counter.html'-             .-             - Complete execution traces for errors: 'http://haskell-web.blogspot.com.es/2013/07/automatic-error-trace-generation-in.html'-             .-             The version 0.3 added:-             - RESTful URLs: 'http://haskell-web.blogspot.com.es/2013/07/the-web-navigation-monad.html'-             .-             - Automatic independent refreshing of widgets via Ajax. (see 'http://haskell-web.blogspot.com.es/2013/06/and-finally-widget-auto-refreshing.html')-             .-             - Page flows: Monadic widgets that can express his own behaviour and can run its own independent page flow. (see http://haskell-web.blogspot.com.es/2013/06/the-promising-land-of-monadic-formlets.html)-             .-             - Widget callbacks, used in page flows, that change the rendering of the widget (see http://haskell-web.blogspot.com.es/2013/06/callbacks-in-mflow.html)-             .-             - Widgets in modal and non modal dialogs (using jQuery dialog)-             .-             - Other jQuery widgets as MFlow widgets-             .-             The version 0.2 added better WAI integration, higher level dynamic Widgets, content management, multilanguage, blaze-html support, stateful ajax for server-side control, user-defined data in sessions and widget requirements for automatic installation of scripts, CSS and server flows.-             .-             The version 0.1 had transparent back button management, cached widgets, callbacks, modifiers, heterogeneous formatting, AJAX, and WAI integration.-             .-             .-             See "MFlow.Forms" for details-             .-             To do:-             .-             -Clustering-             .-category: Web, Application Server-author: Alberto Gómez Corona-data-dir: ""-extra-source-files: src/MFlow/Hack.hs-                    src/MFlow/Hack/Response.hs-                    src/MFlow/Hack/XHtml.hs-                    src/MFlow/Hack/XHtml/All.hs src/MFlow/Forms/HSP.hs-                    src/MFlow/Forms/XHtml.hs-                    src/MFlow/Wai/XHtml/All.hs--source-repository head-    type: git-    location: http://github.com/agocorona/MFlow--library-    build-depends: Workflow , transformers , mtl ,-                   extensible-exceptions ,  base >4.0 && <5,-                   bytestring , containers , RefSerialize , TCache ,-                   stm >2, time, old-time , vector , directory ,-                   utf8-string , wai , case-insensitive ,-                   http-types , conduit  ,conduit-extra, text , parsec , warp ,-                   warp-tls , random , blaze-html , blaze-markup ,-                   monadloc, clientsession-    exposed-modules: MFlow MFlow.Wai.Blaze.Html.All MFlow.Forms-                     MFlow.Forms.Admin MFlow.Cookies MFlow.Wai-                     MFlow.Forms.Blaze.Html MFlow.Forms.Test-                     MFlow.Forms.Widgets MFlow.Forms.Internals-                     MFlow.Forms.WebApi MFlow.Forms.Cache-    exposed: True-    buildable: True-    hs-source-dirs: src .-    other-modules:  MFlow.Wai.Response-----executable demos-blaze---    build-depends: MFlow , RefSerialize , TCache ,---                   tcache-AWS , directory , Workflow , base ,---                   blaze-html , bytestring , containers , mtl ,---                   old-time , stm , text , transformers , vector ,---                   hamlet , shakespeare, monadloc , aws , network , hscolour ,---                   persistent-template , persistent-sqlite , persistent ,---                   conduit ,  http-conduit , monad-logger , safecopy ,---                   time---    main-is: demos-blaze.hs---    buildable: True---    hs-source-dirs: Demos---    other-modules:  TestREST ShopCart AjaxSample TraceSample IncreaseString IncreaseInt---                    AutoCompList ListEdit AutoComplete Menu RuntimeTemplates---                    LoginSample CheckBoxes Multicounter MFlowPersistent---                    Combination Options ContentManagement Database---                    PreventGoingBack Counter MCounter  PushDecrease---                    Dialog PushSample Grid Radio Actions---                    SumView AcidState SearchCart---                    InitialConfig GenerateForm GenerateFormUndo GenerateFormUndoMsg WebService---                    LazyLoad---    ghc-options: -iDemos -threaded -rtsopts---+name: MFlow
+version: 0.4.5.5
+cabal-version: >=1.8
+build-type: Simple
+license: BSD3
+license-file: LICENSE
+maintainer: agocorona@gmail.com
+stability: experimental
+bug-reports: https://github.com/agocorona/MFlow/issues
+synopsis: stateful, RESTful web framework
+description: MFlow is a Web Framework that turns Web programing back into just ordinary programming by automating all the extra
+             complexities.
+             .
+             The goals of MFlow are:
+             .
+             -To invert back the inversion of control of web applications and turn web programming into ordinary, intuitive, imperative-like, programming as seen by the programmer.
+             .
+             -At the same time, to maintain, for the user, all the freedom that it has in web applications.
+             -For scalability-sensitive applications, to avoid the fat state snapshots that continuation based frameworks need to cope with these two previous requirements. State replication and Horizontal scalability must be possible.
+             .
+             -For REST advocates, to maintain the elegant notation of REST urls and the statelessness of GET requests.
+             .
+             -For expert haskell programmers, to reuse the already existent web libraries and techniques.
+             .
+             -For beginner programmers and for Software Enginners, to provide with a high level DSL of reusable, self contained widgets for the user interface, and multipage procedures that can work together provided that they statically typecheck, with zero configuration.
+             .
+             -For highly interactive applications, to give dynamic widgets that have their own dynamic behaviors in the page, and communicate themselves without the need of explicit  JavaScript programming.
+             .
+             -No deployment, in order to speed up the development process. see <http://haskell-web.blogspot.com.es/2013/05/a-web-application-in-tweet.html>
+             .
+             MFlow try to solve the first requirements using a different approach. The routes are expressed as normal, monadic haskell code in the FlowM monad. Local links point to alternative routes within this monadic computation just like a textual menu in a console application. Any GET page is directly reachable by means of a RESTful URL.
+             .
+             At any moment the flow can respond to the back button or to any RESTful path that the user may paste in the navigation bar. If the procedure is waiting for another different page, the FlowM monad backtrack until the path partially match. From this position on, the execution goes forward until the rest of the path match.  Thus, no matter the previous state of the server process, it recover the state of execution appropriate for the request. This way the server process is virtually stateless for any GET request. However, it is possible to store a session state, which may backtrack or not when the navigation goes back and forth. It is up to the programmer. Synchronization between server state and web browser state is supported out-of-the-box.
+             .
+             When the state matters, and user interactions can last for long, such are shopping carts etc. It uses a log for thread state persistence. The server process shut itself down after a programmer defined timeout. Once a new request of the same user arrive, the log is used to recover the process state. There is no need to store a snapshot of every continuation, just the result of each step.
+             .
+             State consistence and transactions are given by the TCache package. It is data cache within the STM monad (Software Transactional Memory).  Serialization and deserialization of data is programmer defined, so it can adapt it to any database, although any other database interface can be used. Default persistence in files comes out of the box for rapid development purposes.
+             .
+             The processes interact trough widgets, that are an extension of formlets with additional applicative combinators , formatting, link management, callbacks, modifiers, caching and AJAX. All is coded in pure haskell. Each widget return statically typed data. They can dynamically modify themselves using AJAX internally (ust prefix it with autorefresh). They are auto-contained: they may include their own JavaScript code, server code and client code in a single pure Haskell procedure that can be combined with other widgets with no other configuration.
+             .
+             To combine widgets, applicative combinators are used. Widgets with dynamic behaviours can use the monadic syntax and callbacks.
+             .
+             The interfaces and communications are abstract, but there are bindings for blaze-html, HSP, Text.XHtml and byteString, Hack and WAI but it can be extended to non Web based architectures.
+             .
+             Bindings for hack, and hsp >= 0.8,  are not compiled by Hackage, and do not appear, but are included in the package files. To use them, add then to the exported modules and execute cabal install
+             .
+             The version 0.4.5.4 add compatibility with ghc 7.8
+             .
+             The version 0.4.5 composable HTTP caching, lazy load, caching datasets in the browser HTTP cache
+             .
+             The version 0.4.0 add encrypted cookies, secure sessions, add REST web services, fixes UTF8 errors, pageFlow fixes, add onBacktrack, compensate
+             .
+             The version 0.3.3 run with wai 2.0
+             .
+             The version 0.3.2 add runtime templates. It also add witerate and dField, two modifiers for single page
+             development. dField creates a placeholder for a widget that is updated via implicit AJAX by witerate.
+             http://haskell-web.blogspot.com.es/2013/11/more-composable-elements-for-single.html
+             .
+             The version 0.3.1 included:
+             .
+             - Push widgets: 'http://haskell-web.blogspot.com.es/2013/07/maxwell-smart-push-counter.html'
+             .
+             - Complete execution traces for errors: 'http://haskell-web.blogspot.com.es/2013/07/automatic-error-trace-generation-in.html'
+             .
+             The version 0.3 added:
+             - RESTful URLs: 'http://haskell-web.blogspot.com.es/2013/07/the-web-navigation-monad.html'
+             .
+             - Automatic independent refreshing of widgets via Ajax. (see 'http://haskell-web.blogspot.com.es/2013/06/and-finally-widget-auto-refreshing.html')
+             .
+             - Page flows: Monadic widgets that can express his own behaviour and can run its own independent page flow. (see http://haskell-web.blogspot.com.es/2013/06/the-promising-land-of-monadic-formlets.html)
+             .
+             - Widget callbacks, used in page flows, that change the rendering of the widget (see http://haskell-web.blogspot.com.es/2013/06/callbacks-in-mflow.html)
+             .
+             - Widgets in modal and non modal dialogs (using jQuery dialog)
+             .
+             - Other jQuery widgets as MFlow widgets
+             .
+             The version 0.2 added better WAI integration, higher level dynamic Widgets, content management, multilanguage, blaze-html support, stateful ajax for server-side control, user-defined data in sessions and widget requirements for automatic installation of scripts, CSS and server flows.
+             .
+             The version 0.1 had transparent back button management, cached widgets, callbacks, modifiers, heterogeneous formatting, AJAX, and WAI integration.
+             .
+             .
+             See "MFlow.Forms" for details
+             .
+             To do:
+             .
+             -Clustering
+             .
+category: Web, Application Server
+author: Alberto Gómez Corona
+data-dir: ""
+extra-source-files: src/MFlow/Hack.hs
+                    src/MFlow/Hack/Response.hs
+                    src/MFlow/Hack/XHtml.hs
+                    src/MFlow/Hack/XHtml/All.hs src/MFlow/Forms/HSP.hs
+                    src/MFlow/Forms/XHtml.hs
+                    src/MFlow/Wai/XHtml/All.hs
+
+source-repository head
+    type: git
+    location: http://github.com/agocorona/MFlow
+
+library
+    build-depends: Workflow , transformers , mtl ,
+                   extensible-exceptions ,  base >4.0 && <5,
+                   bytestring , containers , RefSerialize , TCache ,
+                   stm >2, time, old-time , vector , directory ,
+                   utf8-string , wai , wai-extra, resourcet, case-insensitive ,
+                   http-types , conduit  ,conduit-extra, text , parsec , warp ,
+                   warp-tls , random , blaze-html , blaze-markup ,
+                   monadloc, clientsession, pwstore-fast
+    exposed-modules: MFlow MFlow.Wai.Blaze.Html.All MFlow.Forms
+                     MFlow.Forms.Admin MFlow.Cookies MFlow.Wai
+                     MFlow.Forms.Blaze.Html MFlow.Forms.Test
+                     MFlow.Forms.Widgets MFlow.Forms.Internals
+                     MFlow.Forms.WebApi MFlow.Forms.Cache
+    exposed: True
+    buildable: True
+    hs-source-dirs: src .
+    other-modules:  MFlow.Wai.Response
+
+
+executable demos-blaze
+    build-depends: MFlow , RefSerialize , TCache ,
+                   tcache-AWS , directory , Workflow , base ,
+                   blaze-html , bytestring , containers , mtl ,
+                   old-time , stm , text , transformers , vector ,
+                   hamlet , shakespeare, monadloc , aws , network , hscolour ,
+                   persistent-template , persistent-sqlite , persistent ,
+                   conduit ,  http-conduit , monad-logger , safecopy ,
+                   time, acid-state
+    main-is: demos-blaze.hs
+    buildable: True
+    hs-source-dirs: Demos
+    other-modules:  TestREST ShopCart AjaxSample TraceSample IncreaseString IncreaseInt
+                    AutoCompList ListEdit AutoComplete Menu RuntimeTemplates
+                    LoginSample CheckBoxes Multicounter MFlowPersistent
+                    Combination Options ContentManagement Database
+                    PreventGoingBack Counter MCounter  PushDecrease
+                    Dialog PushSample Grid Radio Actions
+                    SumView AcidState SearchCart
+                    InitialConfig GenerateForm GenerateFormUndo GenerateFormUndoMsg WebService
+                    LazyLoad
+    ghc-options: -iDemos -threaded -rtsopts
+
src/MFlow.hs view
@@ -54,7 +54,7 @@               ,RecordWildCards
               ,OverloadedStrings
               ,ScopedTypeVariables
-
+              ,BangPatterns
                #-}  
 module MFlow (
 Flow, Params, HttpData(..),Processable(..)
@@ -70,9 +70,9 @@ btag, bhtml, bbody,Attribs, addAttrs
 -- * user
 , userRegister, setAdminUser, getAdminName, Auth(..),getAuthMethod, setAuthMethod
--- * static files--- * config-,config, getConfig
+-- * static files
+-- * config
+,config,getConfig
 ,setFilesPath
 -- * internal use
 ,addTokenToList,deleteTokenInList, msgScheduler,serveFile,newFlow
@@ -112,6 +112,9 @@ import qualified Data.Text as T
 import System.Posix.Internals
 import Control.Exception
+import Crypto.PasswordStore
+
+
 --import Debug.Trace
 --(!>)  =   flip trace
 
@@ -165,7 +168,7 @@       case mqs of
               Nothing  -> do
                  q  <- newEmptyMVar  -- `debug` (i++w++u)
-                 qr <- newEmptyMVar+                 qr <- newEmptyMVar
                  pblock <- newMVar True
                  let token= Token w u i  ppath penv pblock q qr
                  addTokenToList token
@@ -226,14 +229,14 @@ anonymous= "anon#"
 
 -- | It is the path of the root flow
-noScriptRef= unsafePerformIO $ newIORef "noscript"+noScriptRef= unsafePerformIO $ newIORef "noscript"
 
 noScript= unsafePerformIO $ readIORef noScriptRef
---- | set the flow to be executed when the URL has no path. The home page.------ By default it is "noscript".--- Although it is changed by `runNavigation` to his own flow name.+
+-- | set the flow to be executed when the URL has no path. The home page.
+--
+-- By default it is "noscript".
+-- Although it is changed by `runNavigation` to his own flow name.
 setNoScript scr= writeIORef noScriptRef scr
 
 {-
@@ -260,15 +263,15 @@ --emptyReceive (Token  queue _  _)= emptyQueue queue
 receive ::  Typeable a => Token -> IO a
 receive t= receiveReq t >>= return  . fromReq
-+
 flushResponse t@(Token _ _ _ _ _ _ _ qresp)= tryTakeMVar qresp
- 
+
 flushRec t@(Token _ _ _ _ _ _ queue _)= tryTakeMVar  queue   -- !> "flushRec"
 
 receiveReq ::  Token -> IO Req
-receiveReq t@(Token _ _ _ _ _ _ queue  _)= do- r <-   readMVar queue      -- !> (">>>>>> receiveReq ")+receiveReq t@(Token _ _ _ _ _ _ queue  _)= do
+ r <-   readMVar queue      -- !> (">>>>>> receiveReq ")
  return r                   -- !> "receiveReq >>>>"
 
 fromReq :: Typeable a => Req -> a
@@ -373,19 +376,19 @@   :: (Typeable a,Processable a)
   => a  -> IO (HttpData, ThreadId)
 msgScheduler x  = do
-  token <- getToken x+  token <- getToken x
   th <- myThreadId
-  let wfname = takeWhile (/='/') $ pwfname x+  let wfname = takeWhile (/='/') $ pwfname x
   criticalSection (tblock token) $ do
      sendToMF token x                             -- !> show th                             
      th <- startMessageFlow wfname token     
      r  <- recFromMF token                          
      return (r,th)                                --  !> let HttpData _ _ r1=r in B.unpack r1 
-  where+  where
   criticalSection mv f= bracket
       (takeMVar mv)
       (putMVar mv)
-      $ const $ f+      $ const $ f
       
   --start the flow if not started yet
   startMessageFlow wfname token = 
@@ -395,7 +398,7 @@         case r of
           Left NotFound -> do
                  (sendFlush token =<<  serveFile  (pwfname x))
-                    `CE.catch` \(e:: CE.SomeException) -> do+                    `CE.catch` \(e:: CE.SomeException) -> do
                        showError wfname token (show e)
 --                     sendFlush token (Error NotFound $ "Not found: " <> pack wfname)
                        deleteTokenInList token
@@ -459,7 +462,8 @@ 
 _authMethod= unsafePerformIO $ newIORef $ Auth tCacheRegister tCacheValidate
 
--- | set an authentication method
+-- | set an authentication method. That includes the registration and validation calls.
+-- both return Nothing if sucessful. Otherwise they return a text mesage explaining the failure
 setAuthMethod auth= writeIORef _authMethod auth
 
 getAuthMethod = readIORef _authMethod
@@ -469,8 +473,8 @@             { userName :: String
             , upassword :: String
             } deriving (Read, Show, Typeable)
- 
+
 eUser= User (error1 "username") (error1 "password")
 
 error1 s= error $ s ++ " undefined"
@@ -489,117 +493,114 @@   
 -- | Register an user/password 
 tCacheRegister ::  String -> String  -> IO (Maybe String)
-tCacheRegister user password  =  atomically $ do
-     withSTMResources [newuser]  doit
+tCacheRegister user password= tCacheRegister' 14 user password
+
+tCacheRegister' strength user password= do
+     salted_password <- makePassword (SB.pack password) strength
+     atomically $ do
+         let newuser = User user (SB.unpack salted_password)
+         withSTMResources [newuser] $ doit newuser
      where
-     newuser= User user password
-     doit [Just (User _ _)] = resources{toReturn= Just "user already exist"}
-     doit [Nothing] = resources{toAdd= [newuser],toReturn= Nothing}
+         doit newuser [Just (User _ _)] = resources{toReturn= Just "user already exist"}
+         doit newuser [Nothing] = resources{toAdd= [newuser],toReturn= Nothing}
 
+
+--     withSTMResources [newuser]  doit
+--     where
+--     newuser= User user password
+--     doit [Just (User _ _)] = resources{toReturn= Just "user already exist"}
+--     doit [Nothing] = resources{toAdd= [newuser],toReturn= Nothing}
+
 tCacheValidate ::  UserStr -> PasswdStr -> IO (Maybe String)
 tCacheValidate  u p =
     let user= eUser{userName=u}
-    in  atomically
+    in atomically
      $ withSTMResources [user]
      $ \ mu -> case mu of
          [Nothing] -> resources{toReturn= err }
-         [Just (User _ pass )] -> resources{toReturn= 
-               case pass==p  of
-                 True -> Nothing
-                 False -> err
+         [Just u@(User _ pass )] -> resources{toReturn =
+               case verifyPassword (SB.pack p) (SB.pack pass)
+                    || pass== p of   -- for backward compatibility for unhashed passwords
+                  True -> Nothing
+                  False -> err
                }
-
      where
      err= Just  "Username or password invalid"
 
-userRegister u p= liftIO $ do
+-- | register an user with the auth Method
+userRegister :: MonadIO m => UserStr -> PasswdStr -> m (Maybe String)
+userRegister !u !p= liftIO $ do
    Auth reg _ <- getAuthMethod :: IO Auth
    reg u p
 
 
 newtype Config= Config1 (M.Map String String) deriving (Read,Show,Typeable)
----defConfig= Config1 $ M.fromList---            [("cadmin","admin")---            ,("cjqueryScript","//ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js")---            ,("cjqueryCSS","//code.jquery.com/ui/1.10.3/themes/smoothness/jquery-ui.css")---            ,("cjqueryUI","//code.jquery.com/ui/1.10.3/jquery-ui.js")---            ,("cnicEditUrl","//js.nicedit.com/nicEdit-latest.js")] 
-data Config0 = Config{cadmin :: UserStr           -- ^ Administrator name-                     ,cjqueryScript :: String     -- ^ URL of jquery-                     ,cjqueryCSS    :: String     -- ^ URL of jqueryCSS-                     ,cjqueryUI     :: String     -- ^ URL of jqueryUI-                     ,cnicEditUrl    :: String    -- ^ URL of the nicEdit  editor-                     }+
+data Config0 = Config{cadmin :: UserStr           -- ^ Administrator name
+                     ,cjqueryScript :: String     -- ^ URL of jquery
+                     ,cjqueryCSS    :: String     -- ^ URL of jqueryCSS
+                     ,cjqueryUI     :: String     -- ^ URL of jqueryUI
+                     ,cnicEditUrl    :: String    -- ^ URL of the nicEdit  editor
+                     }
                     deriving (Read, Show, Typeable)
----defConfig0= Config "admin" "//ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js"---                           "//code.jquery.com/ui/1.10.3/themes/smoothness/jquery-ui.css"---                           "//code.jquery.com/ui/1.10.3/jquery-ui.js"---                           "//js.nicedit.com/nicEdit-latest.js"------writeDefConfig0= writeFile "sal" $ show defConfig0--change :: Config0 -> Config-change Config{..} = Config1 $ M.fromList-            [("cadmin",cadmin )-            ,("cjqueryScript", cjqueryScript)-            ,("cjqueryCSS",cjqueryCSS)-            ,("cjqueryUI",cjqueryUI)-            ,("cnicEditUrl",cnicEditUrl)]--config :: M.Map String String-config= unsafePerformIO $! do-  Config1 c <- atomically $! readConfig-  return c--readConfig=  readDBRef rconf `onNothing`  return (Config1 $ M.fromList []) -- defConfig--readOld :: ByteString -> Config-readOld s= (change . read . B.unpack $ s) 
+
+change :: Config0 -> Config
+change Config{..} = Config1 $ M.fromList
+            [("cadmin",cadmin )
+            ,("cjqueryScript", cjqueryScript)
+            ,("cjqueryCSS",cjqueryCSS)
+            ,("cjqueryUI",cjqueryUI)
+            ,("cnicEditUrl",cnicEditUrl)]
+
+config :: M.Map String String
+config= unsafePerformIO $! do
+  Config1 c <- atomically $! readConfig
+  return c
+
+readConfig=  readDBRef rconf `onNothing`  return (Config1 $ M.fromList []) -- defConfig
+
+readOld :: ByteString -> Config
+readOld s= (change . read . B.unpack $ s)
+
 keyConfig= "mflow.config"
-instance Indexable Config where key _= keyConfig-+instance Indexable Config where key _= keyConfig
+
 rconf :: DBRef Config
 rconf= getDBRef keyConfig
 
 instance  Serializable Config where
-  serialize = B.pack . show
-  deserialize s = unsafePerformIO $  (return $! read $! B.unpack s)+  serialize (Config1 c)= B.pack  $ "Config1 (fromList[\n" <> (concat . intersperse ",\n" $ map show (M.toList c)) <> "])"
+  deserialize s = unsafePerformIO $  (return $! read $! B.unpack s)
                    `CE.catch` \(e :: SomeException) ->  return (readOld s)
   setPersist = \_ -> Just filePersist
---- | read a config variable from the config file \"mflow.config\". if it is not set, uses the second parameter and--- add it to the configuration list, so next time the administrator can change it in the configuration file-getConfig k v= case M.lookup k config of-     Nothing -> unsafePerformIO $ setConfig k v >> return v-     Just s  -> s---- | set an user-defined config variable-setConfig k v=   atomically $ do-   Config1 conf <- readConfig
-   writeDBRef rconf $ Config1 $ M.insert k v conf
----- user --- 
+-- | read a config variable from the config file \"mflow.config\". if it is not set, uses the second parameter and
+-- add it to the configuration list, so next time the administrator can change it in the configuration file
+getConfig k v=  case M.lookup k config of
+     Nothing -> unsafePerformIO $ setConfig k v >> return v
+     Just s  -> s
+
+-- | set an user-defined config variable
+setConfig k v= atomically $ do
+     Config1 conf <-  readConfig
+     writeDBRef rconf $ Config1 $ M.insert k v conf
+
+
+-- user ---
+
 type UserStr= String
 type PasswdStr= String
----- | set the Administrator user and password.--- It must be defined in Main , before any configuration parameter is read, before the execution+
+
+-- | set the Administrator user and password.
+-- It must be defined in Main , before any configuration parameter is read, before the execution
 -- of any flow
 setAdminUser :: MonadIO m => UserStr -> PasswdStr -> m ()
 setAdminUser user password= liftIO $  do
-  userRegister user password-  setConfig "cadmin" user---  atomically $ do---   Config1 conf <- readConfig
---   writeDBRef rconf $ Config1 $ M.insert "cadmin" user conf
-+  userRegister user password
+  setConfig "cadmin" user
 
 
 getAdminName= getConfig "cadmin"  "admin"
@@ -679,7 +680,7 @@ -- It uses 'Data.TCache.Memoization'. 
 -- The caching-uncaching follows the `setPersist` criteria
 setFilesPath :: MonadIO m => String -> m ()
-setFilesPath path= liftIO $ writeIORef rfilesPath path
+setFilesPath !path= liftIO $ writeIORef rfilesPath path
 
 rfilesPath= unsafePerformIO $ newIORef "files/"
src/MFlow/Cookies.hs view
@@ -78,7 +78,7 @@           xs5  = B.dropWhile (==' ') xs4
       in  f xs5 ((name,val):r)
 
-----------------------------+----------------------------
 
 --readEnv :: Parser [(String,String)] 
 readEnv = (do
src/MFlow/Forms.hs view
@@ -75,7 +75,7 @@ formLets (<http://www.haskell.org/haskellwiki/Formlets>) with the addition of caching, links, formatting, attributes,
  extra combinators, callbaks and modifiers.
 The interaction with the user is  stateful. In the same computation there may be  many
-request-response interactions, in the same way than in the case of a console applications. 
+request-response interactions, in the same way than in the case of a console applications.
 
 * APPLICATION SERVER
 
@@ -221,8 +221,8 @@ getString,getInt,getInteger, getTextBox
 ,getMultilineText,getBool,getSelect, setOption,setSelectedOption, getPassword,
 getRadio, setRadio, setRadioActive, wlabel, getCheckBoxes, genCheckBoxes, setCheckBox,
-submitButton,resetButton, whidden, wlink, absLink, getKeyValueParam,-getRestParam, returning, wform, firstOf, manyOf, allOf, wraw, wrender, notValid+submitButton,resetButton, whidden, wlink, absLink, getKeyValueParam, fileUpload,
+getRestParam, returning, wform, firstOf, manyOf, allOf, wraw, wrender, notValid
 -- * FormLet modifiers
 ,validate, noWidget, stop, waction, wcallback, wmodify,
 
@@ -258,13 +258,13 @@ -- * controlling backtracking
 ,goingBack,returnIfForward, breturn, preventGoingBack, compensate, onBacktrack, retry
 
--- * Setting parameters+-- * Setting parameters
 ,setHttpHeader
 ,setHeader
 ,addHeader
 ,getHeader
 ,setSessionData
-,getSessionData+,getSessionData
 ,getSData
 ,delSessionData
 ,setTimeouts
@@ -281,7 +281,7 @@ ,Requirements(..)
 ,WebRequirement(..)
 ,requires
--- * Utility+-- * Utility
 ,getSessionId
 ,getLang
 ,genNewId
@@ -300,8 +300,8 @@ import MFlow
 import MFlow.Forms.Internals
 import MFlow.Cookies
-import Data.ByteString.Lazy.Char8 as B(ByteString,cons,append,empty,fromChunks,unpack)-import Data.ByteString.Lazy.UTF8 hiding (length, take)+import Data.ByteString.Lazy.Char8 as B(ByteString,cons,append,empty,fromChunks,unpack)
+import Data.ByteString.Lazy.UTF8 hiding (length, take)
 import qualified Data.String as S
 import qualified Data.Text as T
 import Data.Text.Encoding
@@ -423,7 +423,7 @@              a -> String -> View view m  (Radio a)
 setRadioActive  v n = View $ do
   st <- get
-  put st{needForm= HasElems}
+  put st{needForm= HasElems }
   let env =  mfEnv st
   mn <- getParam1 n env
   let str = if typeOf v == typeOf(undefined :: String)
@@ -676,12 +676,20 @@ 
     return . FormElm (foption n val check)  . Just $ MFOption nam
 
---fileUpload :: (FormInput view,
---      Monad  m) =>
---      View view m T.Text---fileUpload= getParam Nothing "file" Nothing-+-- | upload a file to a temporary file in the server
+--
+-- The user can move, rename it etc.
+fileUpload :: (FormInput view,
+      Monad  m,Functor m) =>
+      View view m (String
+                  ,String
+                  ,String
+                  ) -- ^ ( original file, file type, temporal uploaded)
+fileUpload=
+  getParam Nothing "file" Nothing <** modify ( \st ->  st{mfFileUpload = True})
 
+
+
 -- | Enclose Widgets within some formating.
 -- @view@ is intended to be instantiated to a particular format
 --
@@ -708,7 +716,7 @@          -> View view m a
          -> View view m a
 (<<<) v form= View $ do
-  FormElm f mx <- runView form 
+  FormElm f mx <- runView form
   return $ FormElm (v  f) mx
 
 
@@ -721,9 +729,9 @@ 
 -- | Append formatting code to a widget
 --
--- @ getString "hi" <++ H1 << "hi there"@
+-- @ getString "hi" '<++' H1 '<<' "hi there"@
 --
--- It has a infix prority: @infixr 6@ higuer that '<<<' and most other operators
+-- It has a infix prority: @infixr 6@ higher than '<<<' and most other operators.
 (<++) :: (Monad m, Monoid v)
       => View v m a
       -> v
@@ -732,25 +740,25 @@   FormElm f mx <-  runView  form
   return $ FormElm ( f <> v) mx
 
-infixr 6  ++> 
-infixr 6 <++ 
+infixr 6  ++>
+infixr 6 <++
 -- | Prepend formatting code to a widget
 --
--- @bold << "enter name" ++> getString Nothing @
+-- @bold '<<' "enter name" '++>' 'getString' 'Nothing' @
 --
--- It has a infix prority: @infixr 6@ higuer that '<<<' and most other operators
+-- It has a infix prority: @infixr 6@ higher than '<<<' and most other operators
 (++>) :: (Monad m,  Monoid view)
        => view -> View view m a -> View view m a
 html ++> w =  --  (html <>) <<< digest
  View $ do
-  FormElm f mx <- runView w 
+  FormElm f mx <- runView w
   return $ FormElm (html  <>  f) mx
 
 
 
 -- | Add attributes to the topmost tag of a widget
 --
--- it has a fixity @infix 8@
+-- It has a fixity @infix 8@
 infixl 8 <!
 widget <! attribs= View $ do
       FormElm fs  mx <- runView widget
@@ -798,12 +806,12 @@      Monad m, Functor m) =>
      View view m a
 noWidget= Control.Applicative.empty
---- | a sinonym of noWidget that can be used in a monadic expression in the View monad does not continue+
+-- | a sinonym of noWidget that can be used in a monadic expression in the View monad does not continue
 stop :: (FormInput view,
      Monad m, Functor m) =>
-     View view m a-stop= Control.Applicative.empty+     View view m a
+stop= Control.Applicative.empty
 
 -- | Render a Show-able  value and return it
 wrender
@@ -924,7 +932,7 @@      when (u /= uname) $ do
          let t'= t{tuser= uname}
     --     moveState (twfname t) t t'
-         put st{mfToken= t'} 
+         put st{mfToken= t'}
          liftIO $ deleteTokenInList t
          liftIO $ addTokenToList t'
          setCookieFunc cookieuser   uname "/"  (Just $ 365*24*60*60)
@@ -941,7 +949,7 @@   :: (Num a1,S.IsString a, MonadIO m,
       MonadState (MFlowState view) m) =>
      (String -> [Char] -> a -> Maybe a1 -> m ()) -> m ()
-logout' setCookieFunc = do+logout' setCookieFunc = do
     public
     back <- goingBack
     if back then return () else do
@@ -1015,12 +1023,12 @@ -- other state in the flow if the request has the required parameters.
 ask :: (FormInput view) =>
        View view IO a -> FlowM view IO a
-ask w =  do+ask w =  do
  resetCachePolicy
- st1 <- get >>= \s -> return s{mfSequence=-                                   let seq= mfSequence s in-                                   if seq ==inRecovery then 0 else seq-                              ,mfHttpHeaders =[],mfAutorefresh= False } 
+ st1 <- get >>= \s -> return s{mfSequence=
+                                   let seq= mfSequence s in
+                                   if seq ==inRecovery then 0 else seq
+                              ,mfHttpHeaders =[],mfAutorefresh= False }
  if not . null $ mfTrace st1 then fail "" else do
   -- AJAX
   let env= mfEnv st1
@@ -1034,18 +1042,20 @@      ask w
   -- END AJAX
 
-   _ ->   do----  mfPagePath : contains the REST path of the page.---  it is set for each page---  if it does not exist then it comes from a state recovery, backtrack (to fill-in the field)-    let pagepath = mfPagePath st1-    if null pagepath then fail ""                                   -- !> "null pagepath"---  if exist and it is not prefix of the current path being navigated to, backtrack-      else if not $  pagepath `isPrefixOf` mfPath st1 then fail ""    -- !> ("pagepath fail with "++ show (mfPath st1))-       else do-   
-     let st= st1{needForm= NoElems, inSync= False, mfRequirements= [], linkMatched= False} 
+   _ ->   do
+
+--  mfPagePath : contains the REST path of the page.
+--  it is set for each page
+--  if it does not exist then it comes from a state recovery, backtrack (to fill-in the field)
+    let pagepath = mfPagePath st1
+    if null pagepath then fail ""                                   -- !> "null pagepath"
+--  if exist and it is not prefix of the current path being navigated to, backtrack
+      else if not $  pagepath `isPrefixOf` mfPath st1 then fail ""    -- !> ("pagepath fail with "++ show (mfPath st1))
+       else do
+
+     let st= st1{needForm= NoElems, inSync= False, linkMatched= False
+                 ,mfRequirements= []
+                 ,mfInstalledScripts=  if newAsk st1 then [] else mfInstalledScripts st1}
      put st
      FormElm forms mx <- FlowM . lift  $ runView  w
      setCachePolicy
@@ -1065,37 +1075,35 @@           then fail ""                                  -- !> "FAIL sync"
           else if mfAutorefresh st' then do
                      resetState st st'                 -- !> ("EN AUTOREFRESH" ++ show [ mfPagePath st,mfPath st,mfPagePath st'])
---                     modify $ \st -> st{mfPagePath=mfPagePath st'} !> "REPEAT"+--                     modify $ \st -> st{mfPagePath=mfPagePath st'} !> "REPEAT"
                      FlowM $ lift  nextMessage
-                     ask w                                 
+                     ask w
           else do
-             reqs <-  FlowM $ lift installAllRequirements     --  !> "REPEAT"-             
+             reqs <-  FlowM $ lift installAllRequirements     --  !> "REPEAT"
+             st' <- get
              let header= mfHeader st'
                  t= mfToken st'
-             cont <- case (needForm1 st') of
-                      True ->  do
+             cont <- case (needForm st') of
+                      HasElems  ->  do
                                frm <- formPrefix  st' forms False   -- !> ("formPrefix="++ show(mfPagePath st'))
                                return . header $  reqs <> frm
-                      _    ->  return . header $  reqs <> forms
+                      _     ->  return . header $  reqs <> forms
 
              let HttpData ctype c s= toHttpData cont
              liftIO . sendFlush t $ HttpData (ctype ++ mfHttpHeaders st') (mfCookies st' ++ c) s
-                          
 
              resetState st st'
-             FlowM $ lift  nextMessage         -- !> "NEXTMESSAGE"+             FlowM $ lift  nextMessage         -- !> "NEXTMESSAGE"
              ask w
     where
     resetState st st'=
              put st{mfCookies=[]
-                 --  ,mfHttpHeaders=[]
+                   ,mfInstalledScripts= mfInstalledScripts st'
                    ,newAsk= False
                    ,mfToken= mfToken st'
                    ,mfPageFlow= mfPageFlow st'
                    ,mfAjax= mfAjax st'
---                   ,mfSeqCache= mfSeqCache st'
-                   ,mfData= mfData st' } 
+                   ,mfData= mfData st' }
 
 
 -- | A synonym of ask.
@@ -1121,24 +1129,20 @@          inPageFlow= mfPagePath st `isPrefixOf` npath
 
      put st{ mfPath= npath
-
-
-           , mfPageFlow= inPageFlow 
-
-           , mfEnv= env }                       
-
+           , mfPageFlow= inPageFlow
+           , mfEnv= env }
 
      where
 
-     comparePaths _ n [] xs=  n
-     comparePaths  o n _ [] = o
-     comparePaths  o n (v:path) (v': npath) | v== v' = comparePaths o (n+1)path npath
-                                        | otherwise= n
+--     comparePaths _ n [] xs=  n
+--     comparePaths  o n _ [] = o
+--     comparePaths  o n (v:path) (v': npath) | v== v' = comparePaths o (n+1)path npath
+--                                        | otherwise= n
 
      updateParams :: Bool -> Params -> Params -> Params
      updateParams False _ req= req
      updateParams True env req=
-        let params= takeWhile isparam env
+        let params= takeWhile isparam req -- env
             fs= fst $ head req
             parms= (case findIndex (\p -> fst p == fs)  params of
                       Nothing -> params
@@ -1160,7 +1164,7 @@ wstateless
   :: (Typeable view,  FormInput view) =>
      View view IO () -> Flow
-wstateless w =  runFlow . transientNav . ask $ w **> (stop `asTypeOf` w) 
+wstateless w =  runFlow . transientNav . ask $ w **> (stop `asTypeOf` w)
 
 
 
@@ -1172,18 +1176,19 @@ -- there are more than one form in the page.
 wform ::  (Monad m, FormInput view)
           => View view m b -> View view m b
-wform x = View $ do
-     FormElm form mr <- (runView $   x )
-     st <- get
-     form1 <- formPrefix st form True
-     put st{needForm=HasForm}
-     return $ FormElm form1 mr
+wform= insertForm
+--wform x = View $ do
+--     FormElm form mr <- (runView $   x )
+--     st <- get
+--     form1 <- formPrefix st form True
+--     put st{needForm=HasForm}
+--     return $ FormElm form1 mr
 
 
 
 
 resetButton :: (FormInput view, Monad m) => String -> View view m ()
-resetButton label= View $ return $ FormElm (finput  "reset" "reset" label False Nothing)+resetButton label= View $ return $ FormElm (finput  "reset" "reset" label False Nothing)
                         $ Just ()
 
 submitButton :: (FormInput view, Monad m) => String -> View view m String
@@ -1258,20 +1263,21 @@    ftag "label" str `attrs` [("for",id)] ++> w <! [("id",id)]
 
 
--- | Creates a link to a the next step within the flow.--- A link can be composed with other widget elements.---  It can not be broken by its own definition.--- It points to the page that created it. 
+-- | Creates a link to a the next step within the flow.
+-- A link can be composed with other widget elements.
+--  It can not be broken by its own definition.
+-- It points to the page that created it.
 wlink :: (Typeable a, Show a, MonadIO m,  FormInput view)
          => a -> view -> View  view m a
 wlink x v=    View $ do
       verb <- getWFName
-      st   <- get+      st   <- get
 
-      let name = mfPrefix st ++ (map toLower $ if typeOf x== typeOf(undefined :: String)
+      let name = --mfPrefix st ++
+                (map toLower $ if typeOf x== typeOf(undefined :: String)
                                    then unsafeCoerce x
                                    else show x)
-          lpath = mfPath st+          lpath = mfPath st
           newPath= mfPagePath st  ++ [name]
 
       r <- if  linkMatched st  then return Nothing -- only a link match per page or monadic sentence in page
@@ -1279,67 +1285,68 @@              case  newPath `isPrefixOf` lpath   of
              True -> do
                   modify $ \s -> s{inSync= True
-                                 ,linkMatched= True+                                 ,linkMatched= True
                                  ,mfPagePath= newPath }
 
-                  return $ Just x+                  return $ Just x
 --                         !> (name ++ "<-" ++ "link path=" ++show newPath)
-             False ->  return Nothing---                         !> ( "NOT MATCHED "++name++" link path= "++show newPath+             False ->  return Nothing
+--                         !> ( "NOT MATCHED "++name++" link path= "++show newPath
 --                             ++ "path="++  show lpath)
-+
       let path= concat ['/':v| v <- newPath ]
       return $ FormElm (flink path v) r
---- Creates an absolute link. While a `wlink` path depend on the page where it is located and--- ever points to the code of the page that had it inserted, an absLink point to the first page--- in the flow that inserted it. It is useful for creating a backtracking point in combination with `retry`------ >   page $ absLink "here" << p << "here link"--- >   page $ p << "second page" ++> wlink () << p << "click here"--- >   page $ p << "third page" ++> retry (absLink "here" << p << "will go back")--- >   page $ p << "fourth page" ++> wlink () << p << "will not reach here"------ After navigating to the third page, when--- ckicking in the link, will backtrack to the first, and will validate the first link as if the click--- where done in the first page. Then the second page would be displayed.------ In monadic widgets, it also backtrack to the statement where the absLink is located without the--- need of retry:------ >   page $ do--- >     absLink "here" << p << "here link"--- >     p << "second statement" ++> wlink () << p << "click here"--- >     p << "third statement" ++> (absLink "here" << p << "will present the first statement alone")--- >     p << "fourth statement" ++> wlink () << p << "will not reach here"---absLink x  = wcached  (show x) 0 . wlink x+
+-- Creates an absolute link. While a `wlink` path depend on the page where it is located and
+-- ever points to the code of the page that had it inserted, an absLink point to the first page
+-- in the flow that inserted it. It is useful for creating a backtracking point in combination with `retry`
+--
+-- >   page $ absLink "here" << p << "here link"
+-- >   page $ p << "second page" ++> wlink () << p << "click here"
+-- >   page $ p << "third page" ++> retry (absLink "here" << p << "will go back")
+-- >   page $ p << "fourth page" ++> wlink () << p << "will not reach here"
+--
+-- After navigating to the third page, when
+-- ckicking in the link, will backtrack to the first, and will validate the first link as if the click
+-- where done in the first page. Then the second page would be displayed.
+--
+-- In monadic widgets, it also backtrack to the statement where the absLink is located without the
+-- need of retry:
+--
+-- >   page $ do
+-- >     absLink "here" << p << "here link"
+-- >     p << "second statement" ++> wlink () << p << "click here"
+-- >     p << "third statement" ++> (absLink "here" << p << "will present the first statement alone")
+-- >     p << "fourth statement" ++> wlink () << p << "will not reach here"
+--absLink x  = wcached  (show x) 0 . wlink x
 absLink x v=    View $ do
       verb <- getWFName
-      st   <- get+      st   <- get
 
-      let name = mfPrefix st ++ (map toLower $ if typeOf x== typeOf(undefined :: String)
+      let name = -- mfPrefix st
+                (map toLower $ if typeOf x== typeOf(undefined :: String)
                                    then unsafeCoerce x
                                    else show x)
--          lpath = mfPath st+
+          lpath = mfPath st
           newPath= mfPagePath st ++ [name]
       r <- if  linkMatched st  then return Nothing -- only a link match per page or monadic sentence in page
            else
              case  newPath `isPrefixOf` lpath   of
              True -> do
                   modify $ \s -> s{inSync= True
-                                 ,linkMatched= True+                                 ,linkMatched= True
                                  ,mfPagePath= newPath }
 
                   return $ Just x                             --  !> (name ++ "<- abs" ++ "lpath=" ++show lpath)
              False ->  return Nothing                         --  !> ( "NOT MATCHED "++name++" LP= "++show  lpath)
-+
       path <- liftIO $ cachedByKey (show x) 0 . return $ currentPath st ++ ('/':name)
-+
       return $ FormElm (flink path v) r  -- !> name
-- 
+
+
 -- | When some user interface return some response to the server, but it is not produced by
 -- a form or a link, but for example by an script, @returning@  convert this code into a
 -- widget.
@@ -1378,7 +1385,7 @@ 
 -- | Concat a list of widgets of the same type, return a the first validated result
 firstOf :: (FormInput view, Monad m, Functor m)=> [View view m a]  -> View view m a
-firstOf xs= foldl' (<|>) noWidget xs+firstOf xs= foldl' (<|>) noWidget xs
 --  View $ do
 --      forms <- mapM runView  xs
 --      let vs  = concatMap (\(FormElm v _) ->  [mconcat v]) forms
@@ -1393,13 +1400,13 @@       let vs  = mconcat $ map (\(FormElm v _) ->   v) forms
           res1= catMaybes $ map (\(FormElm _ r) -> r) forms
       return . FormElm vs $ Just res1)
---- | like manyOf, but does not validate if one or more of the widgets does not validate-allOf xs= manyOf xs `validate` \rs ->-      if length rs== length xs-         then return Nothing-         else return $ Just mempty 
+-- | like manyOf, but does not validate if one or more of the widgets does not validate
+allOf xs= manyOf xs `validate` \rs ->
+      if length rs== length xs
+         then return Nothing
+         else return $ Just mempty
+
 (>:>) :: (Monad m, Monoid v) => View v m a -> View v m [a]  -> View v m [a]
 (>:>) w ws = View $ do
     FormElm fs mxs <- runView $  ws
@@ -1420,9 +1427,9 @@ (|*>) x xs= View $ do
   fs <-  mapM runView  xs
   FormElm fx rx   <- runView  x
-  let (fxs, rxss) = unzip $ map (\(FormElm v r) -> (v,r)) fs-      rs= filter isJust rxss-      rxs= if null rs then Nothing else  head rs 
+  let (fxs, rxss) = unzip $ map (\(FormElm v r) -> (v,r)) fs
+      rs= filter isJust rxss
+      rxs= if null rs then Nothing else  head rs
   return $ FormElm (fx <> mconcat (intersperse  fx fxs) <> fx)
          $ case (rx,rxs) of
             (Nothing, Nothing) -> Nothing
@@ -1561,7 +1568,7 @@     attrs = addAttrs
 
 
-    formAction action form = btag "form" [("action", action),("method", "post")]  form
+    formAction action method form = btag "form" [("action", action),("method", method)]  form
     fromStr = fromString
     fromStrNoEncode= fromString
 
@@ -1582,14 +1589,14 @@      if   mfPageFlow s == False
        then do
        put s{mfPrefix= str ++ mfPrefix s
-            ,mfSequence=0 
-            ,mfPageFlow= True+            ,mfSequence=0
+            ,mfPageFlow= True
              }                               -- !> ("PARENT pageflow. prefix="++ str)
 
        r<- widget <** (modify (\s' -> s'{mfSequence= mfSequence s
-                                   ,mfPrefix= mfPrefix s+                                   ,mfPrefix= mfPrefix s
                                    }))
-       modify (\s -> s{mfPageFlow=False} )+       modify (\s -> s{mfPageFlow=False} )
        return r                                                                                 -- !> ("END PARENT pageflow. prefix="++ str))
src/MFlow/Forms/Admin.hs view
@@ -3,8 +3,8 @@ 
             #-}
 module MFlow.Forms.Admin(adminLoop, wait, addAdminWF) where
-import MFlow.Forms-import MFlow+import MFlow.Forms
+import MFlow
 import MFlow.Forms.Blaze.Html
 import Text.Blaze.Html5 hiding (map)
 import Control.Applicative
@@ -69,20 +69,20 @@ 
 -- | execute the process and wait for its finalization.
 --  then it synchronizes the cache
-wait f= do-    putChar '\n'-    putStrLn "Using configuration: "-    mapM_ putStrLn [k ++"= "++ show v | (k,v) <- M.toList config]+wait f= do
     putChar '\n'
+    putStrLn "Using configuration: "
+    mapM_ putStrLn [k ++"= "++ show v | (k,v) <- M.toList config]
+    putChar '\n'
     mv <- newEmptyMVar
     forkIO (f1 >> putMVar mv True)
     putStrLn "wait: ready"
-    takeMVar mv+    takeMVar mv
     return ()
    `E.catch` (\(e:: E.SomeException) ->do
                   ssyncCache
                   error $ "Signal: "++ show e)
-+
     where
     f1= do
         mv <- newEmptyMVar
src/MFlow/Forms/Blaze/Html.hs view
@@ -1,77 +1,77 @@-{-# OPTIONS  -XOverloadedStrings -XFlexibleInstances -XTypeSynonymInstances-           #-}-{- |-Instantiation of the 'FormInput' class for blaze-html <http://hackage.haskell.org/package/blaze-html>--This package is included in "MFlow.Wai.Blaze.Hml.All".--Use it to create applicaitons with this kind of formatting.--}-module MFlow.Forms.Blaze.Html where-import MFlow-import MFlow.Forms-import MFlow.Cookies(contentHtml)-import Data.ByteString.Lazy.UTF8-import qualified Data.String as S-import Text.Blaze.Html-import qualified Text.Blaze.Internal as I-import Text.Blaze.Html5 as St-import Text.Blaze.Html5.Attributes as At-import Text.Blaze.Html.Renderer.Utf8 -- (renderHtml)-import Control.Monad.Trans-import Data.Typeable-import Data.Monoid---import Data.Text.Encoding---import Data.Text as T-import Text.Blaze.Internal---- | used to insert html elements within a tag with the appropriate infix priority for the--- other operators used in MFlow. Also it can be used for adding markup to--- widgets with this signature such are 'wlink' ad 'setOption'-(<<) :: ToMarkup a => (Markup -> t) -> a -> t-(<<) tag v= tag $ toMarkup v--infixr 7 <<----fromUtf8 = toValue . encodeUtf8 . T.pack---instance FormInput Html where-    toByteString  =  renderHtml-    toHttpData = HttpData [contentHtml] [] . toByteString-    ftag x=  I.Parent (S.fromString x) (S.fromString $ "<" ++ x) (S.fromString $ "</"++ x ++">")-              -- (mempty :: I.MarkupM () )--    inred =  b ! At.style  "color:red"--    finput n t v f c=-       let-        tag= input ! type_ (toValue t) ! name  (toValue n) !value (toValue v)-        tag1= if f then tag  ! checked (toValue ("" ::String)) else tag-       in case c of Just s -> tag1 ! onclick  (toValue s) ; _ -> tag1--    ftextarea nam text=  textarea ! name  (toValue nam) <<  text--    fselect nam list = select ! name  (toValue nam) << list-    foption  name v msel=-      let tag=  option ! value  (toValue name)  <<  v-      in if msel then tag ! selected (toValue ("" ::String)) else tag---    formAction action form = St.form !  acceptCharset "UTF-8" ! At.action  (toValue action) ! method  (toValue ("post" :: String)) $ form--    fromStr= toMarkup-    fromStrNoEncode  = preEscapedToMarkup-    flink  v str = a ! href  (toValue  v) << str--    attrs tag  [] = tag-    attrs tag ((n,v):attribs) =-       let tag'= tag ! (customAttribute $ stringTag n) (toValue v)-       in attrs tag' attribs-------+{-# OPTIONS  -XOverloadedStrings -XFlexibleInstances -XTypeSynonymInstances
+           #-}
+{- |
+Instantiation of the 'FormInput' class for blaze-html <http://hackage.haskell.org/package/blaze-html>
+
+This package is included in "MFlow.Wai.Blaze.Hml.All".
+
+Use it to create applicaitons with this kind of formatting.
+-}
+module MFlow.Forms.Blaze.Html where
+import MFlow
+import MFlow.Forms
+import MFlow.Cookies(contentHtml)
+import Data.ByteString.Lazy.UTF8
+import qualified Data.String as S
+import Text.Blaze.Html
+import qualified Text.Blaze.Internal as I
+import Text.Blaze.Html5 as St
+import Text.Blaze.Html5.Attributes as At
+import Text.Blaze.Html.Renderer.Utf8 -- (renderHtml)
+import Control.Monad.Trans
+import Data.Typeable
+import Data.Monoid
+--import Data.Text.Encoding
+--import Data.Text as T
+import Text.Blaze.Internal
+
+-- | used to insert html elements within a tag with the appropriate infix priority for the
+-- other operators used in MFlow. Also it can be used for adding markup to
+-- widgets with this signature such are 'wlink' ad 'setOption'
+(<<) :: ToMarkup a => (Markup -> t) -> a -> t
+(<<) tag v= tag $ toMarkup v
+
+infixr 7 <<
+
+--fromUtf8 = toValue . encodeUtf8 . T.pack
+
+
+instance FormInput Html where
+    toByteString  =  renderHtml
+    toHttpData = HttpData [contentHtml] [] . toByteString
+    ftag x=  I.Parent (S.fromString x) (S.fromString $ "<" ++ x) (S.fromString $ "</"++ x ++">")
+              -- (mempty :: I.MarkupM () )
+
+    inred =  b ! At.style  "color:red"
+
+    finput n t v f c=
+       let
+        tag= input ! type_ (toValue t) ! name  (toValue n) !value (toValue v)
+        tag1= if f then tag  ! checked (toValue ("" ::String)) else tag
+       in case c of Just s -> tag1 ! onclick  (toValue s) ; _ -> tag1
+
+    ftextarea nam text=  textarea ! name  (toValue nam) <<  text
+
+    fselect nam list = select ! name  (toValue nam) << list
+    foption  name v msel=
+      let tag=  option ! value  (toValue name)  <<  v
+      in if msel then tag ! selected (toValue ("" ::String)) else tag
+
+
+    formAction action method1 form = St.form !  acceptCharset "UTF-8" ! At.action  (toValue action) ! method  (toValue method1) $ form
+
+    fromStr= toMarkup
+    fromStrNoEncode  = preEscapedToMarkup
+    flink  v str = a ! href  (toValue  v) << str
+
+    attrs tag  [] = tag
+    attrs tag ((n,v):attribs) =
+       let tag'= tag ! (customAttribute $ stringTag n) (toValue v)
+       in attrs tag' attribs
+
+
+
+
+
+
+
src/MFlow/Forms/Cache.hs view
@@ -1,181 +1,181 @@--------------------------------------------------------------------------------- | Composable cache and HTTP header directives.--- Intended to permit each widget to express his caching needs to the whole page--- The page will compile them and choose the most strict ones--- Autorefreshed, push and witerate'd widgets do not inherit the page rules. they must specify--- their own.------ The composition rules are explained in the corresponding combinators. This is a work in progress-------------------------------------------------------------------------------{-# LANGUAGE DeriveDataTypeable,FlexibleContexts, OverloadedStrings #-}-module MFlow.Forms.Cache (-resetCachePolicy,setCachePolicy,noCache,noCache',noStore,expires,maxAge-,private, public,sMaxAge,noTransform, proxyRevalidate, etag, vary,-) where-import MFlow.Forms.Internals-import Control.Applicative-import Data.Typeable-import Control.Monad.IO.Class-import Control.Monad.State-import Data.ByteString.Char8-import Data.List (insert,partition,sort)-import Data.Monoid---data CacheElem = Private | Public | NoCache | NoStore-               | Expires ByteString | MaxAge Int-               | SMaxAge Int | NoTransform-               | NoCache' ByteString-               | MustRevalidate | ProxyRevalidate-               | ETag ByteString | Vary ByteString-               deriving(Typeable, Show,Eq,Ord)---- | to delete all previous directives-resetCachePolicy :: (MonadState (MFlowState v) m, Monad m) => m ()-resetCachePolicy= do-  modify $ \s -> s{mfHttpHeaders=[]}-  setSessionData ([] :: [CacheElem])---- | add @no-cache@ to the @Cache-Control@ header directive. It deletes all expires and put max-age=0------ It means that the widget need not to be cached-noCache :: (MonadState (MFlowState v) m, MonadIO m) => m ()-noCache =  set  NoCache---- | add @no-cache: <string>@  to the Cache-Control header directive------ it deletes the header string (sensible cookies for example) from the data stored in the cache-noCache' :: (MonadState (MFlowState v) m, MonadIO m) => ByteString -> m ()-noCache' s =  set ( NoCache' s)---- | add @no-store@ to the @Cache-Control@ header directive. It deletes  @expires@ and put @max-age: 0@------ stronger kind of noCache. Not even store temporally-noStore :: (MonadState (MFlowState v) m, MonadIO m) => m ()-noStore =  set NoStore---- | add @expires: <date string>@ to the @Cache-Control@ header directive. it deletes @max-age@--- Currently it takes the last one if many------ The page will be cached until this date-expires :: (MonadState (MFlowState v) m, MonadIO m) =>  ByteString ->  m ()-expires s =  set (Expires  s)---- | add @max-age: <seconds>@ to the @Cache-Control@ header directive. if there are more than one, it chooses the lower one------ The page will be stored in the cache for that amount of seconds-maxAge  :: (MonadState (MFlowState v) m, MonadIO m) =>   Int ->   m ()-maxAge t =  set (MaxAge t)---- | add @private@ to the @Cache-Control@ header directive. it delete @public@ if any------ It means that the page that holds the widget must not be shared by other users.-private :: (MonadState (MFlowState v) m, MonadIO m) => m ()-private =  set Private---- | add @public@ to the @Cache-Control@ header directive.------ means that the cache can share the page content with other users.-public :: (MonadState (MFlowState v) m, MonadIO m) => m ()-public =  set Public---- | add @sMaxAge <seconds>@ to the @Cache-Control@ header directive. if many, chooses the minimum------ specify the time to hold the page for intermediate caches: for example proxies and CDNs.-sMaxAge :: (MonadState (MFlowState v) m, MonadIO m) => Int -> m ()-sMaxAge secs =  set (SMaxAge secs)---- | add @noTransform@ to the @Cache-Control@ header directive.------ Tell CDNs that the content should not be transformed to save space and so on-noTransform :: (MonadState (MFlowState v) m, MonadIO m) => m ()-noTransform =  set NoTransform---- | add @mustRevalidate@ to the @Cache-Control@ header directive.------ the cache must verify that the page has not changed.-mustRevalidate  :: (MonadState (MFlowState v) m, MonadIO m) => m ()-mustRevalidate =  set MustRevalidate---- | add @proxyRevalidate@ to the @Cache-Control@ header directive.------ The same than mustRevalidate, for shared caches (proxies etc)-proxyRevalidate :: (MonadState (MFlowState v) m, MonadIO m) => m ()-proxyRevalidate =  set ProxyRevalidate---- | add @etag <string>@ to the  header directives.------ it is a resource identifier for the page that substitutes the URL identifier-etag :: (MonadState (MFlowState v) m, MonadIO m) =>  ByteString ->  m ()-etag s =  set (ETag s)---- | add @vary <string>@ to the header directives.------ Usually the page add this identifier to the URL string, that is the default identifier--- So the same page with different etags will be cached and server separately-vary :: (MonadState (MFlowState v) m, MonadIO m) =>  ByteString ->  m ()-vary s =  set (Vary s)--generate ::  [CacheElem] -> [(ByteString,ByteString)]-generate []= []-generate xs = generatep xs [controlempty]- where- controlempty= ("Cache-Control","")- generatep [] res= if Prelude.head res == controlempty then Prelude.tail res else res--- generatep (x:xs) ((k,v):rs) =-  case gen x of-   Right s ->  generatep xs ((k, v <> ", " <>s): rs)--   Left pair -> generatep xs (rs++[pair])-- gen NoCache= Right "no-cache"- gen (NoCache' s)=  Right $ "no-cache= " <>s- gen NoStore= Right "no-store"- gen (Expires s)=  Right $ "expires= "<>s- gen (MaxAge t)= Right $ "max-age= "<> pack (show t)- gen Private= Right "private"- gen Public=  Right "public"- gen (SMaxAge t)= Right $ "s-maxage" <> pack (show t)- gen NoTransform= Right "no-transform"- gen MustRevalidate = Right "must-revalidate"- gen ProxyRevalidate= Right "proxy-revalidate"- gen (ETag s)= Left ("etag", s) :: Either (ByteString, ByteString) ByteString- gen (Vary s)= Left ("vary",s)--set r = do-  rs <- getSessionData `onNothing` return []-  setSessionData $ r:rs----compile rs = comp $ Data.List.sort rs-   where-   comp []= []-   comp [x]= [x]-   comp (x:(xs@(x':_))) | x==x'= comp xs             -- !> ("drop repetitions "++ show x)-   comp (Private:Public: xs) = comp  $ Private:comp xs-   comp (NoCache:NoStore:xs)= comp $ NoCache: comp xs-   comp (NoStore: Expires _: xs)= comp $ NoStore: comp xs-   comp (NoStore:MaxAge _ : xs)= comp $ NoStore: comp xs-   comp (NoCache:MaxAge _ : xs)= comp $ NoCache: comp xs-   comp (SMaxAge t:SMaxAge t':xs)= comp $ MaxAge (Prelude.min t t'): comp xs-   comp (Expires t:Expires t':xs)= comp $ Expires t: comp xs-   comp (Expires t:MaxAge _:xs)= comp $ Expires t: comp xs-   comp (MaxAge t:MaxAge t':xs)= comp $ MaxAge (Prelude.min t t'): comp xs-   comp (x:xs) = x: comp xs--onNothing  mmx mmy= do-  mx <- mmx-  case mx of-   Just x -> return x-   Nothing -> mmy----- | return the composition of the current directives. Used by the page internally-setCachePolicy :: (MonadState (MFlowState v) m, Monad m) => m ()-setCachePolicy= do-   rs <- getSessionData `onNothing` return  []-   let hs =generate $ compile rs                     -- !> show rs-   mapM_ (\(n,v) -> setHttpHeader n v ) hs           -- !> ("headers1="++ show hs)+-----------------------------------------------------------------------------
+-- | Composable cache and HTTP header directives.
+-- Intended to permit each widget to express his caching needs to the whole page
+-- The page will compile them and choose the most strict ones
+-- Autorefreshed, push and witerate'd widgets do not inherit the page rules. they must specify
+-- their own.
+--
+-- The composition rules are explained in the corresponding combinators. This is a work in progress
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable,FlexibleContexts, OverloadedStrings #-}
+module MFlow.Forms.Cache (
+resetCachePolicy,setCachePolicy,noCache,noCache',noStore,expires,maxAge
+,private, public,sMaxAge,noTransform, proxyRevalidate, etag, vary,
+) where
+import MFlow.Forms.Internals
+import Control.Applicative
+import Data.Typeable
+import Control.Monad.IO.Class
+import Control.Monad.State
+import Data.ByteString.Char8
+import Data.List (insert,partition,sort)
+import Data.Monoid
+
+
+data CacheElem = Private | Public | NoCache | NoStore
+               | Expires ByteString | MaxAge Int
+               | SMaxAge Int | NoTransform
+               | NoCache' ByteString
+               | MustRevalidate | ProxyRevalidate
+               | ETag ByteString | Vary ByteString
+               deriving(Typeable, Show,Eq,Ord)
+
+-- | to delete all previous directives
+resetCachePolicy :: (MonadState (MFlowState v) m, Monad m) => m ()
+resetCachePolicy= do
+  modify $ \s -> s{mfHttpHeaders=[]}
+  setSessionData ([] :: [CacheElem])
+
+-- | add @no-cache@ to the @Cache-Control@ header directive. It deletes all expires and put max-age=0
+--
+-- It means that the widget need not to be cached
+noCache :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+noCache =  set  NoCache
+
+-- | add @no-cache: <string>@  to the Cache-Control header directive
+--
+-- it deletes the header string (sensible cookies for example) from the data stored in the cache
+noCache' :: (MonadState (MFlowState v) m, MonadIO m) => ByteString -> m ()
+noCache' s =  set ( NoCache' s)
+
+-- | add @no-store@ to the @Cache-Control@ header directive. It deletes  @expires@ and put @max-age: 0@
+--
+-- stronger kind of noCache. Not even store temporally
+noStore :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+noStore =  set NoStore
+
+-- | add @expires: <date string>@ to the @Cache-Control@ header directive. it deletes @max-age@
+-- Currently it takes the last one if many
+--
+-- The page will be cached until this date
+expires :: (MonadState (MFlowState v) m, MonadIO m) =>  ByteString ->  m ()
+expires s =  set (Expires  s)
+
+-- | add @max-age: <seconds>@ to the @Cache-Control@ header directive. if there are more than one, it chooses the lower one
+--
+-- The page will be stored in the cache for that amount of seconds
+maxAge  :: (MonadState (MFlowState v) m, MonadIO m) =>   Int ->   m ()
+maxAge t =  set (MaxAge t)
+
+-- | add @private@ to the @Cache-Control@ header directive. it delete @public@ if any
+--
+-- It means that the page that holds the widget must not be shared by other users.
+private :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+private =  set Private
+
+-- | add @public@ to the @Cache-Control@ header directive.
+--
+-- means that the cache can share the page content with other users.
+public :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+public =  set Public
+
+-- | add @sMaxAge <seconds>@ to the @Cache-Control@ header directive. if many, chooses the minimum
+--
+-- specify the time to hold the page for intermediate caches: for example proxies and CDNs.
+sMaxAge :: (MonadState (MFlowState v) m, MonadIO m) => Int -> m ()
+sMaxAge secs =  set (SMaxAge secs)
+
+-- | add @noTransform@ to the @Cache-Control@ header directive.
+--
+-- Tell CDNs that the content should not be transformed to save space and so on
+noTransform :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+noTransform =  set NoTransform
+
+-- | add @mustRevalidate@ to the @Cache-Control@ header directive.
+--
+-- the cache must verify that the page has not changed.
+mustRevalidate  :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+mustRevalidate =  set MustRevalidate
+
+-- | add @proxyRevalidate@ to the @Cache-Control@ header directive.
+--
+-- The same than mustRevalidate, for shared caches (proxies etc)
+proxyRevalidate :: (MonadState (MFlowState v) m, MonadIO m) => m ()
+proxyRevalidate =  set ProxyRevalidate
+
+-- | add @etag <string>@ to the  header directives.
+--
+-- it is a resource identifier for the page that substitutes the URL identifier
+etag :: (MonadState (MFlowState v) m, MonadIO m) =>  ByteString ->  m ()
+etag s =  set (ETag s)
+
+-- | add @vary <string>@ to the header directives.
+--
+-- Usually the page add this identifier to the URL string, that is the default identifier
+-- So the same page with different etags will be cached and server separately
+vary :: (MonadState (MFlowState v) m, MonadIO m) =>  ByteString ->  m ()
+vary s =  set (Vary s)
+
+generate ::  [CacheElem] -> [(ByteString,ByteString)]
+generate []= []
+generate xs = generatep xs [controlempty]
+ where
+ controlempty= ("Cache-Control","")
+ generatep [] res= if Prelude.head res == controlempty then Prelude.tail res else res
+
+
+ generatep (x:xs) ((k,v):rs) =
+  case gen x of
+   Right s ->  generatep xs ((k, v <> ", " <>s): rs)
+
+   Left pair -> generatep xs (rs++[pair])
+
+ gen NoCache= Right "no-cache"
+ gen (NoCache' s)=  Right $ "no-cache= " <>s
+ gen NoStore= Right "no-store"
+ gen (Expires s)=  Right $ "expires= "<>s
+ gen (MaxAge t)= Right $ "max-age= "<> pack (show t)
+ gen Private= Right "private"
+ gen Public=  Right "public"
+ gen (SMaxAge t)= Right $ "s-maxage" <> pack (show t)
+ gen NoTransform= Right "no-transform"
+ gen MustRevalidate = Right "must-revalidate"
+ gen ProxyRevalidate= Right "proxy-revalidate"
+ gen (ETag s)= Left ("etag", s) :: Either (ByteString, ByteString) ByteString
+ gen (Vary s)= Left ("vary",s)
+
+set r = do
+  rs <- getSessionData `onNothing` return []
+  setSessionData $ r:rs
+
+
+
+compile rs = comp $ Data.List.sort rs
+   where
+   comp []= []
+   comp [x]= [x]
+   comp (x:(xs@(x':_))) | x==x'= comp xs             -- !> ("drop repetitions "++ show x)
+   comp (Private:Public: xs) = comp  $ Private:comp xs
+   comp (NoCache:NoStore:xs)= comp $ NoCache: comp xs
+   comp (NoStore: Expires _: xs)= comp $ NoStore: comp xs
+   comp (NoStore:MaxAge _ : xs)= comp $ NoStore: comp xs
+   comp (NoCache:MaxAge _ : xs)= comp $ NoCache: comp xs
+   comp (SMaxAge t:SMaxAge t':xs)= comp $ MaxAge (Prelude.min t t'): comp xs
+   comp (Expires t:Expires t':xs)= comp $ Expires t: comp xs
+   comp (Expires t:MaxAge _:xs)= comp $ Expires t: comp xs
+   comp (MaxAge t:MaxAge t':xs)= comp $ MaxAge (Prelude.min t t'): comp xs
+   comp (x:xs) = x: comp xs
+
+onNothing  mmx mmy= do
+  mx <- mmx
+  case mx of
+   Just x -> return x
+   Nothing -> mmy
+
+
+-- | return the composition of the current directives. Used by the page internally
+setCachePolicy :: (MonadState (MFlowState v) m, Monad m) => m ()
+setCachePolicy= do
+   rs <- getSessionData `onNothing` return  []
+   let hs =generate $ compile rs                     -- !> show rs
+   mapM_ (\(n,v) -> setHttpHeader n v ) hs           -- !> ("headers1="++ show hs)
src/MFlow/Forms/HSP.hs view
@@ -1,75 +1,75 @@-{-# OPTIONS -F -pgmFtrhsx  -XTypeFamilies  -XOverloadedStrings -XUndecidableInstances -XOverlappingInstances -XTypeSynonymInstances -XFlexibleInstances #-}--{- |-Instantiation of the 'FormInput' class for the HSP package <http://hackage.haskell.org/package/hsp>- for embedding widgets within HTML-XML formatting---}--module MFlow.Forms.HSP- where--import MFlow-import MFlow.Cookies(contentHtml)-import MFlow.Forms-import Control.Monad.Trans-import Data.Typeable-import HSP.Monad-import HSP.XML-import HSP.XMLGenerator-import Data.Monoid-import Control.Monad(when)-import Data.ByteString.Lazy.Char8(unpack,pack)-import System.IO.Unsafe-import Data.TCache.Memoization (Executable (..))-import Data.Text.Lazy.Encoding-import Data.String----instance (XMLGen m,XML ~ XMLType m, EmbedAsChild m(XMLType m)) => Monoid (XMLGenT m XML) where-    mempty =   <span/>-    mappend  x  y= <span> <% x %> <% y %> </span>-    mconcat xs=  <span> <% [<% x %> |  x <- xs] %> </span>--instance Typeable  (XMLGenT m XML) where-    typeOf= \_ ->  mkTyConApp(mkTyCon3 "hsp" "HSP.XMLGenerator" "XMLGenT m XML") []--instance (XMLGen m,XML ~ XMLType m-         ,EmbedAsChild m XML-         ,EmbedAsAttr m (Attr  String String)-         ,Executable m-         ,SetAttr m XML)-         => FormInput (XMLGenT m XML)   where-    toByteString =  encodeUtf8 . renderXML . execute . unXMLGenT-    toHttpData = HttpData [contentHtml ] [] . toByteString-    ftag t =  \e -> genElement (toName t) [] [asChild e]--    fromStr s =   <span><% s %></span>-    fromStrNoEncode s= <pcdata> pcdataToChild s </pcdata>-    finput typ name value checked onclick=-      <input type= (typ)-             name= (name)-             value=(value)-             checked=(show checked)-             onclick=(case onclick of Just s -> s ; _ -> "")/>--    ftextarea  name text= <textarea name=(name) > <% text %> </textarea>--    fselect name list=  <select name=(name)> <%list%> </select>-    foption  n v msel=-                  <option value=(n) selected=(selected msel ) >-                      <% v %>-                  </option>--          where-          selected msel = if msel then "true" else  "false" :: String--    flink  v str = <a href=(v)> <% str %> </a>--    inred x= <b style= "color:red"> <% x %> </b>--    formAction action form = <form action=(action) method="post" > <% form %> </form>---    attrs tag  attrs=  tag <<@ map (\(n,v)-> n:=v) attrs+{-# OPTIONS -F -pgmFtrhsx  -XTypeFamilies  -XOverloadedStrings -XUndecidableInstances -XOverlappingInstances -XTypeSynonymInstances -XFlexibleInstances #-}
+
+{- |
+Instantiation of the 'FormInput' class for the HSP package <http://hackage.haskell.org/package/hsp>
+ for embedding widgets within HTML-XML formatting
+
+-}
+
+module MFlow.Forms.HSP
+ where
+
+import MFlow
+import MFlow.Cookies(contentHtml)
+import MFlow.Forms
+import Control.Monad.Trans
+import Data.Typeable
+import HSP.Monad
+import HSP.XML
+import HSP.XMLGenerator
+import Data.Monoid
+import Control.Monad(when)
+import Data.ByteString.Lazy.Char8(unpack,pack)
+import System.IO.Unsafe
+import Data.TCache.Memoization (Executable (..))
+import Data.Text.Lazy.Encoding
+import Data.String
+
+
+
+instance (XMLGen m,XML ~ XMLType m, EmbedAsChild m(XMLType m)) => Monoid (XMLGenT m XML) where
+    mempty =   <span/>
+    mappend  x  y= <span> <% x %> <% y %> </span>
+    mconcat xs=  <span> <% [<% x %> |  x <- xs] %> </span>
+
+instance Typeable  (XMLGenT m XML) where
+    typeOf= \_ ->  mkTyConApp(mkTyCon3 "hsp" "HSP.XMLGenerator" "XMLGenT m XML") []
+
+instance (XMLGen m,XML ~ XMLType m
+         ,EmbedAsChild m XML
+         ,EmbedAsAttr m (Attr  String String)
+         ,Executable m
+         ,SetAttr m XML)
+         => FormInput (XMLGenT m XML)   where
+    toByteString =  encodeUtf8 . renderXML . execute . unXMLGenT
+    toHttpData = HttpData [contentHtml ] [] . toByteString
+    ftag t =  \e -> genElement (toName t) [] [asChild e]
+
+    fromStr s =   <span><% s %></span>
+    fromStrNoEncode s= <pcdata> pcdataToChild s </pcdata>
+    finput typ name value checked onclick=
+      <input type= (typ)
+             name= (name)
+             value=(value)
+             checked=(show checked)
+             onclick=(case onclick of Just s -> s ; _ -> "")/>
+
+    ftextarea  name text= <textarea name=(name) > <% text %> </textarea>
+
+    fselect name list=  <select name=(name)> <%list%> </select>
+    foption  n v msel=
+                  <option value=(n) selected=(selected msel ) >
+                      <% v %>
+                  </option>
+
+          where
+          selected msel = if msel then "true" else  "false" :: String
+
+    flink  v str = <a href=(v)> <% str %> </a>
+
+    inred x= <b style= "color:red"> <% x %> </b>
+
+    formAction action form = <form action=(action) method="post" > <% form %> </form>
+
+
+    attrs tag  attrs=  tag <<@ map (\(n,v)-> n:=v) attrs
src/MFlow/Forms/Internals.hs view
@@ -46,12 +46,12 @@ import Data.List
 import System.IO.Unsafe
 import Control.Concurrent.MVar
-import qualified Data.Text as T-import Data.Char-import Data.List(stripPrefix)-import Data.Maybe(isJust)-import Control.Concurrent.STM-import Data.TCache.Memoization+import qualified Data.Text as T
+import Data.Char
+import Data.List(stripPrefix)
+import Data.Maybe(isJust)
+import Control.Concurrent.STM
+import Data.TCache.Memoization
 
 --
 ---- for traces
@@ -60,15 +60,30 @@ import Control.Exception as CE
 import Control.Concurrent 
 import Control.Monad.Loc
-+
 -- debug
---import Debug.Trace
---(!>) = flip trace 
+import Debug.Trace
+(!>) = flip trace 
 
 
 data FailBack a = BackPoint a | NoBack a | GoBack   deriving (Show,Typeable)
 
+instance Functor FailBack where
+  fmap f GoBack= GoBack
+  fmap f (BackPoint x)= BackPoint $ f x
+  fmap f (NoBack x)= NoBack $ f x
 
+instance Applicative FailBack where
+  pure x = NoBack x
+  _ <*> GoBack = GoBack
+  GoBack <*> _ = GoBack
+  k <*> x = NoBack $ (fromFailBack k)  (fromFailBack x)
+
+instance Alternative FailBack where
+   empty= GoBack
+   GoBack <|> f = f
+   f <|> _ = f
+
 instance (Serialize a) => Serialize (FailBack a ) where
    showp (BackPoint x)= insertString (fromString iCanFailBack) >> showp x
    showp (NoBack x)   = insertString (fromString noFailBack) >> showp x
@@ -117,14 +132,30 @@ fromFailBack (BackPoint  x)= x
 toFailBack x= NoBack x
 
+instance (Monad m,Applicative m) => Applicative (Sup m) where
+   pure x = Sup . return $ NoBack x
+   f <*> g= Sup $ do
+       k <- runSup f
+       x <- runSup g
+       return $ k <*> x
 
+instance(Monad m, Applicative m) => Alternative (Sup m) where
+   empty = Sup . return $ GoBack
+   f <|> g= Sup $ do
+       x <- runSup f
+       case x of
+        GoBack -> runSup g !> "GOBACK"
+        _      -> return x
+
 -- | the FlowM monad executes the page navigation. It perform Backtracking when necessary to syncronize
 -- when the user press the back button or when the user enter an arbitrary URL. The instruction pointer
 -- is moved to the right position within the procedure to handle the request.
 --
 -- However this is transparent to the programmer, who codify in the style of a console application.
-newtype FlowM v m a= FlowM {runFlowM :: FlowMM v m a} deriving (Monad,MonadIO,Functor,MonadState(MFlowState v))
-flowM= FlowM
+newtype FlowM v m a= FlowM {runFlowM :: FlowMM v m a}
+        deriving (Applicative,Alternative,Monad,MonadIO,Functor
+                 ,MonadState(MFlowState v))
+
 --runFlowM= runView
 
 {-# NOINLINE breturn  #-}
@@ -134,7 +165,7 @@ -- This way when the user press the back button, the computation will execute back, to
 -- the returned code, according with the user navigation.
 breturn :: (Monad m) => a -> FlowM v m a
-breturn = flowM . Sup . return . BackPoint           -- !> "breturn"
+breturn = FlowM . Sup . return . BackPoint           -- !> "breturn"
 
 
 instance (Supervise s m,MonadIO m) => MonadIO (Sup  m) where
@@ -167,6 +198,7 @@    showp (FormElm _ x)= showp x
    readp= readp >>= \x -> return $ FormElm  mempty x
 
+
 -- | @View v m a@ is a widget (formlet)  with formatting `v`  running the monad `m` (usually `IO`) and which return a value of type `a`
 --
 -- It has 'Applicative', 'Alternative' and 'Monad' instances.
@@ -215,7 +247,7 @@             , mfPath=mfPath 
             , mfData=mfData
             , mfTrace= mfTrace
-            , inSync=False+            , inSync=False
             , newAsk=False}
 
 
@@ -302,21 +334,21 @@ 
 instance (FormInput view,Functor m, Monad m) => Alternative (View view m) where
   empty= View $ return $ FormElm mempty Nothing
-  View f <|> View g= View $ do+  View f <|> View g= View $ do
                    path <- gets mfPagePath
-                   FormElm form1 k <- f-                   s1 <- get-                   let path1 = mfPagePath s1+                   FormElm form1 k <- f
+                   s1 <- get
+                   let path1 = mfPagePath s1
                    put s1{mfPagePath=path}
-                   FormElm form2 x <- g-                   s2 <- get-                   (mix,hasform) <- controlForms s1 s2 form1 form2-                   let path2 = mfPagePath s2-                   let path3 = case (k,x) of-                         (Just _,_) -> path1-                         (_,Just _) -> path2-                         _          -> path-                   if hasform then put s2{needForm= HasForm,mfPagePath= path3}+                   FormElm form2 x <- g
+                   s2 <- get
+                   (mix,hasform) <- controlForms s1 s2 form1 form2
+                   let path2 = mfPagePath s2
+                   let path3 = case (k,x) of
+                         (Just _,_) -> path1
+                         (_,Just _) -> path2
+                         _          -> path
+                   if hasform then put s2{needForm= HasForm,mfPagePath= path3}
                               else put s2{mfPagePath=path3}    
                    return $ FormElm mix (k <|> x) 
 
@@ -326,13 +358,13 @@            FormElm form1 mk <- x   
            case mk of
              Just k  -> do
-                st'' <- get-                let st = st''{ linkMatched = False  }+                st'' <- get
+                let st = st''{ linkMatched = False  }
                 put st      
-                FormElm form2 mk <- runView $ f k-                st' <- get-                (mix, hasform) <- controlForms st st' form1 form2-                when hasform $ put st'{needForm= HasForm}+                FormElm form2 mk <- runView $ f k
+                st' <- get
+                (mix, hasform) <- controlForms st st' form1 form2
+                when hasform $ put st'{needForm= HasForm}
 
                 return $ FormElm mix mk
              Nothing -> 
@@ -343,7 +375,7 @@     return = View .  return . FormElm  mempty . Just
 --    fail msg= View . return $ FormElm [inRed msg] Nothing
 
-+
   
 
 instance (FormInput v,Monad m, Functor m, Monoid a) => Monoid (View v m a) where
@@ -368,7 +400,7 @@    case mk of
      Just k  -> do
        modify $ \st -> st{linkMatched= False, needForm=NoElems}
-       runView (f k)+       runView (f k)
        
      Nothing -> return $ FormElm form1 Nothing
 
@@ -401,11 +433,11 @@ changeMonad w= View . StateT $ \s ->
     let (r,s')= execute $ runStateT  ( runView w)    s
     in mfSequence s' `seq` return (r,s')
--------- some combinators ---- 
+
+
+----- some combinators ----
+
 -- | Join two widgets in the same page
 -- the resulting widget, when `ask`ed with it, return a 2 tuple of their validation results
 -- if both return Noting, the widget return @Nothing@ (invalid).
@@ -419,11 +451,11 @@       -> View view m b
       -> View view m (Maybe a, Maybe b)
 mix digest1 digest2= View $ do
-  FormElm f1 mx' <- runView  digest1+  FormElm f1 mx' <- runView  digest1
   s1 <- get
-  FormElm f2 my' <- runView  digest2-  s2 <- get-  (mix, hasform) <- controlForms s1 s2 f1 f2+  FormElm f2 my' <- runView  digest2
+  s2 <- get
+  (mix, hasform) <- controlForms s1 s2 f1 f2
   when hasform $ put s2{needForm= HasForm}
   return $ FormElm mix
          $ case (mx',my') of
@@ -452,18 +484,18 @@ 
 (**>) :: (Functor m, Monad m, FormInput view)
       => View view m a -> View view m b -> View view m b
---(**>) form1 form2 = valid form1 *> form2-(**>) f g = View $ do-   FormElm form1 k <- runView $ valid f+--(**>) form1 form2 = valid form1 *> form2
+(**>) f g = View $ do
+   FormElm form1 k <- runView $ valid f
    s1 <- get
-   FormElm form2 x <- runView g-   s2 <- get-   (mix,hasform) <- controlForms s1 s2 form1 form2-   when hasform $ put s2{needForm= HasForm}
+   FormElm form2 x <- runView g
+   s2 <- get
+   (mix,hasform) <- controlForms s1 s2 form1 form2
+   when hasform $ put s2{needForm= HasForm} 
    return $ FormElm mix (k *> x)
 
- 
+
 valid form= View $ do
    FormElm form mx <- runView form
    return $ FormElm form $ Just undefined
@@ -480,19 +512,19 @@ (<**) :: (Functor m, Monad m, FormInput view) =>
      View view m a -> View view m b -> View view m a
 -- (<**) form1 form2 =  form1 <* valid form2
-(<**) f g = View $ do-   FormElm form1 k <- runView f+(<**) f g = View $ do
+   FormElm form1 k <- runView f
    s1 <- get
-   FormElm form2 x <- runView $ valid g-   s2 <- get-   (mix,hasform) <- controlForms s1 s2 form1 form2-   when hasform $ put s2{needForm= HasForm}
+   FormElm form2 x <- runView $ valid g
+   s2 <- get
+   (mix,hasform) <- controlForms s1 s2 form1 form2
+   when hasform $ put s2{needForm= HasForm} 
    return $ FormElm mix (k <* x)
 
----------- Flow control 
+
+-------- Flow control
+
 -- | True if the flow is going back (as a result of the back button pressed in the web browser).
 --  Usually this check is nos necessary unless conditional code make it necessary
 --
@@ -570,41 +602,43 @@ -- the context of long running transactions.
 compensate :: Monad m =>  m a ->  m a -> FlowM v m a
 compensate doit undoit= doit `onBacktrack` ( (lift undoit) >> fail "")
-----orElse ::  FormInput v => FlowM v IO a -> FlowM v IO a -> FlowM v IO a---orElse mx my= do---    s <- get---    let tk = mfToken s---    (r,s) <- liftIO $ do---        ref1 <- atomically $ newTVar Nothing---        ref2 <- atomically $ newTVar Nothing---        t1 <- forkIO $ (runFlowOnceReturn s mx tk) >>= atomically . writeTVar  ref1 . Just---        t2 <- forkIO $ (runFlowOnceReturn s my tk) >>= atomically . writeTVar  ref2 . Just---        r <- atomically $ readFrom ref1 `Control.Concurrent.STM.orElse` readFrom ref2---        killThread t1---        killThread t2---        flushResponse tk---        flushRec tk---        return r---    put s---    FlowM . Sup $ return r---    where---    readFrom ref = do---      mr <- readTVar ref---      case mr of---        Nothing -> retry---        Just v  -> return v 
-type Lang=  String--needForm1 st=  case needForm st of-   HasForm -> False-   HasElems -> True-   NoElems -> False
--data NeedForm= HasForm | HasElems | NoElems deriving Show 
+--orElse ::  FormInput v => FlowM v IO a -> FlowM v IO a -> FlowM v IO a
+--orElse mx my= do
+--    s <- get
+--    let tk = mfToken s
+--    (r,s) <- liftIO $ do
+--        ref1 <- atomically $ newTVar Nothing
+--        ref2 <- atomically $ newTVar Nothing
+--        t1 <- forkIO $ (runFlowOnceReturn s mx tk) >>= atomically . writeTVar  ref1 . Just
+--        t2 <- forkIO $ (runFlowOnceReturn s my tk) >>= atomically . writeTVar  ref2 . Just
+--        r <- atomically $ readFrom ref1 `Control.Concurrent.STM.orElse` readFrom ref2
+--        killThread t1
+--        killThread t2
+--        flushResponse tk
+--        flushRec tk
+--        return r
+--    put s
+--    FlowM . Sup $ return r
+--    where
+--    readFrom ref = do
+--      mr <- readTVar ref
+--      case mr of
+--        Nothing -> retry
+--        Just v  -> return v
+
+type Lang=  String
+
+--needForm1 st=  case needForm st of
+--   HasForm -> False
+--   HasElems _ -> True
+--   NoElems -> False
+   
+
+
+data NeedForm= HasForm | HasElems  | NoElems deriving Show
+
 data MFlowState view= MFlowState{   
    mfSequence       :: Int,
    mfCached         :: Bool,
@@ -613,6 +647,7 @@    mfLang           :: Lang,
    mfEnv            :: Params,
    needForm         :: NeedForm,
+   mfFileUpload    ::  Bool,
    mfToken          :: Token,
    mfkillTime       :: Int,
    mfSessionTime    :: Integer,
@@ -621,18 +656,19 @@    mfHeader         :: view -> view,
    mfDebug          :: Bool,
    mfRequirements   :: [Requirement],
+   mfInstalledScripts  :: [WebRequirement],
    mfData           :: M.Map TypeRep Void,
    mfAjax           :: Maybe (M.Map String Void),
    mfSeqCache       :: Int,
    notSyncInAction  :: Bool,
 
    -- Link management
-   mfPath           :: [String],+   mfPath           :: [String],
    mfPagePath       :: [String],
    mfPrefix         :: String,
 --   mfPIndex         :: Int,
    mfPageFlow       :: Bool,
-   linkMatched      :: Bool,+   linkMatched      :: Bool,
 --   mfPendingPath      :: [String],
 
 
@@ -646,8 +682,9 @@ 
 mFlowState0 :: (FormInput view) => MFlowState view
 mFlowState0 = MFlowState 0 False  True  True  "en"
-                [] NoElems  (error "token of mFlowState0 used")
-                0 0 [] [] stdHeader False [] M.empty  Nothing 0 False    [] []  "" False False  False [] False
+                [] NoElems False (error "token of mFlowState0 used")
+                0 0 [] [] stdHeader False [] [] M.empty  Nothing 0 False
+                [] []  "" False False  False [] False
 
 
 -- | Set user-defined data in the context of the session.
@@ -680,18 +717,18 @@       Nothing -> return $ Nothing
  typeResp :: m (Maybe x) -> x
  typeResp= undefined
---- | getSessionData specialized for the View monad. if Nothing, the monadic computation--- does not continue.-getSData :: (Monad m,Typeable a,Monoid v) => View v m a-getSData= View $ do-    r <- getSessionData-    return $ FormElm mempty r---- | Return the session identifier-getSessionId :: MonadState (MFlowState v) m => m String-getSessionId= gets mfToken >>= return . key 
+-- | getSessionData specialized for the View monad. if Nothing, the monadic computation
+-- does not continue.
+getSData :: (Monad m,Typeable a,Monoid v) => View v m a
+getSData= View $ do
+    r <- getSessionData
+    return $ FormElm mempty r
+
+-- | Return the session identifier
+getSessionId :: MonadState (MFlowState v) m => m String
+getSessionId= gets mfToken >>= return . key
+
 -- | Return the user language. Now it is fixed to "en"
 getLang ::  MonadState (MFlowState view) m => m String
 getLang= gets mfLang
@@ -776,20 +813,20 @@                                      SB.fromString v,
                                      SB.fromString p,
                                      fmap (SB.fromString . show) me)):mfCookies st }
-+
 setParanoidCookie :: MonadState (MFlowState view) m
           =>  String  -- ^ name
           -> String  -- ^ value
           -> String  -- ^ path
-          -> Maybe Integer  -- ^ Max-Age in seconds. Nothing for a session cookie+          -> Maybe Integer  -- ^ Max-Age in seconds. Nothing for a session cookie
           -> m ()
 setParanoidCookie n v p me = setEncryptedCookie' n v p me paranoidEncryptCookie
-+
 setEncryptedCookie :: MonadState (MFlowState view) m
           =>  String  -- ^ name
           -> String  -- ^ value
           -> String  -- ^ path
-          -> Maybe Integer  -- ^ Max-Age in seconds. Nothing for a session cookie+          -> Maybe Integer  -- ^ Max-Age in seconds. Nothing for a session cookie
           -> m ()
 setEncryptedCookie n v p me = setEncryptedCookie' n v p me encryptCookie
 
@@ -873,7 +910,7 @@     foption :: String -> view -> Bool -> view
     foption1 :: String -> Bool -> view
     foption1   val msel= foption val (fromStr val) msel
-    formAction  :: String -> view -> view
+    formAction  :: String -> String -> view -> view
     attrs :: view -> Attribs -> view
 
 
@@ -922,12 +959,12 @@         let((FormElm  _ mx2), s2)  = execute $ runStateT  ( runView mf)    s{mfSeqCache= sec,mfCached=True}
         let s''=  s{inSync = inSync s2
                    ,mfRequirements=mfRequirements s2
-                   ,mfPath= mfPath s2+                   ,mfPath= mfPath s2
                    ,mfPagePath= mfPagePath s2
                    ,needForm= needForm s2
                    ,mfPageFlow= mfPageFlow s2
-                   ,mfSeqCache= mfSeqCache s + mfSeqCache s2 - sec}-        return $ (mfSeqCache s'') `seq` form `seq`  ((FormElm form mx2), s'')+                   ,mfSeqCache= mfSeqCache s + mfSeqCache s2 - sec}
+        return $ (mfSeqCache s'') `seq` form `seq`  ((FormElm form mx2), s'')
 
         -- !> ("enter: "++show (mfSeqCache s) ++" exit: "++ show ( mfSeqCache s2))
         where
@@ -987,9 +1024,9 @@     let t''= t'{tpath=[twfname t']}
     liftIO $ do
        flushRec t'' 
-       sendToMF t'' t''-    let s'= case mfSequence s  of-             -1  -> s                     -- !> "end of recovery loop"+       sendToMF t'' t''
+    let s'= case mfSequence s  of
+             -1  -> s                     -- !> "end of recovery loop"
              _   -> s{mfPath=[twfname t],mfPagePath=[],mfEnv=[]} 
     loop   s' f t''{tpath=[]}             -- !> "LOOPAGAIN"
 
@@ -1001,12 +1038,12 @@ 
 runFlowOnce1 f t  = runFlowOnce2 (startState t)  f
 
-startState t= mFlowState0{mfToken=t+startState t= mFlowState0{mfToken=t
                    ,mfSequence= inRecovery
                    ,mfPath= tpath t
-                   ,mfEnv= tenv t+                   ,mfEnv= tenv t
                    ,mfPagePath=[]}  
-+
 runFlowOnce2 s f  =
   runStateT (runSup . runFlowM $ do
         backInit
@@ -1018,20 +1055,20 @@   backInit= do
      s <- get                     --   !> "BackInit"
      case mfTrace s of
-       [] -> do-         let t = mfToken s-         back <- goingBack-         recover <- lift $ isInRecover+       [] -> do
+         let t = mfToken s
+         back <- goingBack
+         recover <- lift $ isInRecover
          when (back && not recover) . modify $ \s -> s{ newAsk= True,mfPagePath=[twfname t]}
-         breturn ()+         breturn ()
          
        tr ->  error $ disp tr
      where
      disp tr= "TRACE (error in the last line):\n\n" ++(concat $ intersperse "\n" tr)
   -- to restart the flow in case of going back before the first page of the flow
--runFlowOnceReturn-  ::   FormInput v => MFlowState v -> FlowM v m a -> Token -> m (FailBack a, MFlowState v)+
+runFlowOnceReturn
+  ::   FormInput v => MFlowState v -> FlowM v m a -> Token -> m (FailBack a, MFlowState v)
 runFlowOnceReturn  s f t =
   runStateT (runSup $ runFlowM f) (startState t)
         
@@ -1041,8 +1078,8 @@ -- the string identifier.
 -- unlike the normal flows, that run within infinite loops, runFlowIn executes once.
 -- In subsequent executions, the flow will get the intermediate responses from te log
--- and will return the result without asking again.--- This is useful for asking once, storing in the log and subsequently retrieving user+-- and will return the result without asking again.
+-- This is useful for asking once, storing in the log and subsequently retrieving user
 -- defined configurations by means of persistent flows with web formularies.
 runFlowIn
   :: (MonadIO m,
@@ -1068,17 +1105,17 @@ runFlowConf :: (FormInput view, MonadIO m) => FlowM view m a ->  m a
 runFlowConf  f = do
   q  <- liftIO newEmptyMVar  -- `debug` (i++w++u)
-  qr <- liftIO newEmptyMVar+  qr <- liftIO newEmptyMVar
   block <- liftIO $ newMVar True
   let t=  Token "" "" "" [] [] block q  qr
   evalStateT (runSup . runFlowM $   f )  mFlowState0{mfToken=t} >>= return . fromFailBack   -- >> return ()
 
---- | run a transient Flow from the IO monad.---runNav :: String -> FlowM Html IO () -> IO ()---runNav ident f= exec1 ident $ runFlowOnce (transientNav f) undefined 
+-- | run a transient Flow from the IO monad.
+--runNav :: String -> FlowM Html IO () -> IO ()
+--runNav ident f= exec1 ident $ runFlowOnce (transientNav f) undefined
 
+
 -- | Clears the environment
 clearEnv :: MonadState (MFlowState view) m =>  m ()
 clearEnv= do
@@ -1098,9 +1135,9 @@     debug=  do
      (x,env) <- readp
      return  (x,mFlowState0{mfEnv= env,mfSequence= inRecovery})
- 
 
+
 -- | stores the result of the flow in a  persistent log. When restarted, it get the result
 -- from the log and it does not execute it again. When no results are in the log, the computation
 -- is executed. It is equivalent to 'Control.Workflow.step' but in the FlowM monad.
@@ -1114,7 +1151,7 @@       -> FlowM view (Workflow m) a
 step f= do
    s <- get
-   flowM $ Sup $ do
+   FlowM $ Sup $ do
         (r,s') <- lift . WF.step $ runStateT (runSup $ runFlowM f) s
 
         -- when recovery of a workflow, the MFlow state is not considered
@@ -1122,8 +1159,8 @@         return r
  
 -- | to execute transient flows as if they were persistent
--- it can be used instead of step, but it does  log nothing.--- Thus, it is faster and convenient when no session state must be stored beyond the lifespan of+-- it can be used instead of step, but it does  log nothing.
+-- Thus, it is faster and convenient when no session state must be stored beyond the lifespan of
 -- the server process.
 --
 -- > transient $ runFlow f === runFlow $ transientNav f
@@ -1136,7 +1173,7 @@       -> FlowM view (Workflow IO) a
 transientNav f= do
    s <- get
-   flowM $ Sup $ do
+   FlowM $ Sup $ do
         (r,s') <-  lift . unsafeIOtoWF $ runStateT (runSup $ runFlowM f) s
         put s'
         return r
@@ -1208,44 +1245,45 @@ fromValidated (Validated x)= x
 fromValidated NoParam= error $ "fromValidated : NoParam"
 fromValidated (NotValidated s err)= error $ "fromValidated: NotValidated "++ s
- 
 
+
 getParam1 :: (Monad m, MonadState (MFlowState v) m, Typeable a, Read a, FormInput v)
           => String -> Params ->  m (ParamResult v a)
 getParam1 par req = case lookup par req of
     Just x -> readParam x  
     Nothing  -> return  NoParam
---- Read a segment in the REST path. if it does not match with the type requested+
+-- Read a segment in the REST path. if it does not match with the type requested
 -- or if there is no remaining segment, it returns Nothing
-getRestParam :: (Read a, Typeable a, Monad m, Functor m, MonadState (MFlowState v) m, FormInput v)+getRestParam :: (Read a, Typeable a, Monad m, Functor m, MonadState (MFlowState v) m, FormInput v)
              => m (Maybe a)
 getRestParam= do
   st <- get 
   let lpath = mfPath st
-  if  linkMatched st+  if  linkMatched st
    then return Nothing          
-   else case  stripPrefix (mfPagePath st) lpath  of-     Nothing -> return Nothing+   else case  stripPrefix (mfPagePath st) lpath  of
+     Nothing -> return Nothing
      Just [] -> return Nothing   
-     Just xs ->-        case stripPrefix  (mfPrefix st) (head xs)  of-             Nothing -> return Nothing-             Just name -> do+     Just xs -> do
+--        case stripPrefix  (mfPrefix st) (head xs)  of
+--             Nothing -> return Nothing
+--             Just name ->
+              let name= head xs
               r <-  fmap valToMaybe $ readParam name 
               when (isJust r) $ modify $ \s -> s{inSync= True
-                                                ,linkMatched= True-                                                ,mfPagePath= mfPagePath s++[name]}+                                               ,linkMatched= True
+                                               ,mfPagePath= mfPagePath s++[name]}
               return r 
              
----- | return the value of a post or get param in the form ?param=value&param2=value2...-getKeyValueParam par= do-  st <- get-  r <- getParam1 par $ mfEnv st-  return $ valToMaybe r+
+
+-- | return the value of a post or get param in the form ?param=value&param2=value2...
+getKeyValueParam par= do
+  st <- get
+  r <- getParam1 par $ mfEnv st
+  return $ valToMaybe r
   
 readParam :: (Monad m, MonadState (MFlowState v) m, Typeable a, Read a, FormInput v)
            => String -> m (ParamResult v a)
@@ -1260,9 +1298,9 @@  x= getType r
  maybeRead str= do
    let typeofx = typeOf x
-   if typeofx == typeOf  ( undefined :: String)   then-           return . Validated $ unsafeCoerce str-    else if typeofx == typeOf (undefined :: T.Text) then+   if typeofx == typeOf  ( undefined :: String)   then
+           return . Validated $ unsafeCoerce str
+    else if typeofx == typeOf (undefined :: T.Text) then
            return . Validated . unsafeCoerce  $ T.pack str
     else case readsPrec 0 $ str of
               [(x,"")] ->  return $ Validated x
@@ -1271,73 +1309,90 @@                    return $ NotValidated str err
 
 
----- Requirements----- | Requirements are javascripts, Stylesheets or server processes (or any instance of the 'Requirement' class) that are included in the--- Web page or in the server when a widget specifies this. @requires@ is the--- procedure to be called with the list of requirements.--- Various widgets in the page can require the same element, MFlow will install it once.-requires rs =do-    st <- get-    let l = mfRequirements st---    let rs'= map Requirement rs \\ l-    put st {mfRequirements= l ++ map Requirement rs}----data Requirement= forall a.(Show a,Typeable a,Requirements a) => Requirement a deriving Typeable--class Requirements  a where-   installRequirements :: (Monad m,FormInput view) => Bool -> [a] ->  m view--instance Show Requirement where-   show (Requirement a)= show a ++ "\n"--installAllRequirements :: ( Monad m, FormInput view) =>  WState view m view-installAllRequirements= do- st <- get- let rs = mfRequirements st-     auto = mfAutorefresh st- installAllRequirements1 auto mempty rs- where-- installAllRequirements1 _ v []= return v- installAllRequirements1 auto v rs= do-   let typehead= case head rs  of {Requirement r -> typeOf  r}-       (rs',rs'')= partition1 typehead  rs-   v' <- installRequirements2 rs'-   installAllRequirements1 auto (v `mappend` v') rs''-   where-   installRequirements2 []= return $ fromStrNoEncode ""-   installRequirements2 (Requirement r:rs)= installRequirements auto  $ r:unmap rs-   unmap []=[]-   unmap (Requirement r:rs)= unsafeCoerce r:unmap rs-   partition1 typehead  xs = foldr select  ([],[]) xs-     where-     select  x ~(ts,fs)=-        let typer= case x of Requirement r -> typeOf r-        in if typer== typehead then ( x:ts,fs)-                           else (ts, x:fs)-+---- Requirements
+
+
+-- | Requirements are javascripts, Stylesheets or server processes (or any instance of the 'Requirement' class) that are included in the
+-- Web page or in the server when a widget specifies this. @requires@ is the
+-- procedure to be called with the list of requirements.
+-- Various widgets in the page can require the same element, MFlow will install it once.
+
+
+requires rs =do
+    st <- get
+    let l = mfRequirements st
+    put st {mfRequirements= l ++ map Requirement rs}
+
+unfold (JScriptFile f ss)= JScript loadScript:map (\s-> JScriptFile f [s]) ss
+unfold x= [x]
+
+data Requirement= forall a.(Show a,Typeable a,Requirements a) => Requirement a deriving Typeable
+
+class Requirements  a where
+   installRequirements :: (MonadState (MFlowState view) m,MonadIO m,FormInput view) => [a] ->  m view
+
+instance Show Requirement where
+   show (Requirement a)= show a ++ "\n"
+
+installAllRequirements :: ( MonadIO m, FormInput view) =>  WState view m view
+installAllRequirements= do
+ st <- get
+ let rs = mfRequirements st
+ installAllRequirements1  mempty rs
+
+ where
+
+ installAllRequirements1  v []= return v
+ installAllRequirements1  v rs= do
+   let typehead= case head rs  of {Requirement r -> typeOf  r}
+       (rs',rs'')= partition1 typehead  rs
+   v' <- installRequirements2 rs'
+   installAllRequirements1  (v `mappend` v') rs''
+   where
+   installRequirements2 []= return $ fromStrNoEncode ""
+   installRequirements2 (Requirement r:rs)= installRequirements   $ r:unmap rs
+   unmap []=[]
+   unmap (Requirement r:rs)= unsafeCoerce r:unmap rs
+   partition1 typehead  xs = foldr select  ([],[]) xs
+     where
+     select  x ~(ts,fs)=
+        let typer= case x of Requirement r -> typeOf r
+        in if typer== typehead then ( x:ts,fs)
+                           else (ts, x:fs)
+
 -- Web requirements ---
-loadjsfile filename lcallbacks=- let name= addrStr filename in-  "var fileref = document.getElementById('"++name++"');\+loadjsfile filename=
+ let name= addrStr filename
+ in  "\n"++name++"=loadScript('"++name++"','"++filename++"');\n"
+
+loadScript ="function loadScript(name, filename){\
+  \var fileref = document.getElementById(name);\
   \if (fileref === null){\
-      \fileref=document.createElement('script');\-      \fileref.setAttribute('id','"++name++"');\
+      \fileref=document.createElement('script');\
+      \fileref.setAttribute('id',name);\
       \fileref.setAttribute('type','text/javascript');\
-      \fileref.setAttribute('src',\'" ++ filename ++ "\');\
-      \document.getElementsByTagName('head')[0].appendChild(fileref);};"
-  ++ onload
-  where
-  onload= case lcallbacks of
-    [] -> ""
-    cs -> "fileref.onload = function() {"++ (concat $ nub cs)++"};"
+      \fileref.setAttribute('src',filename);\
+      \document.getElementsByTagName('head')[0].appendChild(fileref);}\
+      \return fileref};\n\
+  \function addLoadEvent(elem,func) {\
+  \var oldonload = elem.onload;\
+  \if (typeof elem.onload != 'function') {\
+    \elem.onload = func;\
+  \} else {\
+    \elem.onload = function() {\
+      \if (oldonload) {\
+        \oldonload();\
+      \}\
+      \func();\
+    \}\
+  \}\
+ \}"
+   
+loadCallback depend script=
+  let varname= addrStr depend in
+  "\naddLoadEvent("++varname++",function(){"++ script++"});"
 
 
-loadjs content= content
 
 
 loadcssfile filename=
@@ -1366,7 +1421,7 @@                      deriving(Typeable,Eq,Ord,Show)
 
 instance Eq (String, Flow) where
-   (x,_) == (y,_)= x == y+   (x,_) == (y,_)= x == y
  
 instance Ord (String, Flow) where
    compare(x,_)  (y,_)= compare x y
@@ -1378,42 +1433,57 @@ 
 
 
-installWebRequirements ::  (Monad m,FormInput view) => Bool -> [WebRequirement] -> m view
-installWebRequirements auto rs= do
-  let s =  jsRequirements auto $ sort rs  
+installWebRequirements
+ ::  (MonadState(MFlowState view) m,MonadIO m,FormInput view) => [WebRequirement] -> m view
+installWebRequirements  rs= do
+  installed <- gets mfInstalledScripts
+  let rs'=  (nub  rs) \\ installed
 
-  return $ ftag "script" (fromStrNoEncode  s)
+  strs <- mapM strRequirement rs'             -- !>( "OLD="++show installed) !> ("new="++show rs')
+  case null strs of
+      True  -> return mempty
+      False -> return . ftag "script" . fromStrNoEncode  $ concat strs
 
 
-jsRequirements _  []= ""
+strRequirement r=do
+   r1 <- strRequirement' r
+   modify $ \st -> st{mfInstalledScripts= mfInstalledScripts st ++ [r]}
+   return r1
+        
+strRequirement' (CSSFile scr)          = return $ loadcssfile scr
+strRequirement' (CSS scr)              = return $ loadcss scr
+strRequirement' (JScriptFile file scripts) = do
+    installed <- gets mfInstalledScripts
+    let hasLoadScript  (JScriptFile _ _)= True
+        hasLoadScript  _= False
+        inst2= dropWhile (not . hasLoadScript) installed
+        hasSameFile  file (JScriptFile fil _)= if file== fil then True  else False
+        hasSameFile _ _= False
+    case (inst2,find (hasSameFile file) inst2) of
+         ([],_) ->
+               -- no script file has been loaded previously
+               return $ loadScript <> loadjsfile file  <>  concatMap(loadCallback file) scripts
+         (_,Just _) -> do
+               -- This script file has been already loaded or demanded for load
+               autorefresh <- gets mfAutorefresh
+               case autorefresh of
+                        -- demanded for load, not loaded
+                        False -> return $ concatMap(loadCallback file) scripts
+                        -- already loaded
+                        True  -> return $ concat scripts
+               -- other script file has been loaded or demanded load, so loadScript is already installed
+         _ ->  return $  loadjsfile file  <>  concatMap(loadCallback file) scripts
 
-jsRequirements False (r@(JScriptFile f c) : r'@(JScriptFile f' c'):rs)
-         | f==f' = jsRequirements False $ JScriptFile f (nub $ c++c'):rs
-         | otherwise= strRequirement r ++ jsRequirements False (r':rs)
--jsRequirements True (r@(JScriptFile f c) : r'@(JScriptFile f' c'):rs)
-         | f==f' = concatMap strRequirement(map JScript $ nub (c' ++ c)) ++ jsRequirements True rs
-         | otherwise= strRequirement r ++ jsRequirements True (r':rs)
----         
-jsRequirements auto (r:r':rs)
-         | r== r' = jsRequirements  auto $ r:rs
-         | otherwise= strRequirement r ++ jsRequirements auto (r':rs)
+    
+strRequirement' (JScript scr)  = return scr
+strRequirement' (ServerProc  f)= do
+   liftIO $ addMessageFlows [f]
+   return ""
 
-jsRequirements auto (r:rs)= strRequirement r++jsRequirements auto rs
-  
-strRequirement (CSSFile s')          = loadcssfile s'
-strRequirement (CSS s')              = loadcss s'
-strRequirement (JScriptFile s' call) = loadjsfile s' call
-strRequirement (JScript s')          = loadjs s'
-strRequirement (ServerProc  f)= (unsafePerformIO $! addMessageFlows [f]) `seq` ""
--- 
 
+
+
 --- AJAX ----
 ajaxScript=
         "function loadXMLObj()" ++
@@ -1446,41 +1516,50 @@         "  };" ++
         ""
 
-formPrefix   st form anchored= do-     let verb = twfname $ mfToken st-         path  = currentPath st 
+formPrefix st form anchored= do
+     let verb = twfname $ mfToken st
+         path  = currentPath st
+         hasfile= mfFileUpload st
+         attr= case hasfile of
+             True -> [("enctype","multipart/form-data")]
+             False ->  []
      (anchor,anchorf)
            <- case anchored of
                True  -> do
                         anchor <- genNewId
                         return ('#':anchor, (ftag "a") mempty  `attrs` [("name",anchor)])
                False -> return (mempty,mempty)
-     return $ formAction (path ++ anchor ) $  anchorf <> form  -- !> anchor
+     return $ formAction (path ++ anchor ) "POST"  ( anchorf <> form ) `attrs` attr
 
+
+
+
+     
+
 -- | insert a form tag if the widget has form input fields. If not, it does nothing
 insertForm w=View $ do
     FormElm forms mx <- runView w
     st <- get
-    cont <- case needForm1 st of
-              True ->  do
-                       frm <- formPrefix  st forms False
+    cont <- case needForm st of
+              HasElems  ->  do
+                       frm <- formPrefix st forms False
                        put st{needForm= HasForm}
                        return   frm
               _    ->  return forms
     
     return $ FormElm cont mx
---- isert a form tag if necessary when two pieces of HTML have to mix as a result of >>= >> <|>  or <+> operators-controlForms :: (FormInput v, MonadState (MFlowState v) m)-    => MFlowState v -> MFlowState v -> v -> v -> m (v,Bool)-controlForms s1 s2 v1 v2= case (needForm s1, needForm s2) of---    (HasForm,HasElems) -> do---       v2' <- formPrefix s2 v2 True---       return (v1 ++ [v2'], True)-    (HasElems, HasForm) -> do-       v1' <- formPrefix s1 v1 True-       return (v1' <> v2 , True)-+
+-- isert a form tag if necessary when two pieces of HTML have to mix as a result of >>= >> <|>  or <+> operators
+controlForms :: (FormInput v, MonadState (MFlowState v) m)
+    => MFlowState v -> MFlowState v -> v -> v -> m (v,Bool)
+controlForms s1 s2 v1 v2= case (needForm s1, needForm s2) of
+--    (HasForm,HasElems) -> do
+--       v2' <- formPrefix s2 v2 True
+--       return (v1 ++ [v2'], True)
+    (HasElems, HasForm) -> do
+       v1' <- formPrefix s1 v1 True
+       return (v1' <> v2 , True)
+
     _ -> return (v1 <> v2, False)
 
 currentPath  st=  concat ['/':v| v <- mfPagePath st ]
@@ -1515,6 +1594,6 @@     True  -> do
       let n = mfSeqCache st
       return $  'c' : (show n)
--+
+
src/MFlow/Forms/Test.hs view
@@ -48,8 +48,8 @@ import Data.Dynamic
 import Data.TCache.Memoization
 
- 
+
 class Generate a where
   generate :: IO a
 
@@ -106,7 +106,7 @@     name <- generate
     x <- generate
     y <- generate
-    z <- generate+    z <- generate
      
     let t = Token x y z [] [] undefined undefined undefined
     WF.start  name   f t
src/MFlow/Forms/WebApi.hs view
@@ -1,91 +1,91 @@------------------------------------------------------------------------------------ A haskell formlet is the combination of a parameter parser to read input plus a writer to generate HTTP--- output------ I use this similarity to create parsec-like combinators that use the formlet monad in MFlow---(the View monad) to parse the web service parameters and to generate the output.------ This service below implements a service that sum or multiply two Int-egers.------ > parserService :: View Html IO ()--- > parserService=--- >        do rest "sum"  ; disp $ (+) <$> wint "t1" <*> wint "t2"--- >    <|> do rest "prod" ; disp $ (*) <$> wint "t1" <*> wint "t2"--- >    <?> do -- blaze Html--- >           h1 << "ERROR. API usage:"--- >           h3 << "http://server/api/sum?t1=[Int]&t2=[Int]"--- >           h3 << "http://server/api/prod?t1=[Int]&t2=[Int]"--- >   where--- >   asks w= ask $ w >> stop--- >   wint p= wparam p :: View Html IO Int------ Can be called with:------ > mainParser  = runNavigation "apiparser" . step . asks (parserService >> stop)------ or------ > mainParser =do--- >   addMessageFlows[("apiparser",wstateless  parserService)]--- >   wait $ run 80 waiMessageFlow--------------------------------------------------------------------------------module MFlow.Forms.WebApi (-restp, rest, wparam, disp,(<?>)-) where-import MFlow.Forms.Internals-import MFlow.Forms(stop,(++>))-import Control.Monad.State-import Data.Typeable-import Data.Monoid--- | Get the next segment of the REST path. if there is no one or if the data does not match--- with the type expected, then ir return invalid.---  Therefore a monadic sequence in the View monad will not continue-restp :: (Monad m,Functor m, FormInput v,Typeable a,Read a) => View v m a-restp =  View $ do-   mr <- getRestParam-   return $ FormElm mempty mr------ | check that the next rest segment has a certain value. It return invalid otherwise.--- therefore a monadic sequence in the View monad will not continue-rest v= do-   r <- restp-   if r==v then return v-    else-     modify (\s -> s{mfPagePath= reverse . tail . reverse $ mfPagePath s}) >> stop---- | get a parameter from a GET or POST key-value input.-wparam par= View $ do-   mr <- getKeyValueParam par-   return $ FormElm mempty mr---- | append to the output the result of an expression-dispv :: (Monad m, FormInput v) => View v m v -> View  v m ()-dispv w= View $ do-   FormElm f mx <- runView w-   case mx of-     Nothing -> return $ FormElm f Nothing-     justx@(Just x) -> return $ FormElm (f <> x) $ return ()----- | append to the output the result of an expression-disp :: (Monad m, FormInput v, Show a) => View v m a -> View  v m ()-disp w= View $ do-   FormElm f mx <- runView w-   case mx of-     Nothing -> return $ FormElm f Nothing-     justx@(Just x) -> return $ FormElm (f <>fromStr (show x)) $ return ()---- | error message when a applicative expression do not match-infixl 3 <?>-(<?>) w v= View $ do-  r@(FormElm f mx) <- runView w-  case mx of-    Nothing -> runView $ v ++> stop-    Just _ -> return r---+-----------------------------------------------------------------------------
+--
+-- A haskell formlet is the combination of a parameter parser to read input plus a writer to generate HTTP
+-- output
+--
+-- I use this similarity to create parsec-like combinators that use the formlet monad in MFlow
+--(the View monad) to parse the web service parameters and to generate the output.
+--
+-- This service below implements a service that sum or multiply two Int-egers.
+--
+-- > parserService :: View Html IO ()
+-- > parserService=
+-- >        do rest "sum"  ; disp $ (+) <$> wint "t1" <*> wint "t2"
+-- >    <|> do rest "prod" ; disp $ (*) <$> wint "t1" <*> wint "t2"
+-- >    <?> do -- blaze Html
+-- >           h1 << "ERROR. API usage:"
+-- >           h3 << "http://server/api/sum?t1=[Int]&t2=[Int]"
+-- >           h3 << "http://server/api/prod?t1=[Int]&t2=[Int]"
+-- >   where
+-- >   asks w= ask $ w >> stop
+-- >   wint p= wparam p :: View Html IO Int
+--
+-- Can be called with:
+--
+-- > mainParser  = runNavigation "apiparser" . step . asks (parserService >> stop)
+--
+-- or
+--
+-- > mainParser =do
+-- >   addMessageFlows[("apiparser",wstateless  parserService)]
+-- >   wait $ run 80 waiMessageFlow
+-----------------------------------------------------------------------------
+
+module MFlow.Forms.WebApi (
+restp, rest, wparam, disp,(<?>)
+) where
+import MFlow.Forms.Internals
+import MFlow.Forms(stop,(++>))
+import Control.Monad.State
+import Data.Typeable
+import Data.Monoid
+-- | Get the next segment of the REST path. if there is no one or if the data does not match
+-- with the type expected, then ir return invalid.
+--  Therefore a monadic sequence in the View monad will not continue
+restp :: (Monad m,Functor m, FormInput v,Typeable a,Read a) => View v m a
+restp =  View $ do
+   mr <- getRestParam
+   return $ FormElm mempty mr
+
+
+
+-- | check that the next rest segment has a certain value. It return invalid otherwise.
+-- therefore a monadic sequence in the View monad will not continue
+rest v= do
+   r <- restp
+   if r==v then return v
+    else
+     modify (\s -> s{mfPagePath= reverse . tail . reverse $ mfPagePath s}) >> stop
+
+-- | get a parameter from a GET or POST key-value input.
+wparam par= View $ do
+   mr <- getKeyValueParam par
+   return $ FormElm mempty mr
+
+-- | append to the output the result of an expression
+dispv :: (Monad m, FormInput v) => View v m v -> View  v m ()
+dispv w= View $ do
+   FormElm f mx <- runView w
+   case mx of
+     Nothing -> return $ FormElm f Nothing
+     justx@(Just x) -> return $ FormElm (f <> x) $ return ()
+
+
+-- | append to the output the result of an expression
+disp :: (Monad m, FormInput v, Show a) => View v m a -> View  v m ()
+disp w= View $ do
+   FormElm f mx <- runView w
+   case mx of
+     Nothing -> return $ FormElm f Nothing
+     justx@(Just x) -> return $ FormElm (f <>fromStr (show x)) $ return ()
+
+-- | error message when a applicative expression do not match
+infixl 3 <?>
+(<?>) w v= View $ do
+  r@(FormElm f mx) <- runView w
+  case mx of
+    Nothing -> runView $ v ++> stop
+    Just _ -> return r
+
+
+
src/MFlow/Forms/Widgets.hs view
@@ -4,11 +4,11 @@ widgets for templating, content management and multilanguage. And some primitives
 to create other active widgets.
 -}
--- {-# OPTIONS -F -pgmF cpphs  #-}+-- {-# OPTIONS -F -pgmF cpphs  #-}
 {-# OPTIONS -cpp  -pgmPcpphs  -optP--cpp #-}
 {-# LANGUAGE  UndecidableInstances,ExistentialQuantification
             , FlexibleInstances, OverlappingInstances, FlexibleContexts
-            , OverloadedStrings, DeriveDataTypeable , ScopedTypeVariables+            , OverloadedStrings, DeriveDataTypeable , ScopedTypeVariables
             , StandaloneDeriving #-}
 
 
@@ -46,7 +46,7 @@ import MFlow.Forms
 import MFlow.Forms.Internals
 import Data.Monoid
-import Data.ByteString.Lazy.UTF8 as B hiding (length,span)+import Data.ByteString.Lazy.UTF8 as B hiding (length,span)
 import Data.ByteString.Lazy.Char8 (unpack)
 import Control.Monad.Trans
 import Data.Typeable
@@ -67,7 +67,7 @@ import Control.Workflow(killWF)
 import Unsafe.Coerce
 import Control.Exception
-import MFlow.Forms.Cache+import MFlow.Forms.Cache
 
 
 
@@ -106,29 +106,29 @@       then do
           cmd <- ajax $ const $ return "window.location=='/'" --refresh
           fromStr " " ++> ((wlink () (fromStr "logout")) <![("onclick",cmd "''")]) `waction` const logout
-      else noWidget-+      else noWidget
 
-data Medit view m a = Medit (M.Map B.ByteString [(String,View view m a)])--#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)--  deriving  Typeable--#else--instance (Typeable view, Typeable a) => Typeable (Medit view m a) where-  typeOf= \v -> mkTyConApp (mkTyCon3 "MFlow" "MFlow.Forms.Widgets" "Medit" )-                [typeOf (tview v)-                ,typeOf (ta v)]-      where-      tview :: Medit v m a -> v-      tview= undefined-      tm :: Medit v m a -> m a-      tm= undefined-      ta :: Medit v m a -> a-      ta= undefined-+
+data Medit view m a = Medit (M.Map B.ByteString [(String,View view m a)])
+
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+
+  deriving  Typeable
+
+#else
+
+instance (Typeable view, Typeable a) => Typeable (Medit view m a) where
+  typeOf= \v -> mkTyConApp (mkTyCon3 "MFlow" "MFlow.Forms.Widgets" "Medit" )
+                [typeOf (tview v)
+                ,typeOf (ta v)]
+      where
+      tview :: Medit v m a -> v
+      tview= undefined
+      tm :: Medit v m a -> m a
+      tm= undefined
+      ta :: Medit v m a -> a
+      ta= undefined
+
 #endif
 
 -- | If not logged, it present a page flow which askm  for the user name, then the password if not logged
@@ -137,17 +137,17 @@ --
 -- normally to be used with autoRefresh and pageFlow when used with other widgets.
 wlogin :: (MonadIO m,Functor m,FormInput v) => View v m ()
-wlogin=  do
+wlogin=  wform $ do
    username <- getCurrentUser
    if username /= anonymous  
-         then do-           private; noCache;noStore+         then do
+           private; noCache;noStore
            return username 
          else do
-          name <- getString Nothing <! hint "login name"-                                    <! size (9 :: Int)+          name <- getString Nothing <! hint "login name"
+                                    <! size (9 :: Int)
                   <++ ftag "br" mempty
-          pass <- getPassword <! hint "password"+          pass <- getPassword <! hint "password"
                               <! size 9
                      <++ ftag "br" mempty
                      <** submitButton "login" 
@@ -169,20 +169,20 @@     return $ fromMaybe [] $ M.lookup id stored
 
 -- | Return the list of edited widgets (added by the active widgets) for a given identifier
-getEdited--#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)--     :: (Typeable v, Typeable a, Typeable m1, MonadState (MFlowState view) m) =>--#else--    :: (Typeable v, Typeable a, MonadState (MFlowState view) m) =>--#endif-+getEdited
+
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+
+     :: (Typeable v, Typeable a, Typeable m1, MonadState (MFlowState view) m) =>
+
+#else
+
+    :: (Typeable v, Typeable a, MonadState (MFlowState view) m) =>
+
+#endif
+
       B.ByteString -> m [View v m1 a]
-+
 getEdited id= do
   r <- getEdited1 id
   let (_,ws)= unzip r
@@ -190,13 +190,13 @@ 
 -- | Deletes the list of edited widgets for a certain identifier and with the type of the witness widget parameter
 delEdited
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-    :: (Typeable v, Typeable a, MonadIO m, Typeable m1,-#else-    :: (Typeable v, Typeable a, MonadIO m,-#endif-  MonadState (MFlowState view) m)-       => B.ByteString           -- ^ identifier+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+    :: (Typeable v, Typeable a, MonadIO m, Typeable m1,
+#else
+    :: (Typeable v, Typeable a, MonadIO m,
+#endif
+  MonadState (MFlowState view) m)
+       => B.ByteString           -- ^ identifier
          -> [View v m1 a] -> m ()  -- ^ withess
 delEdited id witness=do
     Medit stored <-  getSessionData `onNothing` return (Medit (M.empty))
@@ -221,11 +221,11 @@     ws <- getEdited1 id
     setEdited id (w:ws)
 
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-modifyWidget :: (MonadIO m,Executable m,Typeable a,FormInput v, Typeable Identity, Typeable m)+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+modifyWidget :: (MonadIO m,Executable m,Typeable a,FormInput v, Typeable Identity, Typeable m)
 #else
 modifyWidget :: (MonadIO m,Executable m,Typeable a,FormInput v)
-#endif+#endif
     => B.ByteString -> B.ByteString -> View v Identity a -> View v m B.ByteString
 modifyWidget selector modifier  w = View $ do
      ws <- getEdited selector
@@ -263,11 +263,11 @@ -- >    delEdited sel ws'
 -- >    return  r
 
-prependWidget-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-  :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m)+prependWidget
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+  :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m)
 #else
-  :: (Typeable a, MonadIO m, Executable m, FormInput v)+  :: (Typeable a, MonadIO m, Executable m, FormInput v)
 #endif
   => B.ByteString           -- ^ jquery selector
   -> View v Identity a      -- ^ widget to prepend
@@ -276,20 +276,20 @@ 
 -- | Like 'prependWidget' but append the widget instead of prepend.
 appendWidget
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-  :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m) =>-#else-     :: (Typeable a, MonadIO m, Executable m, FormInput v) =>-#endif+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+  :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m) =>
+#else
+     :: (Typeable a, MonadIO m, Executable m, FormInput v) =>
+#endif
         B.ByteString -> View v Identity a -> View v m B.ByteString
 appendWidget sel w= modifyWidget sel "append" w
 
 -- | L  ike 'prependWidget' but set the entire content of the selector instead of prepending an element
 setWidget
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-  :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable m,  Typeable Identity) =>-#else-   :: (Typeable a, MonadIO m, Executable m, FormInput v) =>+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+  :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable m,  Typeable Identity) =>
+#else
+   :: (Typeable a, MonadIO m, Executable m, FormInput v) =>
 #endif
      B.ByteString -> View v Identity a -> View v m B.ByteString
 setWidget sel w= modifyWidget sel "html" w
@@ -322,11 +322,11 @@ -- >  getString1 mx= El.div  <<< delBox ++> getString  mx <++ br
 
 wEditList :: (Typeable a,Read a
-             ,FormInput view-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-             ,Functor m,MonadIO m, Executable m, Typeable m, Typeable Identity)+             ,FormInput view
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+             ,Functor m,MonadIO m, Executable m, Typeable m, Typeable Identity)
 #else
-             ,Functor m,MonadIO m, Executable m)+             ,Functor m,MonadIO m, Executable m)
 #endif
           => (view ->view)     -- ^ The holder tag
           -> (Maybe String -> View view Identity a) -- ^ the contained widget, initialized  by a string
@@ -396,11 +396,11 @@ -- >               ++> ftag "span" (fromStr $ fromJust x )
 -- >               ++> whidden( fromJust x)
 wautocompleteEdit
-    :: (Typeable a, MonadIO m,Functor m, Executable m-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-     , FormInput v, Typeable m, Typeable Identity)+    :: (Typeable a, MonadIO m,Functor m, Executable m
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+     , FormInput v, Typeable m, Typeable Identity)
 #else
-     , FormInput v)+     , FormInput v)
 #endif
     => String                                 -- ^ the initial text of the box
     -> (String -> IO [String])                -- ^ the autocompletion procedure: receives a prefix, return a list of options.
@@ -450,19 +450,19 @@          \});"
 
     jaddtoautocomp textx us= "$('#"<>fromString textx<>"').autocomplete({ source: " <> fromString( show us) <> "  });"
---#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-deriving instance Typeable Identity-#endif 
+
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+deriving instance Typeable Identity
+#endif
+
 -- | A specialization of 'wutocompleteEdit' which make appear each chosen option with
 -- a checkbox that deletes the element when uncheched. The result, when submitted, is the list of selected elements.
-wautocompleteList-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)-  :: (Functor m, MonadIO m, Executable m, FormInput v, Typeable m, Typeable Identity) =>+wautocompleteList
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
+  :: (Functor m, MonadIO m, Executable m, FormInput v, Typeable m, Typeable Identity) =>
 #else
-  :: (Functor m, MonadIO m, Executable m, FormInput v) =>+  :: (Functor m, MonadIO m, Executable m, FormInput v) =>
 #endif
      String -> (String -> IO [String]) -> [String] -> View v m [String]
 wautocompleteList phold serverproc values=
@@ -503,15 +503,15 @@     Just (TField k v) -> if v /= mempty then return $ fromStrNoEncode $ toString v else return text
     Nothing -> return text
 
--- | Creates a rich text editor aroun a text field or a text area widget.---   This code:------ > page $ p "Insert the text"--- >    ++> htmlEdit ["bold","italic"] ""--- >           (getMultilineText "" <! [("rows","3"),("cols","80")]) <++ br--- >    <** submitButton "enter"------   Creates a rich text area with bold and italic buttons. The buttons are the ones alled+-- | Creates a rich text editor aroun a text field or a text area widget.
+--   This code:
+--
+-- > page $ p "Insert the text"
+-- >    ++> htmlEdit ["bold","italic"] ""
+-- >           (getMultilineText "" <! [("rows","3"),("cols","80")]) <++ br
+-- >    <** submitButton "enter"
+--
+--   Creates a rich text area with bold and italic buttons. The buttons are the ones alled
 --   in the nicEdit editor.
 htmlEdit :: (Monad m, FormInput v) =>  [String] -> UserStr -> View v m a -> View v m a
 htmlEdit buttons jsuser w = do
@@ -526,7 +526,7 @@                  \})};\n"
       install= "installHtmlField('"++jsuser++"','"++cookieuser++"','"++id++"',"++show buttons++");\n"
 
-  requires [JScriptFile nicEditUrl [installHtmlField,install]]
+  requires [JScript installHtmlField ,JScriptFile nicEditUrl [install]]
   w <! [("id",id)]
 
 
@@ -554,7 +554,7 @@    nam     <- genNewId
    let ipanel= nam++"panel"
        name= nam++"-"++k
-       install= "\ninstallEditField('"++muser++"','"++cookieuser++"','"++name++"','"++ipanel++"');\n"
+       install= "installEditField('"++muser++"','"++cookieuser++"','"++name++"','"++ipanel++"');\n"
        getTexts :: (Token -> IO ())
        getTexts token = do
          let (k,s):_ = tenv token
@@ -567,11 +567,10 @@    requires [JScriptFile nicEditUrl [install]
             ,JScript     ajaxSendText
             ,JScript     installEditField
---            ,JScriptFile jqueryScript []
             ,ServerProc  ("_texts",  transient getTexts)]
--   us <- getCurrentUser-   when(us== muser) noCache+
+   us <- getCurrentUser
+   when(us== muser) noCache
    
    (ftag "div" mempty `attrs` [("id",ipanel)]) ++>
     notValid (ftag "span" content `attrs` [("id", name)])
@@ -580,8 +579,7 @@ 
 installEditField=
           "\nfunction installEditField(muser,cookieuser,name,ipanel){\
-            \if(muser== '' || document.cookie.search(cookieuser+'='+muser) != -1)\
-                  \bkLib.onDomLoaded(function() {\
+            \if(muser== '' || document.cookie.search(cookieuser+'='+muser) != -1){\
                     \var myNicEditor = new nicEditor({fullPanel : true, onSave : function(content, id, instance) {\
                          \ajaxSendText(id,content);\
                          \myNicEditor.removeInstance(name);\
@@ -589,7 +587,7 @@                        \}});\
                     \myNicEditor.addInstance(name);\
                     \myNicEditor.setPanel(ipanel);\
-                 \})};\n"
+                 \}};\n"
 
 ajaxSendText = "\nfunction ajaxSendText(id,content){\
         \var arr= id.split('-');\
@@ -628,7 +626,7 @@   lang <- getLang
   tField $ k ++ ('-':lang)
 
-newtype IteratedId= IteratedId  String deriving Typeable
+data IteratedId = IteratedId  String String deriving (Typeable, Show)
 
 -- | Permits to iterate the presentation of data and//or input fields and widgets within
 -- a web page that does not change. The placeholders are created with dField.  Both are widget
@@ -654,7 +652,7 @@       View v m a -> View v m a
 witerate w= do
    name <- genNewId
-   setSessionData $ IteratedId name 
+   setSessionData $ IteratedId name mempty
    st <- get
    let t= mfkillTime st
    let installAutoEval=
@@ -662,12 +660,12 @@            \autoEvalLink('"++name++"',0);\
            \autoEvalForm('"++name++"');\
            \})\n"
-   let r = lookup ("auto"++name) $ mfEnv st-       w'= w `wcallback` (const $ do-                              modify $ \s -> s{mfPagePath=mfPagePath st-                                             ,mfSequence= mfSequence st-                                             ,mfRequirements= if r== Nothing then  mfRequirements s else []-                                             ,mfHttpHeaders=[]}+   let r = lookup ("auto"++name) $ mfEnv st
+       w'= w `wcallback` (const $ do
+                              setSessionData $ IteratedId name mempty
+                              modify $ \s -> s{mfPagePath=mfPagePath st
+                                             ,mfSequence= mfSequence st
+                                             ,mfHttpHeaders=[]}
                               w) 
 
    ret <- case r of
@@ -675,47 +673,52 @@      requires [JScript     autoEvalLink
               ,JScript     autoEvalForm
               ,JScript     $ timeoutscript t
-              ,JScriptFile jqueryScript [installAutoEval]+              ,JScriptFile jqueryScript [installAutoEval]
               ,JScript     setId]    
 
      (ftag "div" <<< w') <! [("id",name)] 
 
-    Just sind -> View $ do
-         let t= mfToken st
-         modify $ \s -> s{mfRequirements=[],mfHttpHeaders=[]} -- !> "just"
-         resetCachePolicy 
-         FormElm _ mr <- runView w'
-         setCachePolicy 
-         reqs <- return . map ( \(Requirement r) -> unsafeCoerce r) =<< gets mfRequirements
-         let js = jsRequirements True reqs--         st' <- get 
-         liftIO . sendFlush t $ HttpData
-                                (mfHttpHeaders st') 
-                                (mfCookies st') (fromString js)
-         put st'{mfAutorefresh=True, inSync=True} 
-         return $ FormElm mempty Nothing  
+    Just sind -> refresh $ View $ do
+              FormElm _ mr <- runView w'
+              IteratedId _ render <- getSessionData `onNothing` return (IteratedId name mempty)
+              return $ FormElm (fromStrNoEncode render) mr
 
-   delSessionData $ IteratedId name
-   return ret--+--     View $ do
+--         let t= mfToken st
+--         modify $ \s -> s{mfRequirements=[],mfHttpHeaders=[]} -- !> "just"
+--         resetCachePolicy 
+--         FormElm _ mr <- runView w'
+--         setCachePolicy 
+--
+--         reqs <- installAllRequirements
+--
+--         st' <- get 
+--         liftIO . sendFlush t $ HttpData
+--                                (mfHttpHeaders st') 
+--                                (mfCookies st')  (toByteString reqs)
+--         put st'{mfAutorefresh=True, inSync=True} 
+--         return $ FormElm mempty Nothing  
 
+   delSessionData $ IteratedId name mempty
+   return ret
+
+
+
 autoEvalLink = "\nfunction autoEvalLink(id,ind){\
     \var id1= $('#'+id);\
-    \var ida= $('#'+id+' a[class!=\"_noAutoRefresh\"]');\+    \var ida= $('#'+id+' a[class!=\"_noAutoRefresh\"]');\
     \ida.off('click');\
     \ida.click(function () {\
      \if (hadtimeout == true) return true;\
      \var pdata = $(this).attr('data-value');\
      \var actionurl = $(this).attr('href');\
      \var dialogOpts = {\
-           \type: 'GET',\+           \type: 'GET',\
            \url: actionurl+'?auto'+id+'='+ind,\
            \data: pdata,\
            \success: function (resp) {\
-               \eval(resp);\-               \autoEvalLink(id,ind);\+               \eval(resp);\
+               \autoEvalLink(id,ind);\
                \autoEvalForm(id);\
            \},\
            \error: function (xhr, status, error) {\
@@ -727,56 +730,56 @@      \return false;\
     \});\
   \}\n"
--autoEvalForm = "\nfunction autoEvalForm(id) {\-    \var buttons= $('#'+id+' input[type=\"submit\"]');\-    \var idform= $('#'+id+' form[class!=\"_noAutoRefresh\"]');\-    \buttons.off('click');\-    \buttons.click(function(event) {\-      \if ($(this).attr('class') != '_noAutoRefresh'){\-        \event.preventDefault();\-        \if (hadtimeout == true) return true;\+
+autoEvalForm = "\nfunction autoEvalForm(id) {\
+    \var buttons= $('#'+id+' input[type=\"submit\"]');\
+    \var idform= $('#'+id+' form[class!=\"_noAutoRefresh\"]');\
+    \buttons.off('click');\
+    \buttons.click(function(event) {\
+      \if ($(this).attr('class') != '_noAutoRefresh'){\
+        \event.preventDefault();\
+        \if (hadtimeout == true) return true;\
         \var $form = $(this).closest('form');\
-        \var url = $form.attr('action');\-        \pdata = 'auto'+id+'=true&'+this.name+'='+this.value+'&'+$form.serialize();\-        \postForm(id,url,pdata);\-        \return false;\+        \var url = $form.attr('action');\
+        \pdata = 'auto'+id+'=true&'+this.name+'='+this.value+'&'+$form.serialize();\
+        \postForm(id,url,pdata);\
+        \return false;\
         \}else {\
-          \noajax= true;\-          \return true;\-        \}\-     \})\-    \\n\-    \var noajax;\-    \idform.submit(function(event) {\-     \if(noajax) {noajax=false; return true;}\-       \event.preventDefault();\+          \noajax= true;\
+          \return true;\
+        \}\
+     \})\
+    \\n\
+    \var noajax;\
+    \idform.submit(function(event) {\
+     \if(noajax) {noajax=false; return true;}\
+       \event.preventDefault();\
        \var $form = $(this);\
-       \var url = $form.attr('action');\-       \var pdata = 'auto'+id+'=true&' + $form.serialize();\-       \postForm(id,url,pdata);\-       \return false;})\-    \}\-    \function postForm(id,url,pdata){\-        \var id1= $('#'+id);\+       \var url = $form.attr('action');\
+       \var pdata = 'auto'+id+'=true&' + $form.serialize();\
+       \postForm(id,url,pdata);\
+       \return false;})\
+    \}\
+    \function postForm(id,url,pdata){\
+        \var id1= $('#'+id);\
          \$.ajax({\
             \type: 'POST',\
             \url: url,\
             \data: 'auto'+id+'=true&'+this.name+'='+this.value+'&'+pdata,\
             \success: function (resp) {\
-                \eval(resp);\-                \autoEvalLink(id,0);\+                \eval(resp);\
+                \autoEvalLink(id,0);\
                 \autoEvalForm(id);\
-            \},\+            \},\
             \error: function (xhr, status, error) {\
                 \var msg = $('<div>' + xhr + '</div>');\
                 \id1.html(msg);\
-            \}\+            \}\
         \});\
-       \}"-+       \}"
 
 
+
 setId= "function setId(id,v){document.getElementById(id).innerHTML= v;};\n"
 
 -- | Present a widget via AJAX if it is within a 'witerate' context. In the first iteration it present the
@@ -791,24 +794,22 @@     st <- get
     let env =  mfEnv st
 
-    IteratedId name <- getSessionData `onNothing` return (IteratedId noid)
-    let r =  lookup ("auto"++name) env
-    if r == Nothing || (name == noid && newAsk st== True)-     then do
---       requires [JScriptFile jqueryScript ["$(document).ready(function() {setId('"++id++"','" ++ toString (toByteString render)++"')});\n"]]
-       return $ FormElm((ftag "span" render) `attrs` [("id",id)]) mx
+    IteratedId name scripts <- getSessionData `onNothing` return (IteratedId noid mempty)
+    let r =  lookup ("auto"++name) env 
+    if r == Nothing || (name == noid && newAsk st== True)
+     then return $ FormElm((ftag "span" render) `attrs` [("id",id)]) mx  
      else do
-       requires [JScript $  "setId('"++id++"','" ++ toString (toByteString $ render)++"');\n"]
+       setSessionData $ IteratedId name $ scripts <> "setId('"++id++"','" ++ toString (toByteString $ render)++"');" 
        return $ FormElm mempty mx
 
 noid= "noid"
 
---- | permits the edition of the rendering of a widget at run time. Once saved, the new rendering--- becomes the new rendering of the widget for all the users. You must keep the active elements of the--- template------ the first parameter is the user that has permissions for edition. the second is a key that+
+-- | permits the edition of the rendering of a widget at run time. Once saved, the new rendering
+-- becomes the new rendering of the widget for all the users. You must keep the active elements of the
+-- template
+--
+-- the first parameter is the user that has permissions for edition. the second is a key that
 -- identifies the template.
 edTemplate
   :: (MonadIO m, FormInput v, Typeable a) =>
@@ -821,12 +822,12 @@        install= "installEditField('"++muser++"','"++cookieuser++"','"++name++"','"++ipanel++"');\n"
 
 
-   requires [JScriptFile nicEditUrl [install]
+   requires [JScript     installEditField
+            ,JScriptFile nicEditUrl [install]
             ,JScript     ajaxSendText
-            ,JScript     installEditField
             ,JScriptFile jqueryScript []
             ,ServerProc  ("_texts",  transient getTexts)]
-   us <- getCurrentUser+   us <- getCurrentUser
    when(us== muser) noCache
    FormElm text mx <- runView w
    content <- liftIO $ readtField text k
@@ -835,19 +836,21 @@                      ftag "span" content `attrs` [("id", name)])
                      mx
    where
-   getTexts :: (Token -> IO ())
+   getTexts :: Token -> IO ()  -- low level server process
    getTexts token= do
      let (k,s):_ = tenv token
      liftIO $ do
        writetField k  $ (fromStrNoEncode s `asTypeOf` viewFormat w)
        flushCached k
-       sendFlush token $ HttpData [] [] ""
+       sendFlush token $ HttpData [] [] "" --empty response
+
        return()
 
+
    viewFormat :: View v m a -> v
    viewFormat= undefined -- is a type function
 
--- | Does the same than template but without the edition facility+-- | Does the same than template but without the edition facility
 template
   :: (MonadIO m, FormInput v, Typeable a) =>
       Key -> View v m a -> View v m a
@@ -967,12 +970,12 @@ prependUpdate= update "prepend"
 
 update :: (MonadIO m, FormInput v)
-  => B.ByteString
+  => String
   -> View v m a
   -> View v m a
 update method w= do
     id <- genNewId
-    st <- get+    st <- get
 
     let t = mfkillTime st -1
 
@@ -980,12 +983,12 @@             "$(document).ready(function(){\
                  \ajaxGetLink('"++id++"');\
                  \ajaxPostForm('"++id++"');\
-                 \});"-    st <- get-    let insync =  inSync st+                 \});"
+    st <- get
+    let insync =  inSync st
     let env= mfEnv st
     let r= lookup ("auto"++id) env      
-    if r == Nothing+    if r == Nothing
       then do
          requires [JScript $ timeoutscript t
                   ,JScript ajaxGetLink
@@ -993,34 +996,35 @@                   ,JScriptFile jqueryScript [installscript]] 
          (ftag "div" <<< insertForm w) <! [("id",id)] 
 
-      else View $ do
-         let t= mfToken st            -- !> "JUST"-         modify $ \s -> s{mfHttpHeaders=[]} -- !> "just"
-         resetCachePolicy-         FormElm form mr <- runView $ insertForm w-         setCachePolicy-         st' <- get-         let HttpData ctype c s= toHttpData $ method <> " " <> toByteString  form-                          
-         (liftIO . sendFlush t $ HttpData (ctype ++-                                mfHttpHeaders st') (mfCookies st' ++ c) s)-         put st'{mfAutorefresh=True,newAsk=True}-            
-         return $ FormElm mempty Nothing 
+      else refresh $ fromStr (method <> " ") ++> insertForm w
+--        View $ do
+--         let t= mfToken st            -- !> "JUST"
+--         modify $ \s -> s{mfHttpHeaders=[]} -- !> "just"
+--         resetCachePolicy
+--         FormElm form mr <- runView $ insertForm w
+--         setCachePolicy
+--         st' <- get
+--         let HttpData ctype c s= toHttpData $ method <> " " <> toByteString  form
+--                          
+--         (liftIO . sendFlush t $ HttpData (ctype ++
+--                                mfHttpHeaders st') (mfCookies st' ++ c) s)
+--         put st'{mfAutorefresh=True,newAsk=True}
+--            
+--         return $ FormElm mempty Nothing 
 
   where
   -- | adapted from http://www.codeproject.com/Articles/341151/Simple-AJAX-POST-Form-and-AJAX-Fetch-Link-to-Modal
---           \url: actionurl+'?bustcache='+ new Date().getTime()+'&auto'+id+'=true',\n\-  ajaxGetLink = "\nfunction ajaxGetLink(id){\+--           \url: actionurl+'?bustcache='+ new Date().getTime()+'&auto'+id+'=true',\n\
+  ajaxGetLink = "\nfunction ajaxGetLink(id){\
     \var id1= $('#'+id);\
-    \var ida= $('#'+id+' a[class!=\"_noAutoRefresh\"]');\+    \var ida= $('#'+id+' a[class!=\"_noAutoRefresh\"]');\
     \ida.off('click');\
     \ida.click(function () {\
     \if (hadtimeout == true) return true;\
     \var pdata = $(this).attr('data-value');\
     \var actionurl = $(this).attr('href');\
     \var dialogOpts = {\
-           \type: 'GET',\+           \type: 'GET',\
            \url: actionurl+'?auto'+id+'=true',\
            \data: pdata,\
            \success: function (resp) {\
@@ -1029,9 +1033,9 @@                 \var method= resp.substr(0,ind);\
                 \if(method== 'html')id1.html(dat);\
                 \else if (method == 'append') id1.append(dat);\
-                \else if (method == 'prepend') id1.prepend(dat);\+                \else if (method == 'prepend') id1.prepend(dat);\
                 \else $(':root').html(resp);\
-                \ajaxGetLink(id);\+                \ajaxGetLink(id);\
                 \ajaxPostForm(id);\
            \},\
            \error: function (xhr, status, error) {\
@@ -1043,37 +1047,37 @@     \return false;\
     \});\
   \}\n"
--  ajaxPostForm = "\nfunction ajaxPostForm(id) {\-    \var buttons= $('#'+id+' input[type=\"submit\"]');\-    \var idform= $('#'+id+' form[class!=\"_noAutoRefresh\"]');\-    \buttons.off('click');\-    \buttons.click(function(event) {\-      \if ($(this).attr('class') != '_noAutoRefresh'){\-        \event.preventDefault();\+
+  ajaxPostForm = "\nfunction ajaxPostForm(id) {\
+    \var buttons= $('#'+id+' input[type=\"submit\"]');\
+    \var idform= $('#'+id+' form[class!=\"_noAutoRefresh\"]');\
+    \buttons.off('click');\
+    \buttons.click(function(event) {\
+      \if ($(this).attr('class') != '_noAutoRefresh'){\
+        \event.preventDefault();\
         \if (hadtimeout == true) return true;\
         \var $form = $(this).closest('form');\
-        \var url = $form.attr('action');\-        \pdata = 'auto'+id+'=true&'+this.name+'='+this.value+'&'+$form.serialize();\-        \postForm(id,url,pdata);\-        \return false;\+        \var url = $form.attr('action');\
+        \pdata = 'auto'+id+'=true&'+this.name+'='+this.value+'&'+$form.serialize();\
+        \postForm(id,url,pdata);\
+        \return false;\
         \}else {\
-          \noajax= true;\-          \return true;\-        \}\-     \})\-    \\n\-    \var noajax;\-    \idform.submit(function(event) {\-     \if(noajax) {noajax=false; return true;}\-       \event.preventDefault();\+          \noajax= true;\
+          \return true;\
+        \}\
+     \})\
+    \\n\
+    \var noajax;\
+    \idform.submit(function(event) {\
+     \if(noajax) {noajax=false; return true;}\
+       \event.preventDefault();\
        \var $form = $(this);\
-       \var url = $form.attr('action');\-       \var pdata = 'auto'+id+'=true&' + $form.serialize();\-       \postForm(id,url,pdata);\-       \return false;})\-    \}\-    \function postForm(id,url,pdata){\+       \var url = $form.attr('action');\
+       \var pdata = 'auto'+id+'=true&' + $form.serialize();\
+       \postForm(id,url,pdata);\
+       \return false;})\
+    \}\
+    \function postForm(id,url,pdata){\
         \var id1= $('#'+id);\
         \$.ajax({\
             \type: 'POST',\
@@ -1085,8 +1089,8 @@                 \var method= resp.substr(0,ind);\
                 \if(method== 'html')id1.html(dat);\
                 \else if (method == 'append') id1.append(dat);\
-                \else if (method == 'prepend') id1.prepend(dat);\-                \else $(':root').html(resp);\+                \else if (method == 'prepend') id1.prepend(dat);\
+                \else $(':root').html(resp);\
                 \ajaxGetLink(id);\
                 \ajaxPostForm(id);\
             \},\
@@ -1097,9 +1101,9 @@         \});\
        \};"
 
- 
 
+
 timeoutscript t=
      "\nvar hadtimeout=false;\
      \if("++show t++" > 0)setTimeout(function() {hadtimeout=true; }, "++show (t*1000)++");\n"
@@ -1214,7 +1218,7 @@            \url: actionurl,\
            \data: '',\
            \success: function (resp) {\
-             \idstatus.html('')\
+             \idstatus.html('');\
              \cnt=0;\
              \id1."++method++"(resp);\
              \ajaxPush1();\
@@ -1256,107 +1260,101 @@       ,JScriptFile  jqueryUI [setit]]
 
     getTextBox mv <! [("id",id)]
- 
---- | takes as argument a widget and delay the load until it is visible. The renderring to--- be shown during the load is the specified in the first parameter. The resulting lazy--- widget behaves programatically in the same way.------ It can lazily load recursively. It means that if the loaded widget has a lazy statement,--- it will be honored as well.------ Because a widget can contain arbitrary HTML, images or javascript, lazy can be used to lazy--- load anything.------ To load a image:------ lazy temprendering $ wraw ( img ! href imageurl)------ or------ lazy temprendering $ img ! href imageurl ++> noWidget-lazy :: (FormInput v,Functor m,MonadIO m) => v -> View v m a -> View v m a+
+
+-- | takes as argument a widget and delay the load until it is visible. The renderring to
+-- be shown during the load is the specified in the first parameter. The resulting lazy
+-- widget behaves programatically in the same way.
+--
+-- It can lazily load recursively. It means that if the loaded widget has a lazy statement,
+-- it will be honored as well.
+--
+-- Because a widget can contain arbitrary HTML, images or javascript, lazy can be used to lazy
+-- load anything.
+--
+-- To load a image:
+--
+-- lazy temprendering $ wraw ( img ! href imageurl)
+--
+-- or
+--
+-- lazy temprendering $ img ! href imageurl ++> noWidget
+lazy :: (FormInput v,Functor m,MonadIO m) => v -> View v m a -> View v m a
 lazy v w=  do
     id <- genNewId
-    st <- get-    let path = currentPath st+    st <- get
+    let path = currentPath st
         env = mfEnv st
         r= lookup ("auto"++id) env   
         t = mfkillTime st -1
-        installscript =  "$(document).ready(function(){\-                \function lazyexec(){lazy('"++id++"','"++ path ++"',lazyexec)};\-                \$(window).one('scroll',lazyexec);\-                \$(window).trigger('scroll');\-                 \});"----        installscript2= "$(window).one('scroll',function(){\---                \function lazyexec(){lazy('"++id++"','"++ path ++"',lazyexec)};\---                \lazyexec()});"-+        installscript =  "$(document).ready(function(){\
+                \function lazyexec(){lazy('"++id++"','"++ path ++"',lazyexec)};\
+                \$(window).one('scroll',lazyexec);\
+                \$(window).trigger('scroll');\
+                 \});"
 
     if r == Nothing  then View $ do
       requires [JScript lazyScript
-                  ,JScriptFile jqueryScript [installscript,scrollposition]]-      FormElm rendering mx <- runView w-      return $ FormElm (ftag "div" v `attrs` [("id",id)]) mx+                  ,JScriptFile jqueryScript [installscript,scrollposition]]
+      reqs <- gets mfRequirements
+      FormElm _ mx <- runView w
+      modify $ \st-> st{mfRequirements= reqs}  --ignore requirements
+      return $ FormElm (ftag "div" v `attrs` [("id",id)]) mx
          
-      else View $ do
-         resetCachePolicy-         st' <- get-         FormElm form mx <- runView w-         setCachePolicy 
-         let t= mfToken st'-         reqs <- installAllRequirements-         let HttpData ctype c s= toHttpData $ toByteString  form
-         liftIO . sendFlush t $ HttpData (ctype ++-                                mfHttpHeaders st') (mfCookies st' ++ c)-                              $ toByteString reqs <> s  -- !> (unpack $ toByteString reqs)-         put st'{mfAutorefresh=True,inSync= True}+     else refresh w
 
-         return $ FormElm mempty mx---    where----    scrollposition= "$.fn.scrollposition= function(){\-       \var pos= $(this).position();\-       \if (typeof(pos)==='undefined') {return 1;}\-       \else{\-         \return pos.top - $( window ).scrollTop() - $( window ).height();\-         \}};"--    lazyScript= "function lazy (id,actionurl,f) {\-     \var now = new Date().getTime(),\-         \id1= $('#'+id),\-         \lastCall= 0;\-     \diff = now - lastCall;\-     \if (diff < 5000) {\-        \$(window).one('scroll',f);}\-     \else {\-      \lastCall = now;\-    \if(id1.scrollposition() > 0){\-    \$(window).one('scroll',f);}\+    where
+
+    scrollposition= "$.fn.scrollposition= function(){\
+       \var pos= $(this).position();\
+       \if (typeof(pos)==='undefined') {return 1;}\
+       \else{\
+         \return pos.top - $( window ).scrollTop() - $( window ).height();\
+         \}};"
+
+    lazyScript= "function lazy (id,actionurl,f) {\
+     \var now = new Date().getTime(),\
+         \id1= $('#'+id),\
+         \lastCall= 0;\
+     \diff = now - lastCall;\
+     \if (diff < 5000) {\
+        \$(window).one('scroll',f);}\
+     \else {\
+      \lastCall = now;\
+    \if(id1.scrollposition() > 0){\
+    \$(window).one('scroll',f);}\
     \else{\
     \var dialogOpts = {\
-           \type: 'GET',\+           \type: 'GET',\
            \url: actionurl+'?auto'+id+'=true',\
            \success: function (resp) {\
-                \id1.html(resp);\+                \id1.html(resp);\
                 \$(window).trigger('scroll');\
-           \},\+           \},\
            \error: function (xhr, status, error) {\
                \var msg = $('<div>' + xhr + '</div>');\
-               \id1.html(msg);\+               \id1.html(msg);\
            \}\
        \};\
     \$.ajax(dialogOpts);\
-    \}}};"---waitAndExecute= "function waitAndExecute(sym,f) {\-        \if (eval(sym)) {f();}\-          \else {setTimeout(function() {waitAndExecute(sym,f)}, 50);}\-        \}\n"+    \}}};"
+
+refresh w=  View $ do
+         resetCachePolicy
+         modify $ \st -> st{mfAutorefresh=True,inSync= True}
+         FormElm form mx <- runView w   -- !> show (mfInstalledScripts st')
+         setCachePolicy
+         st' <- get
+         let t= mfToken st'
+         reqs <- installAllRequirements
+         let HttpData ctype c s= toHttpData $ toByteString  form
+         liftIO . sendFlush t $ HttpData (ctype ++
+                                mfHttpHeaders st') (mfCookies st' ++ c)
+                              $ s <> toByteString reqs
+         return $ FormElm mempty mx
+
+--waitAndExecute= "function waitAndExecute(sym,f) {\
+--        \if (eval(sym)) {f();}\
+--          \else {setTimeout(function() {waitAndExecute(sym,f)}, 50);}\
+--        \}\n"
src/MFlow/Hack.hs view
@@ -1,23 +1,23 @@-{-# LANGUAGE  UndecidableInstances-             , TypeSynonymInstances-             , MultiParamTypeClasses-             , DeriveDataTypeable-             , FlexibleInstances #-}--{- | Instantiation of the "MFlow" server for the Hack interface--see <http://hackage.haskell.org/package/hack>--}+{-# LANGUAGE  UndecidableInstances
+             , TypeSynonymInstances
+             , MultiParamTypeClasses
+             , DeriveDataTypeable
+             , FlexibleInstances #-}
 
-module MFlow.Hack(-     module MFlow.Cookies-    ,module MFlow-    ,hackMessageFlow)-where+{- | Instantiation of the "MFlow" server for the Hack interface
 
+see <http://hackage.haskell.org/package/hack>
+-}
+
+module MFlow.Hack(
+     module MFlow.Cookies
+    ,module MFlow
+    ,hackMessageFlow)
+where
+
 import Data.Typeable
 import Hack
-+
 import Control.Concurrent.MVar(modifyMVar_, readMVar)
 import Control.Monad(when)
 
@@ -25,41 +25,41 @@ import Data.ByteString.Lazy.Char8 as B(pack, unpack, length, ByteString)
 import Control.Concurrent(ThreadId(..))
 import System.IO.Unsafe
-import Control.Concurrent.MVar+import Control.Concurrent.MVar
 import Control.Concurrent
 import Control.Exception
-import qualified Data.Map as M+import qualified Data.Map as M
 import Data.Maybe 
-import Data.TCache+import Data.TCache
 import Data.TCache.DefaultPersistence
 import Control.Workflow hiding (Indexable(..))
 
 import MFlow
-import MFlow.Cookies--import MFlow.Hack.Response-import Data.Monoid-import Data.CaseInsensitive-import System.Time--import System.Time---flow=  "flow"+import MFlow.Cookies
 
+import MFlow.Hack.Response
+import Data.Monoid
+import Data.CaseInsensitive
+import System.Time
+
+import System.Time
+
+
+flow=  "flow"
+
 instance Processable Env  where
    pwfname  env=  if null sc then noScript else sc
       where
-      sc=  tail $ pathInfo env+      sc=  tail $ pathInfo env
    puser env = fromMaybe anonymous $ lookup  cookieuser $ http env
                     
-   pind env= fromMaybe (error ": No FlowID") $ lookup flow $ http env-   getParams=  http---   getServer env= serverName env---   getPath env= pathInfo env---   getPort env= serverPort env--+   pind env= fromMaybe (error ": No FlowID") $ lookup flow $ http env
+   getParams=  http
+--   getServer env= serverName env
+--   getPath env= pathInfo env
+--   getPort env= serverPort env
+
+
                     
 ---------------------------------------------
 
@@ -68,18 +68,18 @@ --
 --instance ConvertTo String TResp  where
 --      convert = TResp . pack
---+--
 --instance ConvertTo ByteString TResp  where
---      convert = TResp---+--      convert = TResp
 --
+--
 --instance ConvertTo Error TResp where
---     convert (Error e)= TResp . pack  $ errorResponse e------instance ToResponse v =>ConvertTo (HttpData v) TResp where+--     convert (Error e)= TResp . pack  $ errorResponse e
+--
+--instance ToResponse v =>ConvertTo (HttpData v) TResp where
 --    convert= TRespR
- 
+
 --webScheduler   :: Env
 --               -> ProcList
 --               -> IO (TResp, ThreadId)
@@ -90,35 +90,35 @@ wFMiddleware :: (Env -> Bool) -> (Env-> IO Response) ->   (Env -> IO Response) 
 wFMiddleware filter f = \ env ->  if filter env then hackMessageFlow env    else f env -- !> "new message"
 
--- | An instance of the abstract "MFlow" scheduler to the Hack interface+-- | An instance of the abstract "MFlow" scheduler to the Hack interface
 -- it accept the list of processes being scheduled and return a hack handler
------ Example:------ @main= do------   putStrLn $ options messageFlows---   'run' 80 $ 'hackMessageFlow'  messageFlows---   where---   messageFlows=  [(\"main\",  'runFlow' flowname )---                  ,(\"hello\", 'stateless' statelesproc)---                  ,(\"trans\", 'transient' $ runflow transientflow]---   options msgs= \"in the browser choose\\n\\n\" ++---     concat [ "http:\/\/server\/"++ i ++ "\n" | (i,_) \<- msgs]--- @---hackMessageFlow :: [(String, (Token -> Workflow IO ()))]+--
+-- Example:
+--
+-- @main= do
+--
+--   putStrLn $ options messageFlows
+--   'run' 80 $ 'hackMessageFlow'  messageFlows
+--   where
+--   messageFlows=  [(\"main\",  'runFlow' flowname )
+--                  ,(\"hello\", 'stateless' statelesproc)
+--                  ,(\"trans\", 'transient' $ runflow transientflow]
+--   options msgs= \"in the browser choose\\n\\n\" ++
+--     concat [ "http:\/\/server\/"++ i ++ "\n" | (i,_) \<- msgs]
+-- @
+--hackMessageFlow :: [(String, (Token -> Workflow IO ()))]
 --                -> (Env -> IO Response)
 --hackMessageFlow  messageFlows = 
 -- unsafePerformIO (addMessageFlows messageFlows) `seq`
 -- hackWorkflow -- wFMiddleware f   other
--- where--- f env = unsafePerformIO $ do---    paths <- getMessageFlows >>=---    return (pwfname env `elem` paths)-+-- where
+-- f env = unsafePerformIO $ do
+--    paths <- getMessageFlows >>=
+--    return (pwfname env `elem` paths)
+
 -- other= (\env -> defaultResponse $  "options: " ++ opts)
--- (paths,_)= unzip messageFlows--- opts= concatMap  (\s -> "<a href=\""++ s ++"\">"++s ++"</a>, ") paths+-- (paths,_)= unzip messageFlows
+-- opts= concatMap  (\s -> "<a href=\""++ s ++"\">"++s ++"</a>, ") paths
 
 
 splitPath ""= ("","","")
@@ -128,9 +128,9 @@             (ext, rest)= span (/= '.') strr
             (mod, path)= span(/='/') $ tail rest
        in   (tail $ reverse path, reverse mod, reverse ext)
-- 
+
+
 hackMessageFlow  ::  Env ->  IO Response
 hackMessageFlow req1=   do
      let httpreq1= http  req1  
@@ -140,7 +140,7 @@               Just fl -> return  (fl, [])
               Nothing  -> do
                      fl <- newFlow
-                     return ( fl,  [( flow,  fl,  "/",(Just $ show $ 365*24*60*60))])+                     return ( fl,  [( flow,  fl,  "/",(Just $ show $ 365*24*60*60))])
                      
 {-  for state persistence in cookies 
      putStateCookie req1 cookies
@@ -160,16 +160,16 @@           _  -> req1{http=(flow, flowval): ( input ++ cookies ) ++ http req1}   -- !> "REQ"
 
 
-     (resp',th) <- msgScheduler  req+     (resp',th) <- msgScheduler  req
 
-+
      let resp''= toResponse resp'
-     let headers1= case retcookies of [] -> headers resp''; _ ->   (cookieHeaders retcookies)+     let headers1= case retcookies of [] -> headers resp''; _ ->   (cookieHeaders retcookies)
      let resp =   resp''{status=200, headers= headers1 {-,("Content-Length",show $ B.length x) -}}
 
-     return resp-+     return resp
 
+
 ------persistent state in cookies (not tested)
 
 tvresources ::  MVar (Maybe ( M.Map string string))
@@ -214,5 +214,5 @@                               case mmap of
                                   Just map -> return $ Just $ M.delete  (keyResource stat) map
                                   Nothing ->  return $ Nothing
---}+
+-}
src/MFlow/Hack/Response.hs view
@@ -1,42 +1,42 @@-{-# OPTIONS -XExistentialQuantification  -XTypeSynonymInstances+{-# OPTIONS -XExistentialQuantification  -XTypeSynonymInstances
             -XFlexibleInstances -XDeriveDataTypeable -XOverloadedStrings #-}
 module MFlow.Hack.Response where
 
-import Hack+import Hack
 import MFlow.Cookies
-import Data.ByteString.Lazy.Char8 as B-+import Data.ByteString.Lazy.Char8 as B
+
 import MFlow
 import Data.Typeable
-import Data.Monoid-import System.IO.Unsafe-import Data.Map as M-import Control.Workflow (WFErrors(..))----import Debug.Trace------(!>)= flip trace--+import Data.Monoid
+import System.IO.Unsafe
+import Data.Map as M
+import Control.Workflow (WFErrors(..))
 
+--import Debug.Trace
+--
+--(!>)= flip trace
+
+
+
 class ToResponse a where
       toResponse :: a -> Response
----data TResp = TRempty | forall a.ToResponse a=>TRespR a |  forall a.(Typeable a, ToResponse a, Monoid a) => TResp a deriving Typeable--instance Monoid TResp where-      mempty = TRempty-      mappend (TResp x) (TResp y)=-         case cast y of-              Just y' -> TResp $ mappend x y'+
+
+
+data TResp = TRempty | forall a.ToResponse a=>TRespR a |  forall a.(Typeable a, ToResponse a, Monoid a) => TResp a deriving Typeable
+
+instance Monoid TResp where
+      mempty = TRempty
+      mappend (TResp x) (TResp y)=
+         case cast y of
+              Just y' -> TResp $ mappend x y'
               Nothing -> error $ "fragment of type " ++ show ( typeOf  y)  ++ " after fragment of type " ++ show ( typeOf x)
 
--instance ToResponse TResp where+
+instance ToResponse TResp where
   toResponse (TResp x)= toResponse x 
-  toResponse (TRespR r)= toResponse r+  toResponse (TRespR r)= toResponse r
   
 instance ToResponse Response where
       toResponse = id
@@ -45,10 +45,10 @@       toResponse x= Response{status=200, headers=[contentHtml {-,("Content-Length",show $ B.length x) -}], body= x}
 
 instance ToResponse String  where
-      toResponse x= Response{status=200, headers=[contentHtml{-,("Content-Length",show $ B.length x) -}], body= B.pack x}--instance  ToResponse HttpData  where-  toResponse (HttpData hs cookies x)=   (toResponse x) {headers=  hs++ cookieHeaders cookies}+      toResponse x= Response{status=200, headers=[contentHtml{-,("Content-Length",show $ B.length x) -}], body= B.pack x}
+
+instance  ToResponse HttpData  where
+  toResponse (HttpData hs cookies x)=   (toResponse x) {headers=  hs++ cookieHeaders cookies}
   toResponse (Error NotFound str)= Response{status=404, headers=[], body=   getNotFoundResponse str}
 
 instance Typeable Env where
src/MFlow/Hack/XHtml.hs view
@@ -1,40 +1,40 @@------------------------------------------------------------------------------------ Module      :  MFlow.Hack.XHtml--- Copyright   :--- License     :  BSD3------ Maintainer  :  agocorona@gmail.com--- Stability   :  experimental--- Portability :------ |-----------------------------------------------------------------------------------{--Instantiations necessary for "MFlow.Hack" to use "Text.XHtml" as format for generating output--}--{-# OPTIONS -XMultiParamTypeClasses #-}--module MFlow.Hack.XHtml (--) where-import MFlow-import Hack-import MFlow.Hack.Response-import Text.XHtml-import Data.Typeable-import Data.ByteString.Lazy.Char8 as B(pack,unpack, length, ByteString)+-----------------------------------------------------------------------------
+--
+-- Module      :  MFlow.Hack.XHtml
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
 
+{-
+Instantiations necessary for "MFlow.Hack" to use "Text.XHtml" as format for generating output
+-}
+
+{-# OPTIONS -XMultiParamTypeClasses #-}
+
+module MFlow.Hack.XHtml (
+
+) where
+import MFlow
+import Hack
+import MFlow.Hack.Response
+import Text.XHtml
+import Data.Typeable
+import Data.ByteString.Lazy.Char8 as B(pack,unpack, length, ByteString)
+
 instance ToResponse Html where
-  toResponse x= Response{ status=200, headers=[]+  toResponse x= Response{ status=200, headers=[]
                         , Hack.body= pack $ showHtml x}
---+--
 --instance Typeable Html where
 --     typeOf =  \_ -> mkTyConApp (mkTyCon "Text.XHtml.Strict.Html") []
---+--
 --instance ConvertTo Html TResp where
---     convert = TResp-+--     convert = TResp
+
src/MFlow/Hack/XHtml/All.hs view
@@ -1,49 +1,49 @@------------------------------------------------------------------------------------ Module      :  MFlow.Hack.XHtml.All--- Copyright   :--- License     :  BSD3------ Maintainer  :  agocorona@gmail.com--- Stability   :  experimental--- Portability :------ |-----------------------------------------------------------------------------------module MFlow.Hack.XHtml.All (- module Data.TCache-,module MFlow.Hack-,module MFlow.FileServer-,module MFlow.Forms-,module MFlow.Forms.XHtml-,module MFlow.Forms.Admin-,module MFlow.Hack.XHtml-,module MFlow.Forms.Widgets-,module Hack-,module Hack.Handler.SimpleServer-,module Text.XHtml.Strict-,module Control.Applicative-) where---import MFlow.Hack-import MFlow.FileServer-import MFlow.Forms-import MFlow.Forms.XHtml-import MFlow.Forms.Admin-import MFlow.Forms.Widgets-import MFlow.Hack.XHtml--import Hack(Env)-import Hack.Handler.SimpleServer-import Data.TCache---import Text.XHtml.Strict hiding (widget)--import Control.Applicative---+-----------------------------------------------------------------------------
+--
+-- Module      :  MFlow.Hack.XHtml.All
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module MFlow.Hack.XHtml.All (
+ module Data.TCache
+,module MFlow.Hack
+,module MFlow.FileServer
+,module MFlow.Forms
+,module MFlow.Forms.XHtml
+,module MFlow.Forms.Admin
+,module MFlow.Hack.XHtml
+,module MFlow.Forms.Widgets
+,module Hack
+,module Hack.Handler.SimpleServer
+,module Text.XHtml.Strict
+,module Control.Applicative
+) where
+
+
+import MFlow.Hack
+import MFlow.FileServer
+import MFlow.Forms
+import MFlow.Forms.XHtml
+import MFlow.Forms.Admin
+import MFlow.Forms.Widgets
+import MFlow.Hack.XHtml
+
+import Hack(Env)
+import Hack.Handler.SimpleServer
+import Data.TCache
+
+
+import Text.XHtml.Strict hiding (widget)
+
+import Control.Applicative
+
+
+
src/MFlow/Wai.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE  UndecidableInstances
+{-# LANGUAGE   UndecidableInstances
              , CPP
              , TypeSynonymInstances
              , MultiParamTypeClasses
              , DeriveDataTypeable
              , FlexibleInstances
-             , OverloadedStrings #-}
+             , OverloadedStrings+             , TemplateHaskell #-}
 
 module MFlow.Wai(
      module MFlow.Cookies
@@ -21,8 +22,8 @@ 
 import qualified Data.ByteString.Lazy.Char8 as B(empty,pack, unpack, length, ByteString,tail)
 import Data.ByteString.Lazy(fromChunks)
-import Data.ByteString.UTF8  hiding (span)-import qualified Data.ByteString as SB hiding (pack, unpack)
+import Data.ByteString.UTF8  hiding (span)
+import qualified Data.ByteString.Char8 as SB -- hiding (pack, unpack)
 import Control.Concurrent(ThreadId(..))
 import System.IO.Unsafe
 import Control.Concurrent.MVar
@@ -40,17 +41,30 @@ import Data.Monoid
 import MFlow.Wai.Response
 import Network.Wai
-import Network.HTTP.Types -- hiding (urlDecode)
+import Network.Wai.Parse
+import qualified  Data.Conduit.Binary as CB
+import Control.Monad.Trans.Resource
+import Network.HTTP.Types 
 import Data.Conduit
 import Data.Conduit.Lazy
 import qualified Data.Conduit.List as CList
 import Data.CaseInsensitive
 import System.Time
+import System.Directory
+import System.IO
 import qualified Data.Text as T
 
 
 --import Debug.Trace
 --(!>) = flip trace
+++toApp :: (Request -> IO Response) -> Application
+#if MIN_VERSION_wai(3, 0, 0)
+toApp f req sendResponse = f req >>= sendResponse
+#else
+toApp = id
+#endif 
 flow=  "flow"
 
@@ -72,22 +86,10 @@      mkParams1 = Prelude.map mkParam1
      mkParam1 ( x,y)= (toString $ original  x, toString y)
 
---   getServer env= serverName env
---   getPath env= pathInfo env
---   getPort env= serverPort env
 
 
-splitPath ""= ("","","")
-splitPath str=
-       let
-            strr= reverse str
-            (ext, rest)= span (/= '.') strr
-            (mod, path)= span(/='/') $ tail rest
-       in   (tail $ reverse path, reverse mod, reverse ext)
-
-
 waiMessageFlow  ::  Application
-waiMessageFlow req1=   do
+waiMessageFlow = toApp $ \req1 -> do
      let httpreq1= requestHeaders  req1
 
      let cookies = getCookies  httpreq1
@@ -105,22 +107,49 @@                                 Just ck -> ck:retcookies1
 -}
 
-     input <- case parseMethod $ requestMethod req1  of
-              Right POST -> do
-
-                   inp <- liftIO $ requestBody req1 $$ CList.consume
-
-                   return . parseSimpleQuery $ SB.concat inp
+     (params,files) <- case parseMethod $ requestMethod req1  of
+              Right GET -> do
+                   return (Prelude.map (\(x,y) -> (x,fromMaybe "" y)) $ queryString req1,[])
 
+              Right POST -> do
 
+                 case getRequestBodyType req1  of
+                     Nothing -> error $ "getRequestBodyType: "
+                     Just rbt ->
+                         runResourceT $ withInternalState $ \state -> liftIO $ do
+                               let backend file info= do
+                                    (key, (fp, h)) <- flip runInternalState state $ allocate (do
+                                        tempDir <- getTemporaryDirectory
+                                        openBinaryTempFile tempDir "upload.tmp") (\(_, h) -> hClose h)
+                                    CB.sinkHandle h
+                                    lift $ release key
+                                    return fp
+#if MIN_VERSION_wai(3, 0, 0)
+                               let backend' file info getBS = do
+                                        let src = do
+                                                bs <- liftIO getBS
+                                                when (not $ SB.null bs) $ do
+                                                    Data.Conduit.yield bs
+                                                    src
+                                        src $$ backend file info
+                               sinkRequestBody backend' rbt (requestBody req1)
+#else
+                               requestBody req1 $$ sinkRequestBody backend rbt
+#endif
 
-              Right GET ->
-                   return . Prelude.map (\(x,y) -> (x,fromMaybe "" y)) $ queryString req1
+--                         let fileparams= Prelude.map (\(param,FileInfo filename contentype content)
+--                                              -> (param,   SB.pack content )) files
+--                         let fileparams= Prelude.map (\(param,fileinfo)
+--                                              -> (param,  fileinfo )) files
+--                         return $ fileparams++ params
+     let filesp= Prelude.map (\(param,FileInfo filename contentype tempfile)
+                                              -> (mk param,  fromString $ show(filename,contentype,tempfile) )) files
+--     let filesp= Prelude.map (\(a,b) -> ( mk a, fromString $ show b)) files
 
 
      let req = case retcookies of
-          [] -> req1{requestHeaders= mkParams (input  ++ cookies) ++ requestHeaders req1}  -- !> "REQ"
-          _  -> req1{requestHeaders= mkParams ((flow, flowval): input ++ cookies) ++ requestHeaders req1}  --  !> "REQ"
+          [] -> req1{requestHeaders= filesp ++ mkParams (params  ++ cookies) ++ requestHeaders req1}  
+          _  -> req1{requestHeaders= filesp ++ mkParams ((flow, flowval): params ++ cookies) ++ requestHeaders req1}
 
 
      (resp',th) <- liftIO $ msgScheduler req      -- !> (show $ requestHeaders req)
src/MFlow/Wai/Blaze/Html/All.hs view
@@ -27,6 +27,7 @@ ,module MFlow.Forms.Cache
 ,runNavigation
 ,runSecureNavigation
+,runSecureNavigation'
 ) where
 
 import MFlow
@@ -40,7 +41,7 @@ import Text.Blaze.Html5 hiding (map)
 import Text.Blaze.Html5.Attributes  hiding (label,span,style,cite,title,summary,step,form)
 import Network.Wai
-import Network.Wai.Handler.Warp  hiding (getPort) --(run,defaultSettings,Settings ,setPort)
+import Network.Wai.Handler.Warp   --(run,defaultSettings,Settings ,setPort)
 import Data.TCache
 import Text.Blaze.Internal(text)
 
@@ -55,10 +56,8 @@ import Data.Char(isNumber)
 import Network.Wai.Handler.WarpTLS as TLS
 
--- | The port is read from the first exectution parameter.
--- If no parameter, it is read from the PORT environment variable.
--- if this does not exist, the port 80 is used.
-getPort= do
+
+getPortW= do
     args <- getArgs
     port <- case args of
            port:xs -> return port
@@ -71,14 +70,17 @@     print porti
     return porti
 
--- | run a persistent flow. It uses `getPort` to get the port
+-- | run a persistent flow. It uses `getPortW` to get the port
 -- The first parameter is the first element in the URL path.
 -- It also set the home page
+-- The port is read from the first parameter passed to the executable.
+-- If no parameter, it is read from the PORT environment variable.
+-- if this does not exist, the port 80 is used.
 runNavigation :: String -> FlowM Html (Workflow IO) () -> IO () 
 runNavigation n f= do
     unless (null n) $ setNoScript n
     addMessageFlows[(n, runFlow f)]
-    porti <- getPort
+    porti <- getPortW
     wait $ run porti waiMessageFlow
     --runSettings defaultSettings{settingsTimeout = 20, settingsPort= porti} waiMessageFlow
 
@@ -91,7 +93,7 @@ runSecureNavigation' t s n f = do
     unless (null n) $ setNoScript n
     addMessageFlows[(n, runFlow f)]
-    porti <- getPort
+    porti <- getPortW
 --    let s' = setPort porti s
---    wait $ TLS.runTLS t s' waiMessageFlow+--    wait $ TLS.runTLS t s' waiMessageFlow
     wait $ TLS.runTLS t s{settingsPort = porti} waiMessageFlow
src/MFlow/Wai/XHtml/All.hs view
@@ -1,49 +1,49 @@------------------------------------------------------------------------------------ Module      :  MFlow.Wai.XHtml.All--- Copyright   :--- License     :  BSD3------ Maintainer  :  agocorona@gmail.com--- Stability   :  experimental--- Portability :------ |-----------------------------------------------------------------------------------module MFlow.Wai.XHtml.All (- module Data.TCache-,module MFlow-,module MFlow.Wai-,module MFlow.Forms-,module MFlow.Forms.XHtml-,module MFlow.Forms.Admin-,module MFlow.Forms.Widgets---,module MFlow.Wai.XHtml-,module Network.Wai-,module Network.Wai.Handler.Warp-,module Text.XHtml.Strict-,module Control.Applicative-) where--import MFlow-import MFlow.Wai-import MFlow.Forms-import MFlow.Forms.XHtml-import MFlow.Forms.Admin-import MFlow.Forms.Widgets---import MFlow.Wai.XHtml--import Network.Wai-import Network.Wai.Handler.Warp-import Data.TCache--import Text.XHtml.Strict hiding (widget)--import Control.Applicative-----+-----------------------------------------------------------------------------
+--
+-- Module      :  MFlow.Wai.XHtml.All
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module MFlow.Wai.XHtml.All (
+ module Data.TCache
+,module MFlow
+,module MFlow.Wai
+,module MFlow.Forms
+,module MFlow.Forms.XHtml
+,module MFlow.Forms.Admin
+,module MFlow.Forms.Widgets
+--,module MFlow.Wai.XHtml
+,module Network.Wai
+,module Network.Wai.Handler.Warp
+,module Text.XHtml.Strict
+,module Control.Applicative
+) where
+
+import MFlow
+import MFlow.Wai
+import MFlow.Forms
+import MFlow.Forms.XHtml
+import MFlow.Forms.Admin
+import MFlow.Forms.Widgets
+--import MFlow.Wai.XHtml
+
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Data.TCache
+
+import Text.XHtml.Strict hiding (widget)
+
+import Control.Applicative
+
+
+
+
+