MFlow 0.3.1.1 → 0.3.2.0

raw patch · 36 files changed

+1766/−1374 lines, 36 files

Files

• Demos/Actions.hs +6/−5
• Demos/AjaxSample.hs +7/−5
• Demos/AutoCompList.hs +6/−5
• Demos/AutoComplete.hs +6/−5
• Demos/CheckBoxes.hs +5/−4
• Demos/Combination.hs +22/−20
• Demos/ContentManagement.hs +29/−21
• Demos/Counter.hs +14/−10
• Demos/Dialog.hs +5/−4
• Demos/Grid.hs +4/−3
• Demos/IncreaseInt.hs +6/−4
• Demos/IncreaseString.hs +3/−2
• Demos/ListEdit.hs +13/−12
• Demos/LoginSample.hs +13/−9
• Demos/MCounter.hs +29/−0
• Demos/Multicounter.hs +4/−3
• Demos/Options.hs +4/−3
• Demos/PreventGoingBack.hs +7/−6
• Demos/PushDecrease.hs +7/−4
• Demos/PushSample.hs +5/−4
• Demos/Radio.hs +4/−3
• Demos/ShopCart.hs +41/−29
• Demos/SumView.hs +3/−2
• Demos/TestREST.hs +25/−25
• Demos/TraceSample.hs +9/−8
• Demos/demos-blaze.hs +87/−234
• MFlow.cabal +111/−135
• src/MFlow.hs +97/−46
• src/MFlow/Cookies.hs +22/−20
• src/MFlow/Forms.hs +144/−144
• src/MFlow/Forms/Internals.hs +374/−310
• src/MFlow/Forms/Widgets.hs +530/−144
• src/MFlow/Forms/XHtml.hs +66/−66
• src/MFlow/Wai.hs +25/−17
• src/MFlow/Wai/Blaze/Html/All.hs +27/−56
• src/MFlow/Wai/Response.hs +6/−6

@@ -2,15 +2,16 @@ module Actions (actions) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu 
-actions n= do
-  r<- ask $   p << b <<  "Two  boxes with one action each one"
+actions = do
+  r<- askm  $   p << b <<  "Two  boxes with one action each one"
           ++> getString (Just "widget1") `waction` action
           <+> getString (Just "widget2") `waction` action
           <** submitButton "submit"
-  ask $ p << ( show r ++ " returned")  ++> wlink ()  << p <<  " menu"
+  askm  $ p << ( show r ++ " returned")  ++> wlink ()  << p <<  " menu"
   where
-  action n=  ask $ getString (Just $ n ++ " action")<** submitButton "submit action"
+  action n=  askm  $ getString (Just $ n ++ " action")<** submitButton "submit action"
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav actions

@@ -1,18 +1,20 @@ 
 
 module AjaxSample ( ajaxsample) where
-import MFlow.Wai.Blaze.Html.All
+import MFlow.Wai.Blaze.Html.All+import Menu
 import Data.Monoid
-import Data.ByteString.Lazy.Char8 as B
+import Data.ByteString.Lazy.Char8 as B+
 ajaxsample= do
-   r <- ask $   p << b <<  "Ajax example that increment the value in a box"
+   r <- askm  $   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"
-   ask $ p << ( show r ++ " returned")  ++> wlink ()  << p <<  " menu"
+   askm  $ p << ( show r ++ " returned")  ++> wlink ()  << p <<  " menu"
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav ajaxsample

@@ -1,18 +1,19 @@ 
 module AutoCompList ( autocompList) where
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Data.List
 
 autocompList= do
-   r <- ask $   p <<  "Autocomplete with a list of selected entries"
+   r <- askm  $   p <<  "Autocomplete with a list of selected entries"
             ++> p <<  "enter  and press enter"
-            ++> p <<  "when su press submit, the entries are returned"
+            ++> p <<  "when submit is pressed, the entries are returned"
             ++> wautocompleteList "red,green,blue" filter1 ["red"]
             <** submitButton "submit"
-   ask $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
+   askm  $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
 
    where
-   filter1 s = return $ filter (isPrefixOf s) ["red","reed rose","green","green grass","blue","blues"]
+   filter1 s = return $ filter (isPrefixOf s) ["red","red rose","green","green grass","blue","blues"]
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav autocompList

@@ -1,19 +1,20 @@ 
 module AutoComplete ( autocomplete1) where
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Data.List
 
 autocomplete1= do
-   r <- ask $   p <<  "Autocomplete "
-            ++> p <<  "when su press submit, the box value  is returned"
+   r <- askm  $   p <<  "Autocomplete "
+            ++> p <<  "when submit is pressed, the box value  is returned"
             ++> wautocomplete Nothing filter1 <! hint "red,green or blue"
             <** submitButton "submit"
-   ask $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
+   askm  $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
 
    where
-   filter1 s = return $ filter (isPrefixOf s) ["red","reed rose","green","green grass","blue","blues"]
+   filter1 s = return $ filter (isPrefixOf s) ["red","red rose","green","green grass","blue","blues"]
 
 hint s= [("placeholder",s)]
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav autocomplete1

@@ -1,17 +1,18 @@ 
 module CheckBoxes ( checkBoxes) where
-import MFlow.Wai.Blaze.Html.All
+import MFlow.Wai.Blaze.Html.All+import Menu
 import Data.Monoid
 
 checkBoxes= do
-   r <- ask $ getCheckBoxes(  (setCheckBox False "Red"   <++ b <<  "red")
+   r <- askm  $ getCheckBoxes(  (setCheckBox False "Red"   <++ b <<  "red")
                            <> (setCheckBox False "Green" <++ b <<  "green")
                            <> (setCheckBox False "blue"  <++ b <<  "blue"))
               <** submitButton "submit"
 
 
-   ask $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
+   askm  $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav checkBoxes

@@ -1,16 +1,17 @@ 
-module Combination ( combination, wlogin) where
+module Combination ( combination, wlogin1) where
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Counter(counterWidget)
 import Data.String
 
 text= fromString
 
-combination =  ask $ do
+combination =  askm  $ do
      p << "Three active widgets in the same page with autoRefresh. Each widget refresh itself \
           \with Ajax. If Ajax is not active, they will refresh by sending a new page."
      ++> hr
-     ++> p << "Login widget (use admin/admin)" ++> autoRefresh (pageFlow "r" wlogin)  <++ hr
+     ++> p << "Login widget (use admin/admin)" ++> autoRefresh (pageFlow "r" wlogin1)  <++ hr
      **> p << "Counter widget" ++> autoRefresh (pageFlow "c" (counterWidget 0))  <++ hr
      **> p << "Dynamic form widget" ++> autoRefresh (pageFlow "f" formWidget) <++ hr
      **> wlink () << b << "exit"
@@ -54,34 +55,35 @@ 
 
 
--- | If not logged, it present a page flow which ask for the user name, then the password if not logged
+-- | If not logged, it present a page flow which askm  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.
-wlogin :: View Html IO ()
-wlogin=  (do
-    username <- getCurrentUser
-    if username /= anonymous
-     then return username
-     else do
-      name <- getString Nothing <! hint "username" <++ br
-      pass <- getPassword <! focus <** submitButton "login" <++ br
-      val  <- userValidate (name,pass)
-      case val of
-        Just msg -> notValid msg
-        Nothing  -> login name >> return name)
-
+wlogin1 :: View Html IO ()
+wlogin1 =  do
+   username <- getCurrentUser
+   if username /= anonymous
+         then return username
+         else do
+          name <- getString Nothing <! hint "username" <++ br
+          clear
+          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")
+                     ++> p << "navigate away of this page before logging out"
                      ++>  wlink "logout"  << b << " logout")
-   `wcallback`  const (logout >>  wlogin)
+   `wcallback`  const (logout >> wlogin1)
 
 focus = [("onload","this.focus()")]
 
 
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav  combination
 

@@ -1,46 +1,54 @@ 
 module ContentManagement ( textEdit) where
 import MFlow.Wai.Blaze.Html.All
+
 import Text.Blaze.Html5 as El
 import Text.Blaze.Html5.Attributes as At hiding (step)
 import Data.Monoid
+import Data.TCache.Memoization
 
+
+import Menu
+
+-- to run it alone, change askm by ask and uncomment this:
+--askm = ask
+--main= runNavigation "" $ transientNav textEdit
+
+
+
+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"
 
-
-
-    ask $   p << b <<  "An example of content management"
+    askm  $   p << b <<  "An example of content management"
         ++> first
         ++> second
         ++> wlink ()  << p <<  "click here to edit it"
-
-
-    ask $   p <<  "Please login with admin/admin to edit it"
-        ++> userWidget (Just "admin") userLogin
-
-    ask $   p <<  "Now you can click the fields and edit them"
-        ++> p << b <<  "to save an edited field, double click on it"
-        ++> tFieldEd "first"  first
-        **> tFieldEd "second" second
+    
+    askm  $   p <<  "Please login with edituser/edituser to edit it"
+        ++> userWidget (Just editUser) userLogin
+     
+    askm  $   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
-
-    ask $   p <<  "the user sees the edited content. He can not edit"
-        ++> tFieldEd "first"  first
-        **> tFieldEd "second" second
-        **> wlink ()  << p <<  "click to continue"
+   
+    askm  $   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"
 
-    ask $   p <<  "When texts are fixed,the edit facility and the original texts can be removed. The content is indexed by the field key"
+    askm  $   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"
 
-
--- to run it alone:
---main= runNavigation "" $ transientNav textEdit

@@ -1,6 +1,7 @@ 
 module Counter ( counter, counterWidget) where
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Data.Monoid
 import Data.String
 
@@ -8,17 +9,20 @@ text= fromString
 
 counter= do
-   let explain=
-        p << "This example emulates the"
-        <> a ! href (attr "http://www.seaside.st/about/examples/counter") << "seaside counter example"
-        <> p << "This widget uses a callback to permit an independent"
-        <> p << "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 call generates a new copy of the counter with the value modified."
-
-   ask $   explain
+   
+   askm  $   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 to permit an independent"
+        p << "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 recursvely generates a new copy of the counter with the value modified."
 
 counterWidget n= 
       (h2 << show n     
@@ -30,5 +34,5 @@           "d" -> counterWidget (n - 1)
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav counter

@@ -1,11 +1,12 @@ 
 module Dialog (wdialog1) where
 
-import MFlow.Wai.Blaze.Html.All
+import MFlow.Wai.Blaze.Html.All+import Menu
 
 wdialog1= do
-   ask  wdialogw
-   ask (wlink () << "out of the page flow, press here to go to the menu")
+   askm   wdialogw
+   askm  (wlink () << "out of the page flow, press here to go to the menu")
 
 wdialogw= pageFlow "diag" $ do
    r <- wform $ p << "please enter your name" ++> getString (Just "your name") <** submitButton "ok"
@@ -16,5 +17,5 @@                       else  wlink () << b << "thanks, press here to exit from the page Flow"
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav wdialog1

@@ -2,17 +2,18 @@ module Grid ( grid) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Data.String
 import Text.Blaze.Html5.Attributes as At hiding (step)
 
 attr= fromString
 
 grid = do
-  r <- ask $   addLink
+  r <- askm  $   addLink
            ++> wEditList table  row ["",""] "wEditListAdd"
            <** submitButton "submit"
            
-  ask $   p << (show r ++ " returned")
+  askm  $   p << (show r ++ " returned")
       ++> wlink () (p <<  " back to menu")
       
   where
@@ -30,5 +31,5 @@              
   tdborder= td ! At.style  (attr "border: solid 1px")
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav grid

@@ -2,18 +2,20 @@ module IncreaseInt ( clickn) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu 
 -- |+| 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 <- ask $   p << b <<  "increase an Int"
+   r <- askm  $ p << b <<  "increase an Int"
             ++> wlink "menu"  << p <<  "menu"      
             |+| getInt (Just n)  <* submitButton "submit"
 
    case r of
-    (Just _,_) -> return ()  --  ask $ wlink () << p << "thanks"
+    (Just _,_) -> return ()  --  askm  $ wlink () << p << "thanks"
     (_, Just n') -> clickn $ n'+1
 
--- to run it alone:
+-- to run it alone, change askm by askm  and uncomment this:
 --main= runNavigation "" $ transientNav sumWidget

@@ -2,9 +2,10 @@ module IncreaseString ( clicks) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu 
 clicks s= do
-   s' <- ask $  p << b <<  "increase a String"
+   s' <- askm  $  p << b <<  "increase a String"
              ++> p << b <<  "press the back button to go back to the menu"
              ++>(getString (Just s)
              <* submitButton "submit")
@@ -12,5 +13,5 @@    clicks $ s'++ "1"
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav clicks "1"

@@ -1,33 +1,34 @@-
+{-# LANGUAGE OverloadedStrings #-}
 module ListEdit ( wlistEd) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Text.Blaze.Html5 as El
 import Text.Blaze.Html5.Attributes as At hiding (step)
 import Data.String
 
-attr= fromString
 
+
 wlistEd= do
-   r <-  ask  $   addLink
+   r <-  askm   $   addLink
               ++> br
               ++> (wEditList El.div getString1   ["hi", "how are you"] "wEditListAdd")
               <++ br
               <** submitButton "send"
 
-   ask $   p << (show r ++ " returned")
-       ++> wlink () (p <<  " back to menu")
+   askm  $   p << (show r ++ " returned")
+       ++> wlink () (p " back to menu")
 
 
    where
-   addLink = a ! At.id  (attr "wEditListAdd")
-               ! href (attr "#")
-               $ b << "add"
-   delBox  =  input ! type_   (attr "checkbox")
-                    ! checked (attr "")
-                    ! onclick (attr "this.parentNode.parentNode.removeChild(this.parentNode)")
+   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:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav wListEd
 

@@ -3,25 +3,29 @@ 
 import MFlow.Wai.Blaze.Html.All
 import Data.Monoid
+import Menu
+-- to run it alone, comment import Menu and uncomment this:
+--main= runNavigation "" $ transientNav loginSample
+--askm= ask
 
 loginSample= do
-    r <- ask $   p <<  "Please login with admin/admin"
-             ++> userWidget (Just "admin") userLogin
-             <|> wlink "exit" << p << "or exit"
+    userRegister "user" "user"
+    r <- askm  $   p <<  "Please login with user/user"
+               ++> userWidget Nothing userLogin
+               <|> wlink "exit" << p << "or exit"
         
     if r == "exit" then return () else do
         user <- getCurrentUser
     
-        r <- ask $   b <<  ("user logged as " <>  user)
-                ++> wlink True  << p <<  "logout"
-                <|> wlink False << p <<  "or exit"
+        r <- askm  $   b <<  ("user logged as " <>  user)
+                   ++> wlink True  << p <<  "logout"
+                   <|> wlink False << p <<  "or exit"
 
         if r
           then do
              logout
-             ask $ p << "logged out" ++> wlink () << "press here to exit"
+             askm  $ p << "logged out" ++> wlink () << "press here to exit"
           else return ()
   
 
--- to run it alone:
--- main= runNavigation "" $ transientNav loginSample
+

@@ -0,0 +1,29 @@+module MCounter (
+mcounter
+) where
+import MFlow.Wai.Blaze.Html.All
+import Menu
+import Data.Monoid
+import Data.String
+
+
+
+mcounter  = do 
+ (op,n) <- step . askm $ 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
+
+-- to run it alone, change askm by ask and uncomment this:
+--main= runNavigation ""  mcounter
+
+

@@ -2,7 +2,8 @@ module Multicounter ( multicounter) where
 
 import MFlow.Wai.Blaze.Html.All
-import Data.Monoid
+import Menu
+import Data.Monoid 
 import Data.String
 import Counter(counterWidget)
 
@@ -10,7 +11,7 @@ attr= fromString
 
 multicounter=
- ask $   explain
+ askm  $ explain
      ++> add (counterWidget 0) [1..4]
      <|> wlink () << p << "exit"
 
@@ -26,5 +27,5 @@  add widget list= firstOf [autoRefresh $ pageFlow (show i) widget <++ hr | i <- list]
 
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav multicounter

@@ -2,18 +2,19 @@ module Options (options) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu 
 options= do
-   r <- ask $ getSelect (setSelectedOption ""  (p <<  "select a option") <|>
+   r <- askm  $ getSelect (setSelectedOption ""  (p <<  "select a option") <|>
                          setOption "red"  (b <<  "red")                  <|>
                          setOption "blue" (b <<  "blue")                 <|>
                          setOption "Green"  (b <<  "Green")  )
                          <! dosummit
-   ask $ p << (r ++ " selected") ++> wlink () (p <<  " menu")
+   askm  $ p << (r ++ " selected") ++> wlink () (p <<  " menu")
 
 
    where
    dosummit= [("onchange","this.form.submit()")]
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav options

@@ -1,6 +1,7 @@ 
 module PreventGoingBack ( preventBack) where
-import MFlow.Wai.Blaze.Html.All
+import MFlow.Wai.Blaze.Html.All+import Menu
 import System.IO.Unsafe
 import Control.Concurrent.MVar
 
@@ -8,14 +9,14 @@ 
 
 preventBack= do
-    ask $ wlink () << b << "press here to pay 100000 $ "
+    askm  $ wlink "don't care" << b << "press here to pay 100000 $ "
     payIt
     paid  <- liftIO $ readMVar rpaid
-    preventGoingBack . ask $   p << "You already paid 100000 before"
-                           ++> p << "you can no go back until the end of the buy process"
+    preventGoingBack . askm  $ 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"
                            
-    ask $   p << ("you paid "++ show paid)
+    askm  $   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
@@ -23,5 +24,5 @@       paid <- takeMVar  rpaid
       putMVar rpaid $ paid + 100000
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav preventBack

@@ -2,17 +2,22 @@ module PushDecrease ( pushDecrease) where
 
 import MFlow.Wai.Blaze.Html.All
+
 import Control.Concurrent.STM
 import Text.Hamlet
 import Control.Concurrent
 
+import Menu
+-- to run it alone, comment "import menu" and uncomment:
+--main= runNavigation "" $ transientNav pushDecrease
 
+
 atomic= liftIO . atomically
 
 pushDecrease= do
  tv <- liftIO $ newTVarIO 10
 
- page $
+ pagem $
       [shamlet|
        <div>
            <h2> Maxwell Smart push counter
@@ -25,7 +30,7 @@ 
  where
  counter tv = push Html 0 $ do
-      setTimeouts 2 0     -- kill  the thread when count finish
+      setTimeouts 2 0     -- kill  the thread after 2 s of incactivity, when count finish
       n <- atomic $ readTVar tv
       if (n== -1)
         then  do
@@ -35,6 +40,4 @@           liftIO $ threadDelay 1000000
           h1 << (show n) ++> noWidget
 
--- to run it alone:
---main= runNavigation "" $ transientNav pushDecrease
 

@@ -1,13 +1,14 @@ 
 module PushSample (pushSample) where
 
-import MFlow.Wai.Blaze.Html.All
-import Control.Concurrent.STM
+import MFlow.Wai.Blaze.Html.All hiding (retry)+import Menu 
+import Control.Concurrent.STM 
 
 
 pushSample=  do
   tv <- liftIO $ newTVarIO $ Just "The content will be appended here"
-  page $   h2 << "Push example"
+  pagem $   h2 << "Push example"
        ++> p << "The content of the text box will be appended to the push widget above."
        ++> p << "A push widget can have links and form fields."
        ++> p << "Since they are asynchronous, the communucation must be trough mutable variables"
@@ -43,5 +44,5 @@ 
 atomic= liftIO . atomically
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav pushSample

@@ -2,12 +2,13 @@ module Radio ( radio) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu 
 radio = do
-   r <- ask $   p << b <<  "Radio buttons"
+   r <- askm $   p << b <<  "Radio buttons"
             ++> getRadio [\n -> fromStr v ++> setRadioActive v n | v <- ["red","green","blue"]]
 
-   ask $ p << ( show r ++ " selected")  ++> wlink ()  << p <<  " menu"
+   askm $ p << ( show r ++ " selected")  ++> wlink ()  << p <<  " menu"
 
--- to run it alone:
+-- to run it alone, change askm by ask and uncomment this:
 --main= runNavigation "" $ transientNav radio

@@ -2,7 +2,8 @@ {-# OPTIONS  -XDeriveDataTypeable #-}
 module ShopCart ( shopCart) where
 
-import MFlow.Wai.Blaze.Html.All
+import MFlow.Wai.Blaze.Html.All+
 import Data.Typeable
 import qualified Data.Vector as V
 import Text.Blaze.Html5 as El
@@ -10,50 +11,61 @@ import Data.Monoid
 import Data.String
 import Data.Typeable
++import Menu 
+-- to run it alone, comment import Menu and uncomment the code below
+--main= runNavigation ""   shopCart+
--askm= ask+
 data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum, Show,Read , Typeable)
 
+newtype Cart= Cart (V.Vector Int) deriving Typeable 
-newtype Cart= Cart (V.Vector Int) deriving Typeable
 emptyCart= Cart $ V.fromList [0,0,0]
-
-shopCart  = do
-
-   addHeader $ \html -> p << ( El.span <<
-     "A persistent flow  (uses step). The process is killed after 100 seconds of inactivity \
-     \but it is restarted automatically. Event If you restart the whole server, it remember the shopping cart\n\n \
-     \Defines a table with links that return ints and a link to the menu, that abandon this flow.\n\
-     \The cart state is not stored, Only the history of events is saved. The cart is recreated by running the history of events."
++shopCart= shopCart1 
-     <> html)
-   setTimeouts 100 (60 * 60)
-   shopCart1
-   where
-   shopCart1 =  do
-     o <-  step . ask $ do
-             let moreexplain= p << "The second parameter of \"setTimeout\" is the time during which the cart is recorded"
+shopCart1  =  do+     setHeader  stdheader 
+--     setTimeouts 200 $ 60*60   
+     prod <-+        step . askm $ 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") <++  td << ( b <<  show ( cart V.! 0))
-                  <|>  tr <<< td <<< wlink  IPod   (b <<  "ipod")   <++  td << ( b <<  show ( cart V.! 1))
-                  <|>  tr <<< td <<< wlink  IPad   (b <<  "ipad")   <++  td << ( b <<  show ( cart V.! 2)))
+                  ++> (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 o
-     Cart cart <- getSessionData `onNothing` return emptyCart
+                  ))++                  
+     let i = fromEnum prod+     Cart cart <- getSessionData `onNothing` return  emptyCart
      setSessionData . Cart $ cart V.// [(i, cart V.!  i + 1 )]
      shopCart1
 
-    where
+    where+    tdc= td ! At.style (attr "text-align:center")
     linkHome= a ! href  (attr $ "/" ++ noScript) << b <<  "home"
-    attr= fromString
-
--- to run it alone:
---main= runNavigation ""   shopCart
+    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\n\n \+         \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.\n\n\
+         \.Defines a table with links that return ints and a link to the menu, that abandon this flow.\n\
+         \.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"

@@ -2,8 +2,9 @@ module SumView (sumInView) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu 
-sumInView= ask $ p << "ask for three numbers in the same page and display the result.\
+sumInView= askm $ p << "ask for three numbers in the same page and display the result.\
                       \It is possible to modify the inputs and the sum will reflect it"
                ++> sumWidget
                
@@ -20,5 +21,5 @@       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:
+-- to run it alone, replace askm by ask and uncomment the following line
 --main= runNavigation "" $ transientNav sumWidget

@@ -1,45 +1,45 @@ 
 module TestREST where
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Data.Monoid
 import Data.String
 
--- 9 pages , each page has a restful link (page = ask)
+-- A menu with two branches, each one is a sucession of pages
 
--- to run it alone:
---main= runNavigation "" $ transientNav testREST
+-- 9 pages , each page has a restful link (pagem = ask)
 
+-- to run it alone,  delete "import Menu" and uncomment the next lines
 
-testREST= do
-  setTimeouts 120 0
+-- main= runNavigation "" $ transientNav testREST
 
-  addHeader header1
+-- pagem= page
 
-  option <- page $   wlink "a" << p << "letters " <++ p << "or"
-                 <|> wlink "1" << p << "numbers"
 
+testREST= do
+--  setTimeouts 120 0
+
+  option <- pagem $  h2 << "Choose between:"
+                 ++> wlink "a" << b << "letters " <++ i << " or "
+                 <|> wlink "1" << b << "numbers"
+
   case option of
     "1" -> do
-          page $ wlink "2" << contentFor "1"
-          page $ wlink "3" << contentFor "2"
-          page $ wlink "4" << contentFor "3"
-          page $ wlink ()  << "menu"
+          pagem $ wlink "2" << contentFor "1" 
+          pagem $ wlink "3" << contentFor "2"
+          pagem $ wlink "4" << contentFor "3"
+          pagem $ wlink ()  << "menu"
 
     "a" -> do
-          page $ wlink "b" << contentFor "a"
-          page $ wlink "c" << contentFor "b"
-          page $ wlink "d" << contentFor "c"
-          page $ wlink ()  << "menu"
+          pagem $ wlink "b" << contentFor "a"
+          pagem $ wlink "c" << contentFor "b"
+          pagem $ wlink "d" << contentFor "c"
+          pagem $ wlink ()  << "menu"
 
 
-contentFor x=
+contentFor x= do
         p << "page for"
-        <> b << x
-        <> p << "goto next page"
-
-header1 h= html << body (text h)
-  where
-  text h= a ! href (fromString "http://haskell-web.blogspot.com.es/2013/07/the-web-navigation-monad.html")
-            << "see this" <> hr <> h <> hr
-          <> a ! href (fromString "/") << "main menu"
+        b << x
+        p << "goto next page"
+        p << "or press the back button for the previous page"
 

@@ -2,10 +2,11 @@ module TraceSample ( traceSample) where
 
 import MFlow.Wai.Blaze.Html.All
+import Menu
 import Control.Monad.Loc
 
 traceSample= do
-  page $   h2 << "Error trace example"
+  pagem $  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"
@@ -13,14 +14,14 @@        ++> 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
+  pagem $   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 page"
-       ++> p << ("user="++ u) ++> br
-       ++> wlink () << "press here"
-  page $   error $ "this is the error"
+  pagem $   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"
+  pagem $   error $ "this is the error"
 
--- to run it alone:
+-- to run it alone, replace askm by ask and uncomment the following line
 --main= runNavigation "" $ transientNav traceSample

@@ -1,10 +1,11 @@-{-# OPTIONS  -XDeriveDataTypeable -XQuasiQuotes  -F -pgmF MonadLoc #-}
+{-# OPTIONS  -XDeriveDataTypeable -XQuasiQuotes -XOverloadedStrings -F -pgmF MonadLoc #-}
 module Main where
-import MFlow.Wai.Blaze.Html.All hiding (article)
-import Text.Blaze.Html5 as El hiding (article)
-import Text.Blaze.Html5.Attributes as At hiding (step)
-
+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
@@ -12,7 +13,8 @@ 
 -- For error traces
 import Control.Monad.Loc
-
++import Menu
 import TestREST
 import Actions
 import IncreaseInt
@@ -35,253 +37,104 @@ import PushSample
 import Grid
 import Radio
-import SumView
+import SumView+import MCounter+import Database+import MFlowPersistent+import RuntimeTemplates
 
 import Debug.Trace-(!>)= flip trace
-
-main= do
-   setAdminUser "admin" "admin"
-   syncWrite SyncManual
-   setFilesPath "Demos/"
-   addMessageFlows  [("shop"      , runFlow $ shopCart  `showSource` "ShopCart.hs")
-                    ,("navigation", runFlow $ transientNav testREST `showSource` "TestREST.hs")]
-
-   runNavigation "" $  transientNav mainmenu
-
-
-attr= fromString
-text= fromString
-
-data Options= CountI | CountS | Radio
-            | Login | TextEdit |Grid | Autocomp | AutocompList
-            | ListEdit |Shop | Action | Ajax | Select
-            | CheckBoxes | PreventBack | Multicounter
-            | Combination
-            | FViewMonad | Counter | WDialog |Push |PushDec |Trace
-            deriving (Bounded, Enum,Read, Show,Typeable)
-
-newtype Server= Server String deriving Typeable
-mainmenu =  do
-       host <- getRawParam "Host" `onNothing` return "mflowdemo.herokuapp.com/"-       setSessionData $ Server host-       setHeader $ stdheader 
-       setTimeouts 100 0-       
-       r <- ask $  wcached "menu" 0 $
-               b <<  "PUSH"-               ++> (li <<< wlink Push << b << "Push example"-                                 <++ b << " A push widget in append mode receives input from\-                                         \a text box with autorefresh"-                                 <>  article pushl)
-               <|> (li <<< wlink PushDec << b << "A push counter"-                                 <++ b << " Show a countdown. Then goes to the main menu"-                                 <>  article pushdec)
-               <|> br ++> br
-               ++> b <<  "ERROR TRACES"
-               ++> (li <<< wlink Trace << b << " Execution traces for errors"-                             <++ b << " produces an error and show the complete execution trace"-                             <>  article errorTrace)
-               <|> br ++> br ++>
-               b <<  "DIFFERENT KINDS OF FLOWS"-               
-               ++> (li $ do a ! href (attr "/navigation") <<  " REST navigation"-                            b << " Navigates trough  menus and a sucession of GET pages"-                            article navigation)-                            
-               ++> (li $ do a ! href (attr "/shop") <<  " Stateful flow: shopping"-                            b << " Add articles to a persistent shopping cart"-                            article stateful)
-                       
-               ++>  br ++> br ++> b <<  "BASIC"-               
-               ++>  (li <<< wlink CountI       << b <<  "Increase an Int"-                                   <++ b << " A loop that increases the Int value of a text box")-                                   
-               <|>  (li <<< wlink CountS       << b <<  "Increase a String"-                                   <++ b << " A loop that concatenate text in a text box")-                                   
-               <|>  (li <<< wlink Select       << b <<  "Select options"-                                   <++ b << " A combo box")-                                   
-               <|>  (li <<< wlink CheckBoxes   << b <<  "Checkboxes")-           
-               <|>  (li <<< wlink Radio        << b <<  "Radio buttons")
-
-               <++  br <>  br                 <> b <<  "WIDGET ACTIONS & CALLBACKS"-               
-               <|>  (li <<< wlink Action       << b <<  "Example of action, executed when a widget is validated")
 -               <|>  (li <<< wlink FViewMonad   << b <<  "in page flow: sum of three numbers"-                             <++ b << " Page flows are monadic widgets that modifies themselves in the page"-                             <>  article pageflow)
--               <|>  (li <<< wlink Counter      << b <<  "Counter"-                             <++ b << " A page flow which increases a counter by using a callback"-                             <>  article callbacks)
--               <|>  (li <<< wlink Multicounter << b <<  "Multicounter"-                             <++ b << " Page flow with many independent counters with autoRefresh, so they modify themselves in-place"-                             <>  article callbacks)
--               <|>  (li <<< wlink Combination  << b <<  "Combination of three dynamic widgets"-                             <++ b << " Combination of autoRefreshe'd widgets in the same page, with\-                                      \ different behaviours"-                             <>  article combinationl)
--               <|>  (li <<< wlink WDialog      << b <<  "Modal dialog"-                             <++ b << " A modal Dialog box with a form within a page flow")          
+--(!>)= flip trace
 
-               <|>  br ++>  br               ++> b <<  "DYNAMIC WIDGETS"
+--attr= fromString -               ++>  (li <<< wlink Ajax         << b <<  "AJAX example"-                             <++ b << " A onclick event in a text box invokes a server procedure that \-                                      \increment the integer value"-                             <>  article ajaxl)
 -               <|>  (li <<< wlink Autocomp     << b <<  "autocomplete"-                             <++ b << " Example of autocomplete, a widget which takes the suggested values from a server procedure")                 
 -               <|>  (li <<< wlink AutocompList << b <<  "autocomplete List"-                             <++ b << " Example of a widget that generates a set of return values, suggested by a autocomplete input box"-                             <>  article editList)
--               <|>  (li <<< wlink ListEdit     << b <<  "list edition"-                             <++ b << " Example of a widget that edit, update and delete a list of user-defined widgets")
--               <|>  (li <<< wlink Grid         << b <<  "grid"-                             <++ b << " Example of the same widget In this case, containing a row of two fields, aranged in a table"-                             <>  article gridl)
--               <|>  (li <<< wlink TextEdit     << b <<  "Content Management"-                             <++ b << " Example of the (basic) content management primitives defined in MFlow.Forms.Widgets")
+main= do+   index idnumber                      -- for the Database example+   index tfieldKey
+   setAdminUser adminname adminname+   userRegister edadmin edadmin+   userRegister "edituser" "edituser"
+   syncWrite  $ Asyncronous 120 defaultCheck  1000+--   addMessageFlows[("wiki", transient $ runFlow $ ask  wiki)] 
+   setFilesPath "Demos/"+   runNavigation "" $ do+       setHeader $ stdheader 
+       setTimeouts 400 $ 60 * 60 
-               <|>  br ++>  br ++> b <<  "OTHERS"
+       r <- step . ask $   tFieldEd edadmin "head" "set Header" <++ hr+                       **> topLogin+                       **> (divmenu  <<< br ++>  mainMenu) 
+                       <** (El.div ! At.style "float:right;width:65%;overflow:auto;"+                            <<< tFieldEd edadmin "intro" "enter intro text")
+
+       case r of+             Wiki      ->    delSessionData (Filename "") >> step  wiki                 
+             CountI    ->     step  (clickn 0)           `showSource`  "IncreaseInt.hs"
+             CountS    ->     step  (clicks "1")         `showSource`  "IncreaseString.hs"
+             Action    ->     step  actions              `showSource`  "Actions.hs"
+             Ajax      ->     step  ajaxsample           `showSource`  "AjaxSample.hs"
+             Select    ->     step  options              `showSource`  "Options.hs"
+             CheckBoxes ->    step  checkBoxes           `showSource`  "CheckBoxes.hs"
+             TextEdit  ->     step  textEdit             `showSource`  "ContentManagement.hs"
+             Grid      ->     step  grid                 `showSource`  "Grid.hs"
+             Autocomp  ->     step  autocomplete1        `showSource`  "AutoComplete.hs"
+             AutocompList ->  step  autocompList         `showSource`  "AutoCompList.hs"
+             ListEdit  ->     step  wlistEd              `showSource`  "ListEdit.hs"
+             Radio     ->     step  radio                `showSource`  "Radio.hs"
+             Login     ->     step  loginSample          `showSource`  "LoginSample.hs"
+             PreventBack ->   step  preventBack          `showSource`  "PreventGoingBack.hs"
+             Multicounter->   step  multicounter         `showSource`  "Multicounter.hs"
+             FViewMonad  ->   step  sumInView            `showSource`  "SumView.hs"
+             Counter     ->   step  counter              `showSource`  "Counter.hs"
+             Combination ->   step  combination          `showSource`  "Combination.hs"
+             WDialog     ->   step  wdialog1             `showSource`  "Dialog.hs"
+             Push        ->   step  pushSample           `showSource`  "PushSample.hs"
+             PushDec     ->   step  pushDecrease         `showSource`  "PushDecrease.hs"
+             Trace       ->   step  traceSample          `showSource`  "TraceSample.hs"+             RESTNav     ->   step  testREST             `showSource`  "TestREST.hs"+             Database    ->   step  database             `showSource`  "Database.hs"
+             ShopCart    ->   shopCart                   `showSource` "ShopCart.hs"+             MCounter    ->   mcounter                   `showSource` "MCounter.hs"+             MFlowPersist ->  step mFlowPersistent       `showSource` "MFlowPersistent.hs"+             RuntimeTemplates -> step runtimeTemplates   `showSource` "RuntimeTemplates.hs" -               ++>  (li <<< wlink Login        << b <<  "login/logout"-                             <++ b << " Example of using the login and/or logout")
 -               <|>  (li <<< wlink PreventBack  << b <<  "Prevent going back after a transaction"-                             <++ b << " Control backtracking to avoid navigating back to undo something that can not be undone\-                                      \. For example, a payment"-                             <>  article preventbackl)
-
-
-
-       case r of
-             CountI    ->  clickn 0              `showSource`  "IncreaseInt.hs"
-             CountS    ->  clicks "1"            `showSource`  "IncreaseString.hs"
-             Action    ->  actions 1             `showSource`  "actions.hs"
-             Ajax      ->  ajaxsample            `showSource`  "AjaxSample.hs"
-             Select    ->  options               `showSource`  "Options.hs"
-             CheckBoxes -> checkBoxes            `showSource`  "CheckBoxes.hs"
-             TextEdit  ->  textEdit              `showSource`  "TextEdit.hs"
-             Grid      ->  grid                  `showSource`  "Grid.hs"
-             Autocomp  ->  autocomplete1         `showSource`  "Autocomplete.hs"
-             AutocompList -> autocompList        `showSource`  "AutoCompList.hs"
-             ListEdit  ->  wlistEd               `showSource`  "ListEdit.hs"
-             Radio     ->  radio                 `showSource`  "Radio.hs"
-             Login     ->  loginSample           `showSource`  "LoginSample.hs"
-             PreventBack -> preventBack          `showSource`  "PreventGoingBack.hs"
-             Multicounter-> multicounter         `showSource`  "Multicounter.hs"
-             FViewMonad  -> sumInView            `showSource`  "SumView.hs"
-             Counter    -> counter               `showSource`  "Counter.hs"
-             Combination -> combination          `showSource`  "Combination.hs"
-             WDialog     -> wdialog1             `showSource`  "Dialog.hs"
-             Push        -> pushSample           `showSource`  "PushSample.hs"
-             PushDec     -> pushDecrease         `showSource`  "PushDecrease.hs"
-             Trace       -> traceSample          `showSource`  "TraceSample.hs"
 -space= preEscapedToMarkup "&nbsp;"-article link=  space <> a ! href (attr link) <<  i << "(article)"+wiki =  do+  pag <- getRestParam `onNothing` return "Index"+  askm $+   (docTypeHtml $ do
+       El.head $ do+        El.title $ fromString pag)+        ++> (El.div ! At.style "float:right" <<< autoRefresh wlogin )+        **> ( h1 ! At.style "text-align:center" <<<  tFieldEd "editor" (wikip ++pag ++ "title.html") (fromString pag))+        **> tFieldEd "editor" (wikip ++ pag ++ "body.html") "Enter the body"+        **> noWidget -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"+wikip="wiki/" -
-showSource w filename = do
-      Server host <- getSessionData `onNothing` error "host must have been set"
-      let path=  attr $ "http://" <> host <> filename !> host
-      addHeader $ \html -> source path html <> download path
-      w
-      where-      download path= p $ text "download " <> a ! href  path << filename
-      source path html =
-        El.div $ do
-             html
-             br
-             br
-             hr
-             h3 $ text "SOURCE CODE:"
-             iframe ! At.style sty
-                    ! At.height (attr "400")
-                    ! At.src path
-                    $ b $ text "no iframes"
-      sty= attr "float:left\
-                \;width:100%\
-                \;margin-left:5px;margin-right:10px;overflow:auto;"
-
++-- | to run it on heroku, traceSample is included since heroku does not run the monadloc preprocessor
 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"
+  pagem $ 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"
+       ++> 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
+  pagem $   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 page"
+  pagem $  p "The trace will appear after you press the link. press one of the options available at the bottom of the page"
        ++> p << ("user="++ u) ++> br
-       ++> wlink () << "press here"
-  page $   error $ "this is the error"
+       ++> wlink () "press here"
+  pagem $  error $ "this is the error"
 
 
-stdheader  c= docTypeHtml
-   $ El.head << (El.title << "MFlow examples"
-     <> link ! rel   ( attr "stylesheet")
-             ! type_ ( attr "text/css")
-             ! href (attr "http://jqueryui.com/resources/demos/style.css"))
-   <> (body $ 
-      a ! At.style (attr "align:center;")
-        ! href ( attr  "http://hackage.haskell.org/packages/archive/MFlow/0.3.0.1/doc/html/MFlow-Forms.html")
-        << h1 <<  "MFlow examples"
-   <> br
-   <> hr
-   <> (El.div ! At.style (attr "float:left\
-                         \;width:50%\
-                         \;margin-left:10px;margin-right:10px;overflow:auto;") $
-          br <> c)
-   <> (El.div ! At.style (attr "float:right;width:45%;overflow:auto;") $
 
-       br
-       <> p  << a ! href (attr "/html/MFlow/index.html") <<  "MFlow package description and documentation"
-       <> p  << a ! href (attr "https://github.com/agocorona/MFlow/blob/master/Demos") <<  "see demos source code"
-       <> p  << a ! href (attr "https://github.com/agocorona/MFlow/issues") <<  "bug tracker"
-       <> p  << a ! href (attr "https://github.com/agocorona/MFlow") <<  "source repository"
-       <> p  << a ! href (attr "http://hackage.haskell.org/package/MFlow") <<  "Hackage repository"
---       <> (h3 $ do---             text "SOURCE CODE:"
---             iframe ! At.style sty
---                    ! At.height (attr "400")
---                    ! At.src (attr $   "http://" <> host <> ('/':"demos-blaze.hs"))
---                    $ b $ text "no iframes")-                ))
-   where-   sty= attr "float:left\
-                \;width:100%\
-                \;margin-left:5px;margin-right:10px;overflow:auto;"
-            

@@ -1,157 +1,133 @@ name: MFlow
-version: 0.3.1.1
+version: 0.3.2.0
 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
+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.3.1 includes:-            .-            - 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 
-            .-            In this release, this issue has been fixed: <https://github.com/agocorona/MFlow/issues/8>-            
+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
+             .+             .+             This version 0.3.2 add runtime templates 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
+             .
+             In this release, runtime templates is e
 category: Web, Application Server
 author: Alberto Gómez Corona
 data-dir: ""
-extra-source-files: Demos/demos-blaze.hs-                  , Demos/TestREST.hs-                    , Demos/Actions.hs-                    , Demos/IncreaseInt.hs-                    , Demos/ShopCart.hs-                    , Demos/AjaxSample.hs-                    , Demos/TraceSample.hs-                    , Demos/IncreaseString.hs-                    , Demos/AutoCompList.hs-                    , Demos/ListEdit.hs-                    , Demos/AutoComplete.hs-                    , Demos/LoginSample.hs-                    , Demos/CheckBoxes.hs-                    , Demos/Multicounter.hs-                    , Demos/Combination.hs-                    , Demos/Options.hs-                    , Demos/ContentManagement.hs-                    , Demos/PreventGoingBack.hs-                    , Demos/Counter.hs-                    , Demos/PushDecrease.hs-                    , Demos/Dialog.hs-                    , Demos/PushSample.hs-                    , Demos/Grid.hs-                    , Demos/Radio.hs-                    , Demos/SumView.hs
-                  , 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-                  
-
+extra-source-files: Demos/demos-blaze.hs Demos/TestREST.hs
+                    Demos/Actions.hs Demos/IncreaseInt.hs Demos/ShopCart.hs
+                    Demos/AjaxSample.hs Demos/TraceSample.hs Demos/IncreaseString.hs
+                    Demos/AutoCompList.hs Demos/ListEdit.hs Demos/AutoComplete.hs
+                    Demos/LoginSample.hs Demos/CheckBoxes.hs Demos/Multicounter.hs
+                    Demos/Combination.hs Demos/Options.hs Demos/ContentManagement.hs
+                    Demos/PreventGoingBack.hs Demos/Counter.hs Demos/PushDecrease.hs
+                    Demos/Dialog.hs Demos/PushSample.hs Demos/Grid.hs Demos/Radio.hs
+                    Demos/SumView.hs src/MFlow/Hack.hs src/MFlow/Hack/Response.hs
+                    Demos/MCounter.hs src/MFlow/Hack/XHtml.hs
+                    src/MFlow/Hack/XHtml/All.hs src/MFlow/Forms/HSP.hs
 
 source-repository head
     type: git
     location: http://github.com/agocorona/MFlow
 
 library
-    build-depends: Workflow -any, transformers -any, mtl -any, 
+    build-depends: Workflow -any, transformers -any, mtl -any,
                    extensible-exceptions -any, xhtml -any, base >4.0 && <5,
-                   bytestring -any, containers -any, RefSerialize -any, TCache -any,
-                   stm >2, old-time -any, vector -any, directory -any,
-                   utf8-string -any, wai -any, case-insensitive -any, http-types -any,
-                   conduit -any, text -any, parsec -any, warp -any,
-                   random -any,  blaze-html -any, blaze-markup -any,-                   monadloc -any, hamlet -any-                  
-
-    exposed-modules: MFlow MFlow.Wai.Blaze.Html.All
-                     MFlow.Forms MFlow.Forms.Admin
-                     MFlow.Cookies  MFlow.Wai
-                     MFlow.Wai.XHtml.All MFlow.Forms.XHtml
-                     MFlow.Forms.Blaze.Html MFlow.Forms.Test
-                     MFlow.Forms.Widgets-                     MFlow.Forms.Internals-                     
-    other-modules:  MFlow.Wai.Response
+                   bytestring -any, containers -any, RefSerialize -any,
+                   TCache -any, stm >2, old-time -any, vector -any,
+                   directory -any, utf8-string -any, wai -any, case-insensitive -any,
+                   http-types -any, conduit -any, text -any, parsec -any, warp -any,
+                   random -any, blaze-html -any, blaze-markup -any, monadloc -any,
+                   hamlet -any
+    exposed-modules: MFlow MFlow.Wai.Blaze.Html.All MFlow.Forms
+                     MFlow.Forms.Admin MFlow.Cookies MFlow.Wai MFlow.Wai.XHtml.All
+                     MFlow.Forms.XHtml MFlow.Forms.Blaze.Html MFlow.Forms.Test
+                     MFlow.Forms.Widgets MFlow.Forms.Internals
     exposed: True
     buildable: True
     hs-source-dirs: src .
+    other-modules:  MFlow.Wai.Response
 
---executable demos-blaze---    build-depends: MFlow -any, RefSerialize -any, TCache -any, directory -any,---                   Workflow -any, base -any, blaze-html -any, bytestring -any,---                   containers -any, mtl -any, old-time -any, stm -any,---                   text -any, transformers -any, vector -any,  hamlet -any,---                   monadloc -any------    main-is: "demos-blaze.hs"---    ghc-options:---        -iDemos---        -threaded---        -rtsopts---    buildable: True---    hs-source-dirs: Demos+--executable demos-blaze
+--    build-depends: MFlow -any, RefSerialize -any, TCache -any,
+--                   directory -any ,  Workflow -any, base -any, blaze-html -any,
+--                   bytestring, containers -any, mtl -any, old-time -any,
+--                   stm -any, text -any, transformers -any, vector -any, hamlet -any,
+--                   monadloc -any, monadloc-pp -any, aws -any, network -any, hscolour -any,
+--                   persistent-template, persistent-sqlite, persistent,
+--                   conduit, http-conduit, monad-logger
+--
+--
+--    main-is: demos-blaze.Loc.hs
+--    buildable: True
+--    hs-source-dirs: Demos
+--    other-modules: MFlowPersistent MCounter
+--    ghc-options: -iDemos -threaded -rtsopts
+

@@ -63,13 +63,13 @@ ,flushRec, receive, receiveReq, receiveReqTimeout, send, sendFlush, sendFragment
 , sendEndFragment, sendToMF
 -- * Flow configuration
-,addMessageFlows,getMessageFlows, transient, stateless,anonymous
+,addMessageFlows,getMessageFlows,delMessageFlow, transient, stateless,anonymous
 ,noScript,hlog, setNotFoundResponse,getNotFoundResponse,
 -- * ByteString tags
--- | very basic but efficient tag formatting
+-- | very basic but efficient bytestring tag formatting
 btag, bhtml, bbody,Attribs, addAttrs
 -- * user
-, userRegister, setAdminUser, getAdminName
+, userRegister, setAdminUser, getAdminName, Auth(..),getAuthMethod, setAuthMethod
 -- * static files
 ,setFilesPath
 -- * internal use
@@ -83,9 +83,9 @@ import GHC.Conc(unsafeIOToSTM)
 import Data.Typeable
 import Data.Maybe(isJust, isNothing, fromMaybe, fromJust)
-import Data.Char(isSeparator)
+import Data.Char(isSeparator) 
 import Data.List(isPrefixOf,isSuffixOf,isInfixOf, elem , span, (\\),intersperse)
-import Control.Monad(when)
+import Control.Monad(when) 
 
 import Data.Monoid
 import Control.Concurrent(forkIO,threadDelay,killThread, myThreadId, ThreadId)
@@ -96,8 +96,9 @@ import Data.TCache
 import Data.TCache.DefaultPersistence  hiding(Indexable(..))
 import Data.TCache.Memoization
-import  Data.ByteString.Lazy.Char8 as B  (head, readFile,ByteString, concat,pack, unpack,empty,append,cons,fromChunks)
+import qualified Data.ByteString.Lazy.Char8 as B  (head, readFile,ByteString, concat,pack, unpack,empty,append,cons,fromChunks)
 import Data.ByteString.Lazy.Internal (ByteString(Chunk))
+import qualified Data.ByteString.Char8 as SB
 import qualified Data.Map as M
 import System.IO
 import System.Time
@@ -106,11 +107,11 @@ import Control.Monad.Trans
 import qualified Control.Exception as CE
 import Data.RefSerialize hiding (empty)
-
+import qualified Data.Text as T
 import System.Posix.Internals
 
---import Debug.Trace
---(!>)  =   flip trace
+import Debug.Trace
+(!>)  =   flip trace
 
 
 -- | a Token identifies a flow that handle messages. The scheduler compose a Token with every `Processable`
@@ -118,9 +119,9 @@ data Token = Token{twfname,tuser, tind :: String , tpath :: [String], tenv:: Params, tsendq :: MVar Req, trecq :: MVar Resp}  deriving  Typeable
 
 instance Indexable  Token  where
-     key (Token w u i _ _ _ _  )=
-          if u== anonymous then  u ++ i   -- ++ "@" ++ w
-                          else  u       -- ++ "@" ++ w
+     key (Token w u i _ _ _ _  )=  i
+--          if u== anonymous then  u ++ i   -- ++ "@" ++ w
+--                          else  u       -- ++ "@" ++ w
 
 instance Show Token where
      show t = "Token " ++ key t
@@ -141,8 +142,9 @@      readsPrec _ str= error $ "parse error in Token read from: "++ str
 
 instance Serializable Token  where
-  serialize  = pack . show
-  deserialize= read . unpack
+  serialize  = B.pack . show
+  deserialize= read . B.unpack
+  setPersist =   \_ -> Just filePersist
 
 iorefqmap= unsafePerformIO  . newMVar $ M.empty
 
@@ -171,7 +173,7 @@ 
 type Flow= (Token -> Workflow IO ())
 
-data HttpData = HttpData Params [Cookie] ByteString | Error  ByteString deriving (Typeable, Show)
+data HttpData = HttpData [(SB.ByteString,SB.ByteString)]  [Cookie] ByteString | Error  ByteString deriving (Typeable, Show)
 
 
 --instance ToHttpData HttpData where
@@ -181,7 +183,7 @@ -- toHttpData bs= HttpData [] [] bs
 
 instance Monoid HttpData where
- mempty= HttpData [] [] empty
+ mempty= HttpData [] [] B.empty
  mappend (HttpData h c s) (HttpData h' c' s')= HttpData (h++h') (c++ c') $ mappend s s'
 
 -- | List of (wfname, workflow) pairs, to be scheduled depending on the message's pwfname
@@ -214,8 +216,7 @@     pind (Req x)= pind x   
     getParams (Req x)= getParams  x
 --    getServer (Req x)= getServer  x
---    getPath (Req x)= getPath  x
---    getPort (Req x)= getPort  x
+--    getPort (Req x)= getPort  x 
 
 data Resp  = Fragm HttpData
            | EndFragm HttpData
@@ -285,7 +286,7 @@       
 
 
--- | executes a simple monadic computation that receive the params and return a response
+-- | executes a simple request-response computation that receive the params and return a response
 --
 -- It is used with `addMessageFlows`
 --
@@ -324,6 +325,8 @@ -- | return the list of the scheduler
 getMessageFlows = readMVar _messageFlows
 
+delMessageFlow wfname= modifyMVar_ _messageFlows (\ms -> return $ M.delete wfname ms)
+
 --class ToHttpData a  where
 --    toHttpData :: a -> HttpData  
 
@@ -369,9 +372,9 @@ msgScheduler x  = do
   token <- getToken x
   let wfname = takeWhile (/='/') $ pwfname x
-  sendToMF token x
-  th <- startMessageFlow wfname token
-  r  <- recFromMF token                          -- !> let HttpData _ _ r1=r in unpack r1 
+  sendToMF token x                                 
+  th <- startMessageFlow wfname token     
+  r  <- recFromMF token                            --  !> let HttpData _ _ r1=r in unpack r1 
   return (r,th)
   where
   --start the flow if not started yet
@@ -394,23 +397,23 @@              
           Left (WFException e)-> do
               showError wfname token e
+              moveState wfname token token{tind= "error/"++tuser token}
               deleteTokenInList token                       -- !> "DELETETOKEN"
               
+              
           Right _ ->  delMsgHistory token >> return ()      -- !> ("finished " ++ wfname)
 
 
 
 showError wfname token@Token{..} e= do
-               let user= key token
                t <- return . calendarTimeToString =<< toCalendarTime =<< getClockTime
                let msg= errorMessage t e tuser (Prelude.concat $ intersperse "/" tpath) tenv
 
                logError  msg
---               moveState wfname token token{tuser= "error/"++tuser token}
                fresp <- getNotFoundResponse
                admin <- getAdminName
-               sendFlush token . Error $ fresp (user== admin)  $  Prelude.concat[ "<br/>"++ s | s <- lines msg]
-
+--               sendFlush token . Error $ fresp (tuser== admin)  $  Prelude.concat[ "<br/>"++ s | s <- lines msg]
+               sendFlush token . Error $ fresp True  $  Prelude.concat[ "<br/>"++ s | s <- lines msg]
 
 errorMessage t e u path env=
      "\n---------------------ERROR-------------------------\
@@ -418,7 +421,7 @@      e++
      "\n\nUSER= " ++ u ++
      "\n\nPATH= " ++ path ++
-     "\n\nREQUEST:\n\n"++
+     "\n\nREQUEST:\n\n" ++
      show env
 
 line= unsafePerformIO $ newMVar ()
@@ -440,10 +443,18 @@ 
 ------ USER MANAGEMENT -------
 
---instance Serialize a => Serializable a where
---  serialize=  runW . showp
---  deserialize=   runR readp
+data Auth = Auth{
+   uregister ::  UserStr -> PasswdStr -> (IO (Maybe String)),
+   uvalidate ::  UserStr -> PasswdStr -> (IO (Maybe String))}
 
+_authMethod= unsafePerformIO $ newIORef $ Auth tCacheRegister tCacheValidate
+
+-- | set an authentication method
+setAuthMethod auth= writeIORef _authMethod auth
+
+getAuthMethod = readIORef _authMethod
+
+
 data User= User
             { userName :: String
             , upassword :: String
@@ -460,39 +471,75 @@ -- | Return  the key name of an user
 keyUserName n= userPrefix++n
 
-instance Serialize a => Serializable a where
-  serialize= runW . showp
-  deserialize= runR  readp
-
+instance  Serializable User where
+  serialize=  B.pack . show
+  deserialize=   read . B.unpack
+  setPersist =   \_ -> Just filePersist
+  
 -- | Register an user/password 
-userRegister :: MonadIO m => String -> String  -> m (DBRef User)
-userRegister user password  = liftIO . atomically $ newDBRef $ User user password
+tCacheRegister ::  String -> String  -> IO (Maybe String)
+tCacheRegister user password  =  atomically $ do
+     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
+     $ withSTMResources [user]
+     $ \ mu -> case mu of
+         [Nothing] -> resources{toReturn= err }
+         [Just (User _ pass )] -> resources{toReturn= 
+               case pass==p  of
+                 True -> Nothing
+                 False -> err
+               }
 
+     where
+     err= Just  "Username or password invalid"
+
+userRegister u p= liftIO $ do
+   Auth reg _ <- getAuthMethod :: IO Auth
+   reg u p
+
+
+
+
 data Config = Config UserStr deriving (Read, Show, Typeable)
 
 keyConfig= "mflow.config"
 instance Indexable Config where key _= keyConfig
 rconf= getDBRef keyConfig
 
+instance  Serializable Config where
+  serialize=  B.pack . show
+  deserialize=   read . B.unpack
+  setPersist =   \_ -> Just filePersist
 
 type UserStr= String
 type PasswdStr= String
 
 setAdminUser :: MonadIO m => UserStr -> PasswdStr -> m ()
-setAdminUser user password= liftIO $  atomically $ do
-  newDBRef $ User user password
-  writeDBRef rconf $ Config user
+setAdminUser user password= liftIO $  do
+  userRegister user password
+  atomically $ writeDBRef rconf $ Config user
 
 getAdminName :: MonadIO m => m UserStr
-getAdminName= liftIO $ atomically ( readDBRef rconf `onNothing` error "admin user not set" ) >>= \(Config u) -> return u
+getAdminName=  liftIO  $ do
+     cu <- atomically $ readDBRef rconf
+     case cu of
+      Nothing -> setAdminUser "admin" "admin" >> getAdminName
+      Just (Config u) -> return u
 
 
 --------------- ERROR RESPONSES --------
 
 defNotFoundResponse isAdmin msg= fresp $
      case isAdmin of
-           True -> pack msg
+           True -> B.pack msg
            _    -> "The administrator has been notified"
   where
   fresp msg=
@@ -529,11 +576,11 @@ -- | Writes a XML tag in a ByteString. It is the most basic form of formatting. For
 -- more sophisticated formatting , use "MFlow.Forms.XHtml" or "MFlow.Forms.HSP".
 btag :: String -> Attribs  -> ByteString -> ByteString
-btag t rs v= "<" `append` pt `append` attrs rs `append` ">" `append` v `append`"</"`append` pt `append` ">"
+btag t rs v= "<" <> pt <> attrs rs <> ">" <> v <> "</" <> pt <> ">"
  where
- pt= pack t
+ pt= B.pack t
  attrs []= B.empty
- attrs rs=  pack $ concatMap(\(n,v) -> (' ' :   n) ++ "=\"" ++ v++ "\"" ) rs
+ attrs rs=  B.pack $ concatMap(\(n,v) -> (' ' :   n) ++ "=\"" ++ v++ "\"" ) rs
 
 -- |
 -- > bhtml ats v= btag "html" ats v
@@ -548,7 +595,7 @@ 
 addAttrs :: ByteString -> Attribs -> ByteString
 addAttrs (Chunk "<" (Chunk tag rest)) rs=
-   Chunk "<"(Chunk tag  (pack $ concatMap(\(n,v) -> (' ' :   n) ++ "=" ++  v ) rs))  <> rest
+   Chunk "<"(Chunk tag  (B.pack $ concatMap(\(n,v) -> (' ' :   n) ++ "=" ++  v ) rs))  <> rest
 
 addAttrs other _ = error  $ "addAttrs: byteString is not a tag: " ++ show other
 
@@ -594,6 +641,10 @@ instance Indexable NFlow where
   key _= "Flow"
 
+instance  Serializable NFlow where
+  serialize=  B.pack . show
+  deserialize=   read . B.unpack
+  setPersist =   \_ -> Just filePersist
 
 rflow= getDBRef . key $ NFlow undefined
 
@@ -602,7 +653,7 @@         atomically $ do 
                     NFlow n <- readDBRef rflow `onNothing` return (NFlow 0)
                     writeDBRef rflow . NFlow $ n+1
-                    return . show $ t + n
+                    return . SB.pack . show $ t + n
 
 
 mimeTable=[

@@ -1,7 +1,7 @@ {-# OPTIONS -XScopedTypeVariables  -XOverloadedStrings #-}  module MFlow.Cookies-(Cookie,contentHtml,urlDecode,cookieuser,cookieHeaders,getCookies)+(Cookie,contentHtml,cookieuser,cookieHeaders,getCookies) where import Control.Monad(MonadPlus(..), guard, replicateM_, when) import Data.Char@@ -14,29 +14,31 @@ import Data.Monoid import Text.Parsec import Control.Monad.Identity+import Data.ByteString.Char8 as B  --import Debug.Trace --(!>)= flip trace +contentHtml :: (ByteString, ByteString) contentHtml= ("Content-Type", "text/html") -type Cookie=  (String,String,String,Maybe String)+type Cookie=  (B.ByteString,B.ByteString,B.ByteString,Maybe B.ByteString)  cookieuser :: String cookieuser= "cookieuser" ---getCookies :: Params -> Params+ getCookies httpreq=      case  lookup "Cookie" $ httpreq of-             Just str  -> splitCookies str+             Just str  -> splitCookies str :: [(B.ByteString, B.ByteString)]              Nothing   -> []  cookieHeaders cs =  Prelude.map (\c-> ( "Set-Cookie", showCookie c)) cs -showCookie ::  Cookie -> String-showCookie (n,v,p,me) = n <> "="  <> v  <>-                       ";path="  <> p  <>-                        showMaxAge me+showCookie ::  Cookie -> B.ByteString+showCookie (n,v,p,me) =  n <> "="  <>  v  <>+                       ";path="  <>  p  <>+                        showMaxAge  me      where     showMaxAge Nothing =  ""
@@ -60,17 +62,17 @@  splitCookies cookies  = f cookies []  
     where
-    f s r | null s  = r
+    f s r | B.null s  = r
     f xs0 r =
       let-          xs   = dropWhile (==' ') xs0
-          name = takeWhile (/='=') xs
-          xs1  = dropWhile (/='=') xs
-          xs2  = dropWhile (=='=') xs1
-          val  = takeWhile (/=';') xs2
-          xs3  = dropWhile (/=';') xs2
-          xs4  = dropWhile (==';') xs3
-          xs5  = dropWhile (==' ') xs4
+          xs   = B.dropWhile (==' ') xs0
+          name = B.takeWhile (/='=') xs
+          xs1  = B.dropWhile (/='=') xs
+          xs2  = B.dropWhile (=='=') xs1
+          val  = B.takeWhile (/=';') xs2
+          xs3  = B.dropWhile (/=';') xs2
+          xs4  = B.dropWhile (==';') xs3
+          xs5  = B.dropWhile (==' ') xs4
       in  f xs5 ((name,val):r)  -----------------------------@@ -207,7 +209,7 @@ --         toInt d                = error ("hex2int: illegal hex digit " ++ [d])

  --urlDecode :: String -> [([(String, String)],String)]-urlDecode str= case parse readEnv "" str of  -- let Parser p= readEnv in  p str-                     Left err  -> error $ "urlDecode: decode  error: " ++ show err-                     Right r  ->   r+--urlDecode str= case parse readEnv "" str of  -- let Parser p= readEnv in  p str+--                     Left err  -> error $ "urlDecode: decode  error: " ++ show err+--                     Right r  ->   r --               !> ("decode="++str)

@@ -111,15 +111,19 @@ be combined as such.  * NEW IN THIS RELEASE+[@Runtime templates@]  'template', 'edTemplate', 'witerate' and 'dField' permit the edition of+the widget content at runtime, and the management of placeholders with input fields and data fields+within the template with no navigation in the client, little bandwidth usage and little server load. Enven less+than using 'autoRefresh'. +* IN PREVIOUS RELEASES -{@Auto-Refresh@] Using `autoRefresh`, Dynamic widgets can refresh themselves with new information without forcing a refresh of the whole page+{@AutoRefresh@] Using `autoRefresh`, Dynamic widgets can refresh themselves with new information without forcing a refresh of the whole page  [@Push@]  With `push` a widget can push new content to the browser when something in the server happens  [@Error traces@] using the monadloc package, now each runtime error (in a monadic statement) has a complete execution trace. -* IN PREVIOUS RELEASES  [@RESTful URLs@] Now each page is directly reachable by means of a intuitive, RESTful url, whose path is composed by the sucession of links clicked to reach such page and such point in the procedure. Just what you would expect.@@ -200,11 +204,11 @@ FlowM, View(..), FormElm(..), FormInput(..) 
 -- * Users 
-,userRegister, userValidate, isLogged, setAdminUser, getAdminName
-,getCurrentUser,getUserSimple, getUser, userFormLine, userLogin,logout, userWidget,getLang, login,+, Auth(..), userRegister, setAuthMethod, userValidate, isLogged, setAdminUser, getAdminName
+,getCurrentUser,getUserSimple, getUser, userFormLine, userLogin,logout, userWidget, login, userName,
 -- * User interaction 
-ask, page, askt, clearEnv, wstateless, transfer, pageFlow, 
+ask, page, askt, clearEnv, wstateless, pageFlow,  
 -- * formLets 
 -- | They usually produce the HTML form elements (depending on the FormInput instance used) -- It is possible to modify their attributes with the `<!` operator.@@ -214,9 +218,9 @@ getString,getInt,getInteger, getTextBox 
 ,getMultilineText,getBool,getSelect, setOption,setSelectedOption, getPassword, getRadio, setRadio, setRadioActive, wlabel, getCheckBoxes, genCheckBoxes, setCheckBox,-submitButton,resetButton, whidden, wlink, returning, wform, firstOf, manyOf, wraw, wrender, notValid+submitButton,resetButton, whidden, wlink, getRestParam, returning, wform, firstOf, manyOf, wraw, wrender, notValid -- * FormLet modifiers-,validate, noWidget, waction, wcallback, wmodify,+,validate, noWidget, waction, wcallback, clear, wmodify,  -- * Caching widgets cachedWidget, wcached, wfreeze,@@ -245,10 +249,10 @@ ,flatten, normalize 
 -- * Running the flow monad
-,runFlow, transientNav,runFlowOnce,runFlowIn+,runFlow, transientNav, runFlowOnce, runFlowIn ,runFlowConf,MFlow.Forms.Internals.step -- * controlling backtracking-,goingBack,returnIfForward, breturn, preventGoingBack+,goingBack,returnIfForward, breturn, preventGoingBack, retry 
 -- * Setting parameters
 ,setHeader@@ -270,7 +274,9 @@ ,WebRequirement(..) ,requires -- * Utility+,getLang ,genNewId+,getNextId ,changeMonad ,FailBack ,fromFailBack@@ -284,9 +290,11 @@ import Data.TCache import Data.TCache.Memoization
 import MFlow-import MFlow.Forms.Internals
+import MFlow.Forms.Internals 
 import MFlow.Cookies-import Data.ByteString.Lazy.Char8 as B(ByteString,cons,pack,unpack,append,empty,fromChunks) 
+import Data.ByteString.Lazy.Char8 as B(ByteString,cons,pack,unpack,append,empty,fromChunks)+import qualified Data.Text as T+import Data.Text.Encoding
 import Data.List --import qualified Data.CaseInsensitive as CI
 import Data.Typeable
@@ -316,7 +324,7 @@      -> (a -> WState view m (Maybe view))      -> View view m a
 validate  formt val= View $ do
-   FormElm form mx <- (runView  formt)  
+   FormElm form mx <- runView  formt
    case mx of
     Just x -> do
       me <- val x@@ -414,15 +422,6 @@           ( isValidated mn  && v== fromValidated mn) (Just  "this.form.submit()")]           (fmap Radio $ valToMaybe mn) -valToMaybe (Validated x)= Just x-valToMaybe _= Nothing--isValidated (Validated x)= True-isValidated _= False--fromValidated (Validated x)= x-fromValidated NoParam= error $ "fromValidated : NoParam"-fromValidated (NotValidated s err)= error $ "fromValidated: NotValidated "++ s 
 -- | Implement a radio button -- the parameter is the name of the radio group@@ -567,25 +566,26 @@        
  -getCurrentName :: MonadState (MFlowState view) m =>  m String-getCurrentName= do-     st <- get-     let parm = mfSequence st-     return $ "p"++show parm+--getCurrentName :: MonadState (MFlowState view) m =>  m String+--getCurrentName= do+--     st <- get+--     let parm = mfSequence st+--     return $ "p"++show parm   -- | Display a multiline text box and return its content-getMultilineText :: (FormInput view,
-      Monad m) =>
-      String ->  View view m String
+getMultilineText :: (FormInput view
+                 ,  Monad m)
+                   => T.Text+                 ->  View view m T.Text
 getMultilineText nvalue = View $ do
     tolook <- genNewId     env <- gets mfEnv     r <- getParam1 tolook env     case r of-       Validated x        -> return $ FormElm [ftextarea tolook  (show x) ] $ Just x-       NotValidated s err -> return $ FormElm [ftextarea tolook  s ] $ Nothing-       NoParam            -> return $ FormElm [ftextarea tolook  nvalue ] $ Nothing
+       Validated x        -> return $ FormElm [ftextarea tolook  x] $ Just x+       NotValidated s err -> return $ FormElm [ftextarea tolook  (T.pack s)]  Nothing+       NoParam            -> return $ FormElm [ftextarea tolook  nvalue]  Nothing
 
       
 --instance  (MonadIO m, Functor m, FormInput view) => FormLet Bool m view where
@@ -820,6 +820,12 @@      back <- goingBack      if back then noWidget else return x +-- | forces backtracking if the widget validates, because a previous page handle this widget response+-- . This is useful for recurrent cached widgets that are present in multiple pages. For example+-- in the case of menus or common options. The active elements of this widget must be cached with no timeout.+retry :: Monad m => View v m a -> View v m ()+retry w=  w >> modify (\st -> st{inSync=False})+ -- | It creates a widget for user login\/registering. If a user name is specified -- in the first parameter, it is forced to login\/password as this specific user. -- If this user was already logged, the widget return the user without asking.@@ -868,31 +874,32 @@   login uname= do--- st <- get--- let t = mfToken st---     u = tuser t--- if u == uname then return () else do---     let t'= t{tuser= uname}---     moveState (twfname t) t t'---     put st{mfToken= t'}---     liftIO $ deleteTokenInList t---     liftIO $ addTokenToList t'-     setCookie cookieuser   uname "/"  (Just $ 365*24*60*60) 
---+    back <- goingBack+    if back then return () else do+     st <- get+     let t = mfToken st+         u = tuser t+     if u == uname then return () else do+         let t'= t{tuser= uname}+    --     moveState (twfname t) t t'+         put st{mfToken= t'}+--         liftIO $ deleteTokenInList t+         liftIO $ addTokenToList t'+         setCookie cookieuser   uname "/"  (Just $ 365*24*60*60)  -- | logout. The user is reset to the `anonymous` user logout :: (MonadIO m, MonadState (MFlowState view) m) => m ()
 logout= do---     st <- get---     let t = mfToken st---         t'= t{tuser= anonymous}---     if tuser t == anonymous then return () else do+    back <- goingBack+    if back then return () else do+     st <- get+     let t = mfToken st+         t'= t{tuser= anonymous}+     if tuser t == anonymous then return () else do --         moveState (twfname t) t t'---         put st{mfToken= t'}+         put st{mfToken= t'} --         liftIO $ deleteTokenInList t---         liftIO $ addTokenToList t'+         liftIO $ addTokenToList t'          setCookie cookieuser   anonymous "/" (Just $ -1000) 
 -- | If not logged, perform login. otherwise return the user@@ -918,20 +925,9 @@ -- | Authentication against `userRegister`ed users.
 -- to be used with `validate`
 userValidate :: (FormInput view,MonadIO m) => (UserStr,PasswdStr) -> m (Maybe view)
-userValidate (u,p) =
-    let user= eUser{userName=u}
-    in liftIO $ atomically
-     $ withSTMResources [user]
-     $ \ mu -> case mu of
-         [Nothing] -> resources{toReturn= err }
-         [Just (User _ pass )] -> resources{toReturn= 
-               case pass==p  of
-                 True -> Nothing
-                 False -> err
-               }
-
-     where
-     err= Just . fromStr $ "Username or password invalid"
+userValidate (u,p) = liftIO $  do+   Auth _ val <- getAuthMethod+   val u p >>= return .  fmap  fromStr
 
 -- | Join two widgets in the same page
 -- the resulting widget, when `ask`ed with it, return a 2 tuple of their validation results
@@ -1017,16 +1013,16 @@ -- -- 'ask' also synchronizes the execution of the flow with the user page navigation by --- * Backtracking (invoking previous 'ask' staement in the flow) when detecting mismatches between get and post parameters and what is expected by the widgets
+-- * Backtracking (invoking previous 'ask' staement in the flow) when detecting mismatches between+-- get and post parameters and what is expected by the widgets
 -- until a total or partial match is found. ----- * Advancing in the flow by mathing a single requests with one or more sucessive ask statements+-- * Advancing in the flow by matching a single requests with one or more sucessive ask statements -- -- Backtracking and advancing can occur in a single request, so the flow in any state can reach any--- other state in the flow if the request satisfy the parameters required.-ask-  :: (FormInput view) =>-      View view IO a -> FlowM view IO a
+-- 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  st1 <- get  if not . null $ mfTrace st1 then fail "" else do@@ -1043,7 +1039,7 @@   -- END AJAX     _ ->   do-     let st= st1{needForm= False, inSync= False, mfRequirements= [],linkMatched=False} 
+     let st= st1{needForm= False, inSync= False, mfRequirements= [], linkMatched= False} 
      put st       FormElm forms mx <- FlowM . lift  $ runView  w@@ -1051,18 +1047,16 @@      st' <- get      if notSyncInAction st' then put st'{notSyncInAction=False}>> ask w -       else       case mx  of
        Just x -> do-         put st'{newAsk= True  , mfEnv=[]+         put st'{newAsk= True, mfEnv=[]                 ,mfPageIndex=Nothing                 ,mfPIndex= case isJust $ mfPageIndex st' of                             True -> length (mfPath st') -1                             False -> mfPIndex st'          }--         breturn x                                       -- !> "RETURN"+         breturn x                                        -- !> "RETURN" 
        Nothing ->          if  not (inSync st')  && not (newAsk st')@@ -1078,20 +1072,19 @@           else if mfAutorefresh st' then do                      resetState st st'                      FlowM (lift  nextMessage)-                     ask w                              --  !> "EN AUTOREFRESH"+                     ask w                                -- !> "EN AUTOREFRESH"           else do              reqs <-  FlowM $ lift installAllRequirements     -- !> "REPEAT"              let header= mfHeader st'                  t= mfToken st'              cont <- case (needForm st') of                       True ->  do-                               frm <- formPrefix (mfPIndex st') (twfname t ) st' forms False-                               return . header $  reqs <> frm+                              frm <- formPrefix (mfPIndex st') (twfname t ) st' forms False+                              return . header $  reqs <> frm                       _    ->  return . header $  reqs <> mconcat  forms               let HttpData ctype c s= toHttpData cont 
-             liftIO . sendFlush t $ HttpData (ctype++mfHttpHeaders st') (mfCookies st' ++ c) s-+             liftIO . sendFlush t $ HttpData (ctype ++ mfHttpHeaders st') (mfCookies st' ++ c) s               resetState st st'              
 @@ -1105,7 +1098,8 @@                    ,mfToken= mfToken st'                    ,mfPageIndex= mfPageIndex st'                    ,mfAjax= mfAjax st'-                   ,mfSeqCache= mfSeqCache st' }+                   ,mfSeqCache= mfSeqCache st'+                   ,mfData= mfData st' }   -- | A synonym of ask.@@ -1115,16 +1109,7 @@ page   :: (FormInput view) =>       View view IO a -> FlowM view IO a-page= ask-----
-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+page= ask
 
 nextMessage :: MonadIO m => WState view m ()
 nextMessage= do
@@ -1137,20 +1122,30 @@          env=   updateParams inPageFlow (mfEnv st) req          npath= pwfPath msg          path=  mfPath st-         inPageFlow= isJust $ mfPageIndex st  
+         inPageFlow= case (comparep,mfPageIndex st) of+                    (n, Just n') -> if n < n' then Nothing   else Just n'+                    _ -> Nothing+         comparep= comparePaths (mfPIndex st) 1 (tail path) (tail npath)
      put st{ mfPath= npath-           , mfPIndex= case mfPageIndex st of+           , mfPIndex= case inPageFlow of                          Just n -> n-                         Nothing ->-                             comparePaths (mfPIndex st) 1 (tail path) (tail npath)---           , mfPageIndex= Nothing+                         Nothing -> comparep++           , mfPageIndex= inPageFlow+           , mfLinks= if isNothing inPageFlow then M.empty else mfLinks st            , mfEnv= env }                        -- !> show req        where-     updateParams :: Bool -> Params -> Params -> Params-     updateParams False _ req= req-     updateParams True env req=++     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 :: Maybe Int -> Params -> Params -> Params+     updateParams Nothing _ req= req+     updateParams (Just _) env req=         let params= takeWhile isparam env             fs= fst $ head req             parms= (case findIndex (\p -> fst p == fs)  params of@@ -1172,14 +1167,14 @@ -- higuer level form of the latter 
 wstateless   :: (Typeable view,  FormInput view) =>-     View view IO a -> Flow-wstateless w = transient $ runFlow loop-  where-  loop= do-      ask w-      env <- get-      put $ env{ mfSequence= 0} 
-      loop+     View view IO () -> Flow+wstateless w = transient . runFlow . ask $ w **> noWidget -- loop+--  where+--  loop= do+--      ask w+--      env <- get+--      put $ env{ mfSequence= 0} 
+--      loop   ---- This version writes a log with all the values returned by ask@@ -1196,22 +1191,14 @@ --         return r
 --      loop 
--- | transfer control to another flow.-transfer :: MonadIO m => String -> FlowM v m ()-transfer flowname =do-         t <- gets mfToken-         let t'= t{twfname= flowname}-         liftIO  $ do-             (r,_) <- msgScheduler t'-             sendFlush t r + 
 -- | Wrap a widget with form element within a form-action element. -- Usually this is not necessary since this wrapping is done automatically by the @Wiew@ monad, unless -- 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@@ -1243,7 +1230,7 @@ -- >          ++> getInt (Just 0) <! [("id","text1"),("onclick", ajaxc elemval)] ajax :: (MonadIO m)      => (String ->  View v m ByteString)  -- ^ user defined procedure, executed in the server.Receives the value of the javascript expression and must return another javascript expression that will be executed in the web browser-     ->  View v m (String -> String)      -- ^ returns a function that accept a javascript expression and return a javascript event handler expression that invoques the ajax server procedure+     ->  View v m (String -> String)      -- ^ returns a function that accept a javascript expression and return a javascript event handler expression that invokes the ajax server procedure ajax  f =  do      requires[JScript ajaxScript]      t <- gets mfToken@@ -1299,7 +1286,24 @@ --                       True  -> s{mfSeqCache= mfSeqCache s -1} --                       False -> s{mfSequence= mfSequence s -1}    ftag "label" str `attrs` [("for",id)] ++> w <! [("id",id)]-    
++getRestParam :: (Read a, Typeable a,Monad m,Functor m, FormInput v) => FlowM v m (Maybe a)+getRestParam= do+   st <- get+   let lpath = mfPath st+   let index' = mfPIndex st+                 + if linkMatched st then -1 else 0+                 + if Just (mfPIndex st)== mfPageIndex st then 1 else 0+       index = if index'== 0 then 1 else index'++   case  index < length lpath  of+             True -> do+                  modify $ \s -> s{inSync= True+                                 ,linkMatched= True, mfPIndex= index+1 }  -- !> (name ++ "<-" ++show index++ " MATCHED")+                  fmap valToMaybe $ readParam $ lpath !! index+             False ->  return Nothing++   
 -- | Creates a link wiget. A link can be composed with other widget elements,
 wlink :: (Typeable a, Show a, MonadIO m,  FormInput view) 
          => a -> view -> View  view m a
@@ -1325,7 +1329,7 @@           toSend = flink path v  -      r <- if linkMatched st then return Nothing+      r <- if linkMatched st then return Nothing -- only a link match per page or monadic sentence in page            else            if isJust $ mfPageIndex st -- !> (show $ mfPageIndex st)              then@@ -1338,7 +1342,7 @@                      modify $ \st -> st{ inSync= True,linkMatched= True                                       , mfPIndex= index + 1                                       , mfLinks= M.insert name (n-1) $ mfLinks st}-                                            -- !> (name ++" "++ show n ++ " Match")+                                           -- !> (name ++" "++ show n ++ " Match")                      return $ Just x                  Nothing -> return Nothing  -- !> (name ++ " 0 Fail")              else@@ -1347,21 +1351,22 @@                   modify $ \s -> s{inSync= True                                  ,linkMatched= True, mfPIndex= index+1 }  -- !> (name ++ "<-" ++show index++ " MATCHED")                   return $ Just x-             False ->  return Nothing                                        -- !> (name++"<-" ++show index++ " "++(if index < length lpath then lpath !! index else ""))+             False ->  return Nothing                                      -- !> ( "NOT MATCHED "++name++"<-" ++show index++ " "++(if index < length lpath then lpath !! index else ""))        return $ FormElm [toSend] r
    --- | When some user interface int return some response to the server, but it is not produced by--- a form or a link, but for example by an script, @returning@ notify the type checker.+-- | 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. -- -- At runtime the parameter is read from the environment and validated. -- -- . The parameter is the visualization code, that accept a serialization function that generate -- the server invocation string, used by the visualization to return the value by means--- of a link or a @window.location@ statement in javasCript
+-- of an script, usually.
 returning :: (Typeable a, Read a, Show a,Monad m, FormInput view) 
          => ((a->String) ->view) -> View view m a returning expr=View $ do@@ -1402,31 +1407,27 @@ manyOf :: (FormInput view, MonadIO m, Functor m)=> [View view m a]  -> View view m [a]
 manyOf xs= whidden () *> (View $ do 
       forms <- mapM runView  xs
-      let vs  = concatMap (\(FormElm v _) ->  [mconcat v]) forms-          
-          res1= catMaybes $ map (\(FormElm _ r) -> r) forms--       
-      return $ FormElm  vs $  Just res1)-+      let vs  = concatMap (\(FormElm v _) ->  [mconcat v]) forms
+          res1= catMaybes $ map (\(FormElm _ r) -> r) forms
+      return . FormElm vs $  Just res1) -(>:>) :: (Monad m)=> View v m a -> View v m [a]  -> View v m [a]-(>:>) w ws= View $ do+(>:>) :: Monad m => View v m a -> View v m [a]  -> View v m [a]+(>:>) w ws = View $ do     FormElm fs mxs <- runView $  ws     FormElm f1 mx  <- runView w     return $ FormElm (f1++ fs)          $ case( mx,mxs) of              (Just x, Just xs) -> Just $ x:xs-             (Nothing, mxs) -> mxs-             (Just x, _) -> Just [x]+             (Nothing, mxs)    -> mxs+             (Just x, _)       -> Just [x]  -- | Intersperse a widget in a list of widgets. the results is a 2-tuple of both types. -- -- it has a infix priority @infixr 5@ (|*>) :: (MonadIO m, Functor m,Monoid view)             => View view m r-            -> [View view m r']-            -> View view m (Maybe r,Maybe r')+           -> [View view m r']+           -> View view m (Maybe r,Maybe r') (|*>) x xs= View $ do   FormElm fxs rxs <-  runView $ firstOf  xs   FormElm fx rx   <- runView $  x@@ -1558,7 +1559,7 @@     inred = btag "b" [("style", "color:red")]     finput n t v f c= btag "input"  ([("type", t) ,("name", n),("value",  v)] ++ if f then [("checked","true")]  else []                               ++ case c of Just s ->[( "onclick", s)]; _ -> [] ) ""-    ftextarea name text= btag "textarea"  [("name", name)]   $ pack text+    ftextarea name text= btag "textarea"  [("name", name)]   $ fromChunks [encodeUtf8 text]      fselect name   options=  btag "select" [("name", name)]   options @@ -1577,11 +1578,10 @@  ------ page Flows ---- --- | prepares the state for a page flow. A page flow is a dynamic page which changes his rendering by executing--- a monadic computation with widgets that are validated depending on the user responses.--- It initiates the creation of a well known sequence of identifiers for the formlets and also--- keep the state of the previous form submissions within the page.--- If the computation has branches   @if@ @case@ etc, each branch must have its pageFlow with a distinct identifier+-- | prepares the state for a page flow.+-- It add a prefix to every form element or link identifier for the formlets and also+-- keep the state of the links clicked and form imput entered within the widget.+-- If the computation within the widget has branches  @if@ @case@ etc, each branch must have its pageFlow with a distinct identifier -- -- See "http://haskell-web.blogspot.com.es/2013/06/the-promising-land-of-monadic-formlets.html" pageFlow

@@ -20,7 +20,7 @@              -XGeneralizedNewtypeDeriving
              -XFlexibleContexts
              -XOverlappingInstances
-             -XRecordWildCards+             -XRecordWildCards
              -XTemplateHaskell
 #-}
 
@@ -31,7 +31,8 @@ import Data.Monoid
 import Control.Monad.Trans
 import Control.Monad.State
-import Data.ByteString.Lazy.Char8 as B(ByteString,cons,pack,unpack,append,empty,fromChunks)
+import qualified Data.ByteString.Lazy.Char8 as B
+import qualified Data.ByteString.Char8 as SB
 import Data.Typeable
 import Data.RefSerialize hiding((<|>))
 import Data.TCache
@@ -45,45 +46,46 @@ import Control.Monad.Identity
 import Data.List
 import System.IO.Unsafe
-import Control.Concurrent.MVar-import Control.Workflow(WFErrors(Timeout))
+import Control.Concurrent.MVar
+import qualified Data.Text as T
+
 --
 ---- for traces
-----import Control.Exception as CE(catch,SomeException,AsyncException,throw,fromException)-import Control.Concurrent-import Control.Monad.Loc
 --
---import Debug.Trace
---(!>) =    flip trace
 
+import Control.Exception as CE
+import Control.Concurrent
+import Control.Monad.Loc
 
+import Debug.Trace
+(!>) = flip trace
+
+
 data FailBack a = BackPoint a | NoBack a | GoBack   deriving (Show,Typeable)
 
 
 instance (Serialize a) => Serialize (FailBack a ) where
-   showp (BackPoint x)= insertString (pack iCanFailBack) >> showp x
-   showp (NoBack x)= insertString (pack noFailBack) >> showp x
-   showp GoBack = insertString (pack repeatPlease)
+   showp (BackPoint x)= insertString (B.pack iCanFailBack) >> showp x
+   showp (NoBack x)   = insertString (B.pack noFailBack) >> showp x
+   showp GoBack       = insertString (B.pack repeatPlease)
 
    readp = choice [icanFailBackp,repeatPleasep,noFailBackp]
     where
-    noFailBackp   = {-# SCC "deserialNoBack" #-} symbol noFailBack >> readp >>= return . NoBack
-    icanFailBackp = {-# SCC "deserialBackPoint" #-} symbol iCanFailBack >> readp >>= return . BackPoint
-    repeatPleasep = {-# SCC "deserialbackPlease" #-}  symbol repeatPlease  >> return  GoBack
+    noFailBackp   = symbol noFailBack >> readp >>= return . NoBack      
+    icanFailBackp = symbol iCanFailBack >> readp >>= return . BackPoint 
+    repeatPleasep = symbol repeatPlease  >> return  GoBack          
 
 iCanFailBack= "B"
 repeatPlease= "G"
 noFailBack= "N"
 
 newtype Sup m a = Sup { runSup :: m (FailBack a ) }
-+
 class MonadState s m => Supervise s m where
-   supBack     :: s -> m ()-   supBack = const $ return ()+   supBack     :: s -> m ()
+   supBack = const $ return ()
    
-   supervise ::    m (FailBack a) -> m (FailBack a)+   supervise ::    m (FailBack a) -> m (FailBack a)
    supervise= id
 
 --instance Monad m => Supervise () m where
@@ -109,9 +111,18 @@ 
 fromFailBack (NoBack  x)   = x
 fromFailBack (BackPoint  x)= x
-
 toFailBack x= NoBack 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
+--runFlowM= runView
+
 {-# NOINLINE breturn  #-}
 
 -- | Use this instead of return to return from a computation with ask statements
@@ -153,143 +164,134 @@    readp= readp >>= \x -> return $ FormElm  [] 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.------ Things to know about these instances:------   If the View expression does not validate, ask will present the page again.------ /Alternative instance/: Both alternatives are executed. The rest is as usual------ /Monad Instance/:------  The rendering of each statement is added to the previous. If you want to avoid this, use 'wcallback'------  The execution is stopped when the statement has a formlet-widget that does not validate.------  The monadic code is executed from the beginning each time the page is presented or refreshed------  use 'pageFlow' if your page has more than one monadic computation with dynamic behaviour------ use 'pageFlow' to identify each subflow branch of a conditional------  For example:------  > pageFlow "myid" $ do---  >      r <- formlet1---  >      liftIO $ ioaction1 r---  >      s <- formlet2---  >      liftIO $ ioaction2 s---  >      case s of---  >       True  -> pageFlow "idtrue" $ do ....---  >       False -> paeFlow "idfalse" $ do ...---  >      ...------  Here if  @formlet2@ do not validate, @ioaction2@ is not executed. But if @formLet1@ validates and the---  page is refreshed two times (because @formlet2@ has failed, see above),then @ioaction1@ is executed two times.-+--
+-- It has 'Applicative', 'Alternative' and 'Monad' instances.
+--
+-- Things to know about these instances:
+--
+--   If the View expression does not validate, ask will present the page again.
+--
+-- /Alternative instance/: Both alternatives are executed. The rest is as usual
+--
+-- /Monad Instance/:
+--
+--  The rendering of each statement is added to the previous. If you want to avoid this, use 'wcallback'
+--
+--  The execution is stopped when the statement has a formlet-widget that does not validate and
+-- return an invalid response (So it will present the page again if no other widget in the expression validates).
+--
+--  The monadic code is executed from the beginning each time the page is presented or refreshed
+--
+--  use 'pageFlow' if your page has more than one monadic computation with dynamic behaviour
+--
+-- use 'pageFlow' to identify each subflow branch of a conditional
+--
+--  For example:
+--
+--  > pageFlow "myid" $ do
+--  >      r <- formlet1
+--  >      liftIO $ ioaction1 r
+--  >      s <- formlet2
+--  >      liftIO $ ioaction2 s
+--  >      case s of
+--  >       True  -> pageFlow "idtrue" $ do ....
+--  >       False -> paeFlow "idfalse" $ do ...
+--  >      ...
+--
+--  Here if  @formlet2@ do not validate, @ioaction2@ is not executed. But if @formLet1@ validates and the
+--  page is refreshed two times (because @formlet2@ has failed, see above),then @ioaction1@ is executed two times.
+--  use 'cachedByKey' if you want to avoid repeated IO executions.
 newtype View v m a = View { runView :: WState v m (FormElm v a)}
- 
+
 instance  Monad m => Supervise (MFlowState v) (WState v m) where
    supBack st= do
       MFlowState{..} <- get
-      put  st{ mfEnv= mfEnv,mfToken=mfToken-                    , mfPath=mfPath,mfPIndex= mfPIndex-                    , mfData=mfData-                    , mfTrace= mfTrace-                    , inSync=False,newAsk=False}+      put st{ mfEnv= mfEnv,mfToken=mfToken
+            , mfPath=mfPath,mfPIndex= mfPIndex
+            , mfData=mfData
+            , mfTrace= mfTrace
+            , inSync=False,newAsk=False}
 
 
----instance  CMT.MonadCatchIO (FlowM v IO) where---    catch f hand = FlowM . Sup $ do---            s <- get+
+--instance  CMT.MonadCatchIO (FlowM v IO) where
+--    catch f hand = FlowM . Sup $ do
+--            s <- get
 --            (r,s') <- lift $ execMF f s  `CE.catch` \e -> execMF (hand e) s
------            put s'---            return r---            where---            execMF f s= runStateT (runSup (runFlowM f) ) s--+--
+--            put s'
+--            return r
+--            where
+--            execMF f s= runStateT (runSup (runFlowM f) ) s
 
----instance  MonadLoc (FlowM v IO) where-    withLoc loc f = FlowM . Sup $ do-       withLoc loc $ do-            s <- get-            (r,s') <- lift $ do-                       rs@(r,s') <- runStateT (runSup (runFlowM f) ) s+
+
+instance  MonadLoc (FlowM v IO) where
+    withLoc loc f = FlowM . Sup $ do
+       withLoc loc $ do
+            s <- get
+            (r,s') <- lift $ do
+                       rs@(r,s') <- runStateT (runSup (runFlowM f) ) s
                                           `CE.catch` (handler1  loc s)
-                       case mfTrace s' of-                            []    ->  return rs-                            trace ->  return(r, s'{mfTrace= loc:trace})-            put s'-            return r-+                       case mfTrace s' of
+                            []    ->  return rs
+                            trace ->  return(r, s'{mfTrace= loc:trace})
+            put s'
+            return r
+
        where
-       handler1 loc s (e :: SomeException)= do-        case CE.fromException e :: Maybe WFErrors of-           Just e  -> CE.throw e     -- !> ("TROWNF=" ++ show e)-           Nothing ->-             case CE.fromException e :: Maybe AsyncException of-                Just e -> CE.throw e -- !> ("TROWN ASYNCF=" ++ show e)-                Nothing ->-                 return (GoBack, s{mfTrace= [show e]})-----instance (Serialize a,Typeable a, FormInput v) => MonadLoc (FlowM v (Workflow IO)) a where---    withLoc loc f =  FlowM . Sup $---       withLoc loc $  do---            s <- get---            (r,s') <-  lift . WF.step $ exec1d "jkkjk" ( runStateT (runSup $ runFlowM f) s) `CMT.catch` (handler1  loc s)---            put s'---            return r---+       handler1 loc s (e :: SomeException)= do
+        case CE.fromException e :: Maybe WFErrors of
+           Just e  -> CE.throw e     -- !> ("TROWNF=" ++ show e)
+           Nothing ->
+             case CE.fromException e :: Maybe AsyncException of
+                Just e -> CE.throw e -- !> ("TROWN ASYNCF=" ++ show e)
+                Nothing ->
+                 return (GoBack, s{mfTrace= [show e]})
+
+
+--instance (Serialize a,Typeable a, FormInput v) => MonadLoc (FlowM v (Workflow IO)) a where
+--    withLoc loc f =  FlowM . Sup $
+--       withLoc loc $  do
+--            s <- get
+--            (r,s') <-  lift . WF.step $ exec1d "jkkjk" ( runStateT (runSup $ runFlowM f) s) `CMT.catch` (handler1  loc s)
+--            put s'
+--            return r
+--
 --       where
---       handler1 loc s (e :: SomeException)=+--       handler1 loc s (e :: SomeException)=
 --        return (GoBack, s{mfTrace= Just ["exception: " ++show e]}) 
--instance  MonadLoc (View v IO)  where-    withLoc loc f = View $ do-       withLoc loc $ do-            s <- get-            (r,s') <- lift $ do-                       rs@(r,s') <- runStateT (runView f) s+
+instance  MonadLoc (View v IO)  where
+    withLoc loc f = View $ do
+       withLoc loc $ do
+            s <- get
+            (r,s') <- lift $ do
+                       rs@(r,s') <- runStateT (runView f) s
                                              `CE.catch` (handler1  loc s)
-                       case mfTrace s' of-                            []     ->  return rs-                            trace  ->  return(r, s'{mfTrace=  loc:trace})-            put s'-            return r-+                       case mfTrace s' of
+                            []     ->  return rs
+                            trace  ->  return(r, s'{mfTrace=  loc:trace})
+            put s'
+            return r
+
        where
-       handler1 loc s (e :: SomeException)= do-        case CE.fromException e :: Maybe WFErrors of-           Just e  -> CE.throw e                -- !> ("TROWN=" ++ show e)-           Nothing ->-             case CE.fromException e :: Maybe AsyncException of-                Just e -> CE.throw e            -- !> ("TROWN ASYNC=" ++ show e)-                Nothing ->+       handler1 loc s (e :: SomeException)= do
+        case CE.fromException e :: Maybe WFErrors of
+           Just e  -> CE.throw e                -- !> ("TROWN=" ++ show e)
+           Nothing ->
+             case CE.fromException e :: Maybe AsyncException of
+                Just e -> CE.throw e            -- !> ("TROWN ASYNC=" ++ show e)
+                Nothing ->
                   return (FormElm [] Nothing, s{mfTrace= [show e]}) -- !> loc
- 
 
--- | the FlowM monad executes the page navigation. It perform Supracking 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,MonadState(MFlowState v))
-flowM= FlowM
---runFlowM= runView
 
 
 
+
+
 instance (FormInput v,Serialize a)
    => Serialize (a,MFlowState v) where
    showp (x,s)= case mfDebug s of
@@ -330,23 +332,15 @@                    FormElm form1 mk <- x
                    case mk of
                      Just k  -> do
-                        modify $ \st -> st{linkMatched= False} 
+                        st <- get
+                        put st{linkMatched = False} 
                         FormElm form2 mk <- runView $ f k
                         return $ FormElm (form1 ++ form2) mk
 
                      Nothing -> 
-                        return $ FormElm form1 Nothing+                        return $ FormElm form1 Nothing
                         
-    View x >> f = View $ do
-                   FormElm form1 mk <- x
-                   case mk of
-                     Just k  -> do
-                        modify $ \st -> st{linkMatched= False} 
-                        FormElm form2 mk <- runView  f 
-                        return $ FormElm (form1 ++ form2) mk
 
-                     Nothing -> 
-                        return $ FormElm form1 Nothing
 
     return = View .  return . FormElm  [] . Just
 --    fail msg= View . return $ FormElm [fromStr msg] Nothing
@@ -374,11 +368,18 @@    FormElm form1 mk <- x
    case mk of
      Just k  -> do
-       modify $ \st -> st{linkMatched= False} 
+       modify $ \st -> st{linkMatched= False, needForm=False} 
        runView (f k)
      Nothing -> return $ FormElm form1 Nothing
--   
+
+--clear :: Monad m => View v m ()
+--clear=  View $ do
+--   modify $ \s -> s{mfClear= True}
+--   return . FormElm [] $ Just ()
+
+clear :: Monad m => View v m ()
+clear = wcallback (return()) (const $ return()) 
+
 --incLink :: MonadState (MFlowState view) m => m()
 --incLink= modify $ \st -> st{mfPIndex= if linkMatched st then mfPIndex  st + 1 else mfPIndex st
 --                ,linkMatched= False}  -- !> "<-inc"
@@ -488,11 +489,12 @@   :: ( Functor m, MonadIO m,  FormInput v) => FlowM v m () -> FlowM v m ()
 preventGoingBack msg= do
    back <- goingBack
-   if not back  then breturn() else do
-         breturn()  -- will not go back beyond this
-         clearEnv
-         modify $ \s -> s{newAsk= True}
-         msg
+   if not back  then breturn()  else do
+             breturn()  -- will not go back beyond this
+             clearEnv
+             modify $ \s -> s{newAsk= True}
+             msg
+             
 
 
 
@@ -510,7 +512,7 @@    mfkillTime       :: Int,
    mfSessionTime    :: Integer,
    mfCookies        :: [Cookie],
-   mfHttpHeaders    :: Params,
+   mfHttpHeaders    :: [(SB.ByteString,SB.ByteString)],
    mfHeader         :: view -> view,
    mfDebug          :: Bool,
    mfRequirements   :: [Requirement],
@@ -521,7 +523,6 @@ 
    -- Link management
    mfPath           :: [String],
-
    mfPrefix         :: String,
    mfPIndex         :: Int,
    mfPageIndex      :: Maybe Int,
@@ -529,7 +530,8 @@    mfLinks          :: M.Map String Int,
 
    mfAutorefresh   :: Bool,
-   mfTrace          :: [String]
+   mfTrace          :: [String],
+   mfClear          :: Bool
    }
    deriving Typeable
 
@@ -538,7 +540,7 @@ mFlowState0 :: (FormInput view) => MFlowState view
 mFlowState0 = MFlowState 0 False  True  True  "en"
                 [] False  (error "token of mFlowState0 used")
-                0 0 [] [] stdHeader False [] M.empty  Nothing 0 False    []   ""   1 Nothing False M.empty False []
+                0 0 [] [] stdHeader False [] M.empty  Nothing 0 False    []   ""   1 Nothing False M.empty False [] False
 
 
 -- | Set user-defined data in the context of the session.
@@ -558,9 +560,9 @@ setSessionData ::  (Typeable a,MonadState (MFlowState view) m) => a -> m ()  
 setSessionData  x=
   modify $ \st -> st{mfData= M.insert  (typeOf x ) (unsafeCoerce x) (mfData st)}
--delSessionData x=-  modify $ \st -> st{mfData= M.delete  (typeOf x ) (mfData st)}+
+delSessionData x=
+  modify $ \st -> st{mfData= M.delete  (typeOf x ) (mfData st)}
   
 -- | Get the session data of the desired type if there is any.
 getSessionData ::  (Typeable a, MonadState (MFlowState view) m) =>  m (Maybe a)
@@ -632,53 +634,44 @@   fs <- get
   put fs{mfHeader= header}
 
-----addHeader added= do
-----     h <- gets mfHeader
-----     let h' added html = h $ added <> html
-----     setHeader $ h' added
-----
-----addFooter added= do
-----     h <- gets mfHeader
-----     let h' added html = h $ html <> added
-----     setHeader $ h' added
 
 
 -- | Return the current header
 getHeader :: ( Monad m) => FlowM view m (view -> view)
 getHeader= gets mfHeader
---- | Add another header embedded in the previous one-addHeader new= do-  fhtml <- getHeader-  setHeader $ fhtml . new+
+-- | Add another header embedded in the previous one
+addHeader new= do
+  fhtml <- getHeader
+  setHeader $  fhtml . new
   
 -- | Set an HTTP cookie
 setCookie :: MonadState (MFlowState view) m
-          => String  -- ^ name
+          =>  String  -- ^ name
           -> String  -- ^ value
           -> String  -- ^ path
           -> Maybe Integer  -- ^ Max-Age in seconds. Nothing for a session cookie
           -> m ()
 setCookie n v p me= do
-    modify $ \st -> st{mfCookies= (n,v,p,fmap  show me):mfCookies st }
+    modify $ \st -> st{mfCookies= (SB.pack n,SB.pack v,SB.pack p, fmap  (SB.pack . show) me):mfCookies st }
 
 -- | Set an HTTP Response header
 setHttpHeader :: MonadState (MFlowState view) m
-          => String  -- ^ name
-          -> String  -- ^ value
+           => SB.ByteString  -- ^ name
+          -> SB.ByteString  -- ^ value
           -> m ()
 setHttpHeader n v = do
     modify $ \st -> st{mfHttpHeaders=  (n,v):mfHttpHeaders st }
 
 
--- | Set+-- | Set
 --  1) the timeout of the flow execution since the last user interaction.
--- Once passed, the flow executes from the begining.---+-- Once passed, the flow executes from the begining.
+--
 -- 2) In persistent flows
 -- it set the session state timeout for the flow, that is persistent. If the
--- flow is not persistent, it has no effect.---+-- flow is not persistent, it has no effect.
+--
 -- As the other state primitives, it can be run in the Flow and in the View monad
 --
 -- `transient` flows restart anew.
@@ -706,23 +699,13 @@ type Checked= Bool
 type OnClick= Maybe String
 
-normalize :: (Monad m, FormInput v) => View v m a -> View ByteString m a
+normalize :: (Monad m, FormInput v) => View v m a -> View B.ByteString m a
 normalize f=  View .  StateT $ \s ->do
        (FormElm fs mx, s') <-  runStateT  ( runView f) $ unsafeCoerce s
        return  (FormElm (map toByteString fs ) mx,unsafeCoerce s')
 
---class ToByteString a where
---  toByteString :: a -> ByteString
---
---instance ToByteString a => ToHttpData a where
---  toHttpData = toHttpData . toByteString
---
---instance ToByteString ByteString where
---  toByteString= id
---
---instance ToByteString String where
---  toByteString  =  pack
 
+
 -- | Minimal interface for defining the basic form and link elements. The core of MFlow is agnostic
 -- about the rendering package used. Every formatting (either HTML or not) used with MFlow must have an
 -- instance of this class
@@ -730,7 +713,7 @@ -- See "MFlow.Forms.Blaze.Html for the instance for blaze-html. "MFlow.Forms.XHtml" for the instance
 -- for @Text.XHtml@ and MFlow.Forms.HSP for the instance for Haskell Server Pages.
 class (Monoid view,Typeable view)   => FormInput view where
-    toByteString :: view -> ByteString
+    toByteString :: view -> B.ByteString
     toHttpData :: view -> HttpData
     fromStr :: String -> view
     fromStrNoEncode :: String -> view
@@ -740,7 +723,7 @@     flink1:: String -> view
     flink1 verb = flink verb (fromStr  verb) 
     finput :: Name -> Type -> Value -> Checked -> OnClick -> view 
-    ftextarea :: String -> String -> view
+    ftextarea :: String -> T.Text -> view
     fselect :: String -> view -> view
     foption :: String -> view -> Bool -> view
     foption1 :: String -> Bool -> view
@@ -770,19 +753,19 @@ --, permanently or for a certain time. this is very useful for complex widgets that present information. Specially it they must access to databases.
 --
 -- @
--- import MFlow.Wai.XHtm.All
+-- import MFlow.Wai.Blaze.Html.All
 -- import Some.Time.Library
 -- addMessageFlows [(noscript, time)]
 -- main= run 80 waiMessageFlow
 -- time=do  ask $ cachedWidget \"time\" 5
---            $ wlink () bold << \"the time is \" ++ show (execute giveTheTime) ++ \" click here\"
---          time
+--              $ wlink () b << \"the time is \" ++ show (execute giveTheTime) ++ \" click here\"
+--              time
 -- @
 --
 -- this pseudocode would update the time every 5 seconds. The execution of the IO computation
 -- giveTheTime must be executed inside the cached widget to avoid unnecesary IO executions.
 --
--- NOTE: cached widgets are shared by all users
+-- NOTE: the rendering of cached widgets are shared by all users
 cachedWidget :: (MonadIO m,Typeable view
          , FormInput view, Typeable a,  Executable m )
         => String  -- ^ The key of the cached object for the retrieval
@@ -793,9 +776,10 @@         let((FormElm  form _), sec)= execute $ cachedByKey key t $ proc mf s{mfCached=True}
         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-                   ,mfPIndex= mfPIndex s2+                   ,mfRequirements=mfRequirements s2
+                   ,mfPath= mfPath s2
+                   ,needForm= needForm s2
+                   ,mfPIndex= mfPIndex s2
                    ,mfPageIndex= mfPageIndex s2
                    ,mfSeqCache= mfSeqCache s + mfSeqCache s2 - sec}
         return $ (mfSeqCache s'') `seq`  ((FormElm form mx2), s'')
@@ -818,53 +802,23 @@ -- It is faster than `cachedWidget`.
 -- It is not restricted to the Identity monad.
 --
--- NOTE: cached widgets are shared by all users
+-- NOTE: the content of freezed widgets are shared by all users
 wfreeze :: (MonadIO m,Typeable view
          , FormInput view, Typeable a,  Executable m )
-        => String  -- ^ The key of the cached object for the retrieval
-        -> Int     -- ^ Timeout of the caching. Zero means sessionwide
+        => String          -- ^ The key of the cached object for the retrieval
+        -> Int             -- ^ Timeout of the caching. Zero means sessionwide
         -> View view m a   -- ^ The cached widget
-        -> View view m a          -- ^ The cached result
+        -> View view m a   -- ^ The cached result
 wfreeze key t mf = View .  StateT $ \s -> do
-        ((FormElm  f mx), req,seq,ajax) <- cachedByKey key t $ proc mf s{mfCached=True}
-        return ((FormElm  f mx), s{mfRequirements=req,mfSeqCache= seq,mfAjax=ajax})
+        (FormElm  f mx, req,seq,ajax) <- cachedByKey key t $ proc mf s{mfCached=True}
+        return ((FormElm f mx), s{mfRequirements=req ,mfSeqCache= seq,mfAjax=ajax})
         where
         proc mf s= do
           (r,s) <- runStateT (runView mf) s
-          return (r,mfRequirements s, mfSeqCache s,mfAjax s)
+          return (r,mfRequirements s, mfSeqCache s, mfAjax s)
 
---
----- | FormLet class
---class (Functor m, MonadIO m) => FormLet  a  m view where
---   digest :: Maybe a
---          -> View view m a
 
---wrender
---  :: Widget a1 a m v => a1 -> StateT (MFlowState v) m ([v], Maybe a)
---
---wrender x =do
---         (FormElm frm x) <-  runView (widget x)
---         return (frm, x)
 
--- Minimal definition: either (wrender and wget) or widget
---class (Functor m, MonadIO m) => Widget  a b m view |  a -> b view where
---   wrender :: a -> WState view m [view]
---   wrender x =do
---         (FormElm frm (_ :: Maybe b)) <-  runView (widget x)
---         return frm
---   wget :: a -> WState view m (Maybe b)
---   wget x=  runView (widget x) >>= \(FormElm _ mx) -> return mx
-
---   widget :: a  -> View view m b
---   widget x = View $  do
---       form <- wrender x  
---       got  <- wget x  
---       return $ FormElm form got
-
-
---instance FormLet  a m view => Widget (Maybe a) a m view  where
---   widget = digest
-
 {- | Execute the Flow, in the @FlowM view m@ monad. It is used as parameter of `hackMessageFlow`
 `waiMessageFlow` or `addMessageFlows`
 
@@ -885,7 +839,7 @@     t' <- f t
     let t''= t'{tpath=[twfname t']}
     liftIO $ do
-       flushRec t''
+       flushRec t'' 
        sendToMF t'' t''  -- !> "SEND"
     loop  f t''          -- !> "LOOPAGAIN"
 
@@ -905,42 +859,112 @@                    ,mfEnv= tenv t} >>= return . fromFailBack
 
   where
-  backInit= do-     s <- get                       -- !> "BackInit"-     case mfTrace s of+  backInit= do
+     s <- get                       -- !> "BackInit"
+     case mfTrace s of
        [] -> do
          modify $ \s -> s{mfEnv=[], newAsk= True}
-         breturn ()-       tr -> do--         error $ disp tr-     where+         breturn ()
+       tr -> do
+
+         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
 
 
 -- | Run a persistent flow inside the current flow. It is identified by the procedure and
 -- the string identifier.
--- unlike the normal flows, that are infinite loops, runFlowIn executes a finite flow
--- once executed, in subsequent executions the flow will return the stored result
--- without asking again. This is useful for asking/storing/retrieving user defined configurations.
+-- 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/storing/retrieving user defined configurations by
+-- means of web formularies.
 runFlowIn
   :: (MonadIO m,
       FormInput view)
   => String
   -> FlowM  view  (Workflow IO)  b
   -> FlowM view m b
-runFlowIn wf f= do
-  t <- gets mfToken
-  FlowM .  Sup $ liftIO $ WF.exec1nc wf $ runFlow1 f t
+runFlowIn wf f= FlowM . Sup $ do
+      st <- get     
+      let t = mfToken st
+      (r,st') <- liftIO $ exec1nc wf $ runFlow1 st f t
+      put st{mfPath= mfPath st'}
+      case r of
+        GoBack ->  delWF  wf ()
+      return r
 
   where
-  runFlow1 f t=   evalStateT (runSup . runFlowM $ f)  mFlowState0{mfToken=t,mfEnv= tenv t}  -- >>= return . fromFailBack  -- >> return ()
+  runFlow1 st f t= runStateT (runSup . runFlowM $ f) st
 
+--exec1bnc :: String ->  Workflow IO a ->   IO  a
+--exec1bnc wf f= liftIO $ do
+-- ei <- getState  wf f ()
+-- case ei of
+--  Left err -> CE.throw err
+--  Right (name, _, stat) -> do
+--     let vers = reverse $ dropWhile isback $ reverse $ S.versions stat !> (unpack $ runW $ showp (S.versions stat))
+--         stat'= stat{S.versions= vers, S.state= length vers} !> (unpack $ runW $ showp vers)
+--     atomically $ writeDBRef (S.self stat) stat'
+--     writeResource stat'
+--     runWF1 name f  stat' False
+--    `CE.catch`
+--      (\(e :: CE.SomeException) -> liftIO $ do
+----             let name=  keyWF wf ()
+--             clearRunningFlag name  --`debug` ("exception"++ show e)
+--             CE.throw e )
+--    `finally`
+--      (liftIO . atomically .
+--           when(S.recover stat) $ do
+--              let ref= S.self stat
+--              s <- readDBRef ref `onNothing` error ("step: not found: "++ S.wfName stat)
+--              writeDBRef ref s{S.recover= False,S.versions= reverse $ S.versions s})
+--
+-- where
+--
+--
+--isback x= serializedEqual x (pack "G ")
+--
+--
+--dropBacks  _ []= []
+--dropBacks nbacks (x:xs)=
+--  case isback x of
+--    True  -> dropBacks (nbacks+1) xs
+--    False -> if nbacks== 0 then x:dropBacks 0 xs
+--                           else dropBacks 0 xs
+--switchWF
+--  :: (MonadIO m,
+--      FormInput view)
+--  => String
+--  -> FlowM  view  (Workflow IO)  b
+--  -> FlowM view m b
+--switchWF wf f= FlowM . Sup $ do
+--      st <- get     
+--      let t = mfToken st
+--      (r,st') <- liftIO $ WF.exec1 wf $ runFlow1 st f t
+--      put st{mfPath= mfPath st'}
+--      return r
+
+--switchWF wf f= do
+--  liftIO $ addMessageFlows [(wf,runFlow f)]
+--  transfer wf
+--
+--  where
+--  runFlow1 st f t= runStateT (runSup . runFlowM $ f) st
+
+-- | transfer control to another flow. (experimental)
+--transfer :: MonadIO m => String -> FlowM v m ()
+--transfer flowname = do
+--         t <- gets mfToken
+--         let t'= t{twfname= flowname}
+--         liftIO  $ do
+--             (r,_) <- msgScheduler t'
+--             sendFlush t r
+
 -- | to unlift a FlowM computation. useful for executing the configuration generated by runFLowIn
--- outside of a web application
-runFlowConf :: (FormInput view, MonadIO m) 
-        => FlowM view m a ->  m a  
+-- outside of the web flow (FlowM) monad
+runFlowConf :: (FormInput view, MonadIO m) => FlowM view m a ->  m a  
 runFlowConf  f = do
   q  <- liftIO newEmptyMVar  -- `debug` (i++w++u)
   qr <- liftIO newEmptyMVar
@@ -955,6 +979,10 @@   st <- get
   put st{ mfEnv= []}
 
+
+-- | 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.
 step
   :: (Serialize a,
       Typeable view,
@@ -966,14 +994,17 @@ step f= do
    s <- get
    flowM $ Sup $ do
-        (r,s') <-  lift . WF.step $ runStateT (runSup $ runFlowM f) s
+        (r,s') <- lift . WF.step $ runStateT (runSup $ runFlowM f) s
+                  
         -- when recovery of a workflow, the MFlow state is not considered
         when( mfSequence s' /= -1) $ put s'  -- !> (show $ mfSequence s') -- else put  s{newAsk=True}
-        return r
---- | to execute transient flows as if they were persistent------ > transient $ runFlow f === runFlow $ transientNav f+        return r  
+
+-- | to execute transient flows as if they were persistent
+-- it can be used instead of step, but it does not log the response. it ever executes the computation
+--
+-- > transient $ runFlow f === runFlow $ transientNav f
+
 transientNav
   :: (Serialize a,
       Typeable view,
@@ -981,13 +1012,15 @@       Typeable a) =>
       FlowM view IO a
       -> FlowM view (Workflow IO) a
-transientNav f= do
-   s <- get
-   flowM $ Sup $ do
-        (r,s') <-  lift . unsafeIOtoWF $ runStateT (runSup $ runFlowM f) s-        put s'
-        return r
+transientNav= MFlow.Forms.Internals.step
 
+--transientNav f= do
+--   s <- get
+--   flowM $ Sup $ do
+--        (r,s') <-  lift . unsafeIOtoWF $ runStateT (runSup $ runFlowM f) s
+--        put s'
+--        return r
+
 --stepWFRef
 --  :: (Serialize a,
 --      Typeable view,
@@ -1046,22 +1079,39 @@ 
 data ParamResult v a= NoParam | NotValidated String v | Validated a deriving (Read, Show)
 
+valToMaybe (Validated x)= Just x
+valToMaybe _= Nothing
+
+isValidated (Validated x)= True
+isValidated _= False
+
+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 =  r
+getParam1 par req =   case lookup  par req of
+    Just x1 -> readParam x1
+    Nothing  -> return  NoParam
+
+readParam :: (Monad m, MonadState (MFlowState v) m, Typeable a, Read a, FormInput v)
+           => String -> m (ParamResult v a)
+readParam x1 = r
  where
- r= case lookup  par req of
-    Just x -> do
-        modify $ \s -> s{inSync= True}
-        maybeRead x 
-    Nothing  -> return  NoParam 
+ r= do
+     modify $ \s -> s{inSync= True}
+     maybeRead x1
+      
  getType ::  m (ParamResult v a) -> a
  getType= undefined
  x= getType r
  maybeRead str= do
-   if typeOf x == (typeOf  ( undefined :: String))
-         then return . Validated $ unsafeCoerce str
-         else case readsPrec 0 $ str of
+   let typeofx = typeOf x
+   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
               _ -> do
 
@@ -1077,24 +1127,25 @@ -- procedure to be called with the list of requirements.
 -- Varios widgets in the page can require the same element, MFlow will install it once.
 requires rs =do
-    st <- get
+    st <- get 
     let l = mfRequirements st
 --    let rs'= map Requirement rs \\ l
     put st {mfRequirements= l ++ map Requirement rs}
 
 
 
-data Requirement= forall a.(Typeable a,Requirements a) => Requirement a deriving Typeable
+data Requirement= forall a.(Show a,Typeable a,Requirements a) => Requirement a deriving Typeable
 
 class Requirements  a where
    installRequirements :: (Monad m,FormInput view) => [a] ->  m view
 
-
+instance Show Requirement where
+   show (Requirement a)= show a ++ "\n"
 
 installAllRequirements :: ( Monad m, FormInput view) =>  WState view m view
 installAllRequirements= do
  rs <- gets mfRequirements
- installAllRequirements1 mempty rs
+ installAllRequirements1 mempty rs 
  where
 
  installAllRequirements1 v []= return v
@@ -1147,10 +1198,6 @@   \document.getElementsByTagName('head')[0].appendChild(fileref);"
 
 
-
-
-
-
 data WebRequirement= JScriptFile
                             String
                             [String]   -- ^ Script URL and the list of scripts to be executed when loaded
@@ -1158,7 +1205,7 @@                    | CSS String        -- ^ a String with a CSS description
                    | JScript String                -- ^ a string with a valid JavaScript
                    | ServerProc (String, Flow)     -- ^ a server procedure
-                   deriving(Typeable,Eq,Ord,Show)
+                     deriving(Typeable,Eq,Ord,Show)
 
 instance Eq (String, Flow) where
    (x,_) == (y,_)= x == y
@@ -1175,30 +1222,31 @@ 
 installWebRequirements ::  (Monad m,FormInput view) =>[WebRequirement] -> m view
 installWebRequirements rs= do
-  let s =  aggregate  $ sort rs
+  let s =  jsRequirements $ sort rs
 
   return $ ftag "script" (fromStrNoEncode  s)
-  where
-  aggregate  []= ""
 
 
-  aggregate (r@(JScriptFile f c) : r'@(JScriptFile f' c'):rs)
-         | f==f'= aggregate $ JScriptFile f (nub  c++c'):rs
-         | otherwise= strRequirement r++aggregate (r':rs)
+jsRequirements  []= ""
 
-  aggregate (r:r':rs)
-         | r== r' = aggregate $ r:rs
-         | otherwise= strRequirement r ++ aggregate (r':rs)
 
-  aggregate (r:rs)= strRequirement r++aggregate rs
+jsRequirements (r@(JScriptFile f c) : r'@(JScriptFile f' c'):rs)
+         | f==f' = jsRequirements $ JScriptFile f (nub $ c++c'):rs
+         | otherwise= strRequirement r ++ jsRequirements (r':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` ""
+jsRequirements (r:r':rs)
+         | r== r' = jsRequirements $ r:rs
+         | otherwise= strRequirement r ++ jsRequirements (r':rs)
 
+jsRequirements (r:rs)= strRequirement r++jsRequirements 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()" ++
@@ -1247,7 +1295,9 @@         True   -> concat $ take index  ['/':v | v <- lpath]  -- !> ("index= " ++ show index)
         False  -> concat ['/':v| v <- lpath])
 
--- | Generate a new string. Useful for creating tag identifiers and other attributes
+-- | Generate a new string. Useful for creating tag identifiers and other attributes.
+--
+-- if the page is refreshed, the identifiers generated are the same.
 genNewId :: MonadState (MFlowState view) m =>  m String
 genNewId=  do
   st <- get
@@ -1262,3 +1312,17 @@       let n = mfSeqCache st
       put $ st{mfSeqCache=n+1}
       return $  'c' : (show n)
+
+-- | get the next ideitifier that will be created by genNewId
+getNextId :: MonadState (MFlowState view) m =>  m String
+getNextId=  do
+  st <- get
+  case mfCached st of
+    False -> do
+      let n= mfSequence st
+          prefseq=  mfPrefix st
+      return $ 'p':show n++prefseq
+    True  -> do
+      let n = mfSeqCache st
+      return $  'c' : (show n)
+

@@ -15,28 +15,31 @@  module MFlow.Forms.Widgets ( -- * Ajax refreshing of widgets-autoRefresh, appendUpdate, prependUpdate, push, UpdateMethod(..)+autoRefresh, noAutoRefresh, appendUpdate, prependUpdate, push, UpdateMethod(..)  -- * JQueryUi widgets ,datePicker, getSpinner, wautocomplete, wdialog,  -- * User Management-userFormOrName,maybeLogout,+userFormOrName,maybeLogout, wlogin,  -- * Active widgets wEditList,wautocompleteList , wautocompleteEdit,  -- * Editing widgets-delEdited, getEdited-,prependWidget,appendWidget,setWidget+delEdited, getEdited,prependWidget,appendWidget,setWidget  -- * Content Management-,tField, tFieldEd, tFieldGen+,tField, tFieldEd, htmlEdit, edTemplate, dField, template, witerate,tfieldKey  -- * Multilanguage ,mFieldEd, mField +-- * utility+,insertForm++ ) where import MFlow import MFlow.Forms@@ -60,7 +63,7 @@ import Data.Char import Control.Monad.Identity import Control.Workflow(killWF)-+import Unsafe.Coerce   readyJQuery="ready=function(){if(!window.jQuery){return setTimeout(ready,100)}};"@@ -113,6 +116,34 @@       ta :: Medit v m a -> a       ta= undefined +-- | If not logged, it present a page flow which askm  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.
+wlogin :: (MonadIO m,Functor m,FormInput v) => View v m ()
+wlogin=  do
+   username <- getCurrentUser
+   if username /= anonymous
+         then return username
+         else do
+          name <- getString Nothing <! hint "login name" <! size 9 <++ ftag "br" mempty
+          pass <- getPassword <! hint "password" <! size 9+                     <++ ftag "br" mempty+                     <** submitButton "login" 
+          val  <- userValidate (name,pass)
+          case val of
+            Just msg -> notValid msg
+            Nothing  -> login name >> return name
+       
+   `wcallback` (\name -> ftag "b" (fromStr $ "logged as " ++ name)
+                     ++>  wlink ("logout" :: String) (ftag "b" $ fromStr " logout"))
+   `wcallback`  const (logout >> wlogin)
+   
+focus = [("onload","this.focus()")]+hint s= [("placeholder",s)]+size n= [("size",show n)]+ getEdited1 id= do     Medit stored <- getSessionData `onNothing` return (Medit M.empty)     return $ fromMaybe [] $ M.lookup id stored@@ -170,6 +201,7 @@      where      typ :: View v Identity a -> a      typ = undefined+ -- | Return the javascript to be executed on the browser to prepend a widget to the location -- identified by the selector (the bytestring parameter), The selector must have the form of a jquery expression -- . It stores the added widgets in the edited list, that is accessed with 'getEdited'@@ -221,7 +253,6 @@ -- This example add or delete editable text boxes, with two initial boxes   with -- /hi/, /how are you/ as values. Tt uses blaze-html: --- -- >  r <-  ask  $   addLink -- >              ++> br -- >              ++> (El.div `wEditList`  getString1 $  ["hi", "how are you"]) "addid"@@ -298,9 +329,10 @@   -> (String -> IO a)   -- ^ Autocompletion procedure: will receive a prefix and return a list of strings   -> View v m String wautocomplete mv autocomplete  = do+    text1 <- genNewId     ajaxc <- ajax $ \u -> do                           r <- liftIO $ autocomplete u-                          return $ jaddtoautocomp r+                          return $ jaddtoautocomp text1 r       requires [JScriptFile jqueryScript [] -- [events]@@ -309,18 +341,18 @@       getString mv <!  [("type", "text")-                     ,("id", "text1")-                     ,("oninput",ajaxc "$('#text1').attr('value')" )+                     ,("id", text1)+                     ,("oninput",ajaxc $ "$('#"++text1++"').attr('value')" )                      ,("autocomplete", "off")]       where-    jaddtoautocomp us= "$('#text1').autocomplete({ source: " <> B.pack( show us) <> "  });"+    jaddtoautocomp text1 us= "$('#"<>B.pack text1<>"').autocomplete({ source: " <> B.pack( show us) <> "  });"   -- | Produces a text box. It gives a autocompletion list to the textbox. When return -- is pressed in the textbox, the box content is used to create a widget of a kind defined--- by the user, which will be situated above of the textbox. When submitted, the result of this widget is the content+-- by the user, which will be situated above of the textbox. When submitted, the result is the content -- of the created widgets (the validated ones). -- -- 'wautocompleteList' is an specialization of this widget, where@@ -341,18 +373,19 @@     -> (Maybe String  -> View v Identity a)   -- ^ the widget to add, initialized with the string entered in the box     -> [String]                               -- ^ initial set of values     -> View v m [a]                           -- ^ resulting widget-wautocompleteEdit phold   autocomplete  elem values= do+wautocompleteEdit phold autocomplete  elem values= do     id1 <- genNewId+    let textx= id1++"text"     let sel= "$('#" <> B.pack id1 <> "')"     ajaxc <- ajax $ \(c:u) ->-              case c of+              case c  of                 'f' -> prependWidget sel (elem $ Just u)                 _   -> do                           r <- liftIO $ autocomplete u-                          return $ jaddtoautocomp r+                          return $ jaddtoautocomp textx r  -    requires [JScriptFile jqueryScript [events ajaxc] -- [events]+    requires [JScriptFile jqueryScript  [events textx ajaxc]              ,CSSFile jqueryCSS              ,JScriptFile jqueryUI []] @@ -362,29 +395,29 @@       ++> manyOf (ws' ++ (map (changeMonad . elem . Just) values)))       <++ ftag "input" mempty              `attrs` [("type", "text")-                     ,("id", "text1")+                     ,("id", textx)                      ,("placeholder", phold)-                     ,("oninput",ajaxc "'n'+$('#text1').attr('value')" )+                     ,("oninput", ajaxc $ "'n'+$('#"++textx++"').val()" )                      ,("autocomplete", "off")]     delEdited sel ws'     return r     where-    events ajaxc=+    events textx ajaxc=          "$(document).ready(function(){   \-         \  $('#text1').keydown(function(){ \+         \  $('#"++textx++"').keydown(function(){ \          \   if(event.keyCode == 13){  \-             \   var v= $('#text1').attr('value'); \+             \   var v= $('#"++textx++"').val(); \              \   if(event.preventDefault) event.preventDefault();\              \   else if(event.returnValue) event.returnValue = false;" ++                  ajaxc "'f'+v"++";"++-             "   $('#text1').val('');\+             "   $('#"++textx++"').val('');\          \  }\          \ });\          \});" -    jaddtoautocomp us= "$('#text1').autocomplete({ source: " <> B.pack( show us) <> "  });"+    jaddtoautocomp textx us= "$('#"<>B.pack textx<>"').autocomplete({ source: " <> B.pack( show us) <> "  });" --- | A specialization of 'selectAutocompleteEdit' which make appear each option choosen with+-- | 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   :: (Functor m, MonadIO m, Executable m, FormInput v) =>@@ -392,44 +425,67 @@ wautocompleteList phold serverproc values=  wautocompleteEdit phold serverproc  wrender1 values  where- wrender1 x= ftag "div"    <<< ftag "input" mempty+ wrender1 x= ftag "div" <<< ftag "input" mempty                                 `attrs` [("type","checkbox")                                         ,("checked","")                                         ,("onclick","this.parentNode.parentNode.removeChild(this.parentNode)")]-                           ++> ftag "span" (fromStr $ fromJust x )-                           ++> whidden( fromJust x)+                        ++> ftag "span" (fromStr $ fromJust x )+                        ++> whidden( fromJust x)  ------- Templating and localization --------- -writetField    k s=  atomically $ writetFieldSTM k s+data TField  = TField {tfieldKey :: Key, tfieldContent :: B.ByteString}  deriving (Read, Show,Typeable) -writetFieldSTM k s=  do-             phold <- readDBRef tFields `onNothing` return (M.fromList [])-             let r= M.insert k  (toByteString s) phold-             writeDBRef tFields   r+instance Indexable TField where+    key (TField k _)= k+    defPath _= "texts/" ++instance Serializable TField where+    serialize (TField k content)  = B.pack $ "TField "++show k ++ " " ++ show (B.unpack content)-- B.pack . show+    deserialize bs=+                let ('T':'F':'i':'e':'l':'d':' ':s)= B.unpack bs -- read . B.unpack+                    [(k,rest)] =  readsPrec 0 s+                    [(content,_)] = readsPrec 0 $ tail rest+                in TField k (B.pack content)+    setPersist =   \_ -> Just filePersist+++writetField k s= atomically $ writeDBRef (getDBRef k) $ TField k $ toByteString s++ readtField text k= atomically $ do-       hs<- readDBRef tFields `onNothing` return (M.fromList [])-       let mp=  M.lookup k hs-       case mp of-         Just c  -> return   $ fromStrNoEncode $ B.unpack c-         Nothing -> writetFieldSTM k  text >> return  text+   let ref = getDBRef k+   mr <- readDBRef ref+   case mr of+    Just (TField k v) -> return $ fromStrNoEncode $ B.unpack v+    Nothing -> return text -type TFields  = M.Map String B.ByteString-instance Indexable TFields where-    key _= "texts"-    defPath _= "texts/" -tFields :: DBRef TFields-tFields =  getDBRef "texts"+htmlEdit :: (Monad m, FormInput v) =>  [String] -> UserStr -> View v m a -> View v m a+htmlEdit buttons jsuser w = do+  id <- genNewId -type Key= String+  let installHtmlField=+          "\nfunction installHtmlField(muser,cookieuser,name,buttons){\n\+            \if(muser== '' || document.cookie.search(cookieuser+'='+muser) != -1)\n\+                 \ bkLib.onDomLoaded(function() {\n\+                 \   var myNicEditor = new nicEditor({buttonList : buttons});\n\+                 \   myNicEditor.panelInstance(name);\n\+                 \})};\n"+      install= "installHtmlField('"++jsuser++"','"++cookieuser++"','"++id++"',"++show buttons++");\n" --- | A widget that display the content of an  html, But if logged as administrator,+  requires [JScriptFile nicEditUrl [installHtmlField,install]]+  w <! [("id",id)]++nicEditUrl= "http://js.nicedit.com/nicEdit-latest.js"+++-- | A widget that display the content of an  html, But if the user has edition privileges, -- it permits to edit it in place. So the editor could see the final appearance--- of what he write in the page.+-- of what he writes. ----- When the administrator double click in the paragraph, the content is saved and+-- When the user  click the save, the content is saved and -- identified by the key. Then, from now on, all the users will see the saved -- content instead of the code content. --@@ -437,102 +493,387 @@ -- a configurable version (`tFieldGen`). The content of the element and the formatting -- is cached in memory, so the display is, theoretically, very fast. ----- THis is an example of how to use the content management primitives (in demos.blaze.hs):------ > textEdit= do--- >   setHeader $ \t -> html << body << t--- >--- >   let first=  p << i <<--- >                  (El.span << text "this is a page with"--- >                  <> b << text " two " <> El.span << text "paragraphs")--- >--- >       second= p << i << text "This is the original text of the second paragraph"--- >--- >       pageEditable =  (tFieldEd "first"  first)--- >                   **> (tFieldEd "second" second)--- >--- >   ask $   first--- >       ++> second--- >       ++> wlink () (p << text "click here to edit it")--- >--- >   ask $ p << text "Please login with admin/admin to edit it"--- >           ++> userWidget (Just "admin") userLogin--- >--- >   ask $   p << text "now you can click the field and edit them"--- >       ++> p << b << text "to save the edited field, double click on it"--- >       ++> pageEditable--- >       **> wlink () (p << text "click here to see it as a normal user")--- >--- >   logout--- >--- >   ask $   p << text "the user sees the edited content. He can not edit"--- >       ++> pageEditable--- >       **> wlink () (p << text "click to continue")--- >--- >   ask $   p << text "When text are fixed,the edit facility and the original texts can be removed. The content is indexed by the field key"--- >       ++> tField "first"--- >       **> tField "second"--- >       **> p << text "End of edit field demo" ++> wlink () (p << text "click here to go to menu")+ tFieldEd   :: (Functor m,  MonadIO m, Executable m,       FormInput v) =>-      Key -> v -> View v m ()-tFieldEd  k text=-   tFieldGen k  (readtField text) writetField+      UserStr -> Key -> v -> View v m ()+tFieldEd  muser k  text= wfreeze k 0 $  do+   content <- liftIO $ readtField text k+   nam     <- genNewId+   let ipanel= nam++"panel"+       name= nam++"-"++k+       install= "\ninstallEditField('"++muser++"','"++cookieuser++"','"++name++"','"++ipanel++"');\n"+       getTexts :: (Token -> IO ())+       getTexts token = do+         let (k,s):_ = tenv token+         liftIO $ do+           writetField k  $ (fromStrNoEncode s `asTypeOf` text)+           flushCached k+           sendFlush token $ HttpData [] [] ""+           return() +   requires [JScriptFile nicEditUrl [install]+            ,JScript     ajaxSendText+            ,JScript     installEditField+--            ,JScriptFile jqueryScript []+            ,ServerProc  ("_texts",  transient getTexts)] --- | Like 'tFieldEd' with user-configurable storage.-tFieldGen :: (MonadIO m,Functor m, Executable m-        ,FormInput v)-        => Key-        -> (Key -> IO  v)  -- ^ the read procedure, user defined-        -> (Key ->v  -> IO())   -- ^ the write procedure, user defiend-        -> View v m ()-tFieldGen  k  getcontent create =   wfreeze k 0 $ do-    content <- liftIO $ getcontent  k-    admin   <- getAdminName-    ajaxjs  <- ajax  $ \str -> do-              let (k,s)= break (==',')    str  -- !> str-              liftIO  . create  k  $ fromStrNoEncode (tail s)-              liftIO $ flushCached k-              return "alert('saved')"-    attribs <- do-            name <- genNewId-            -- Need to check the user in the browser because the widget is wfreeze'd-            let ifUserAdmin= "if(document.cookie.search('"++cookieuser++"="++admin++"') != -1)"-                nikeditor= "var myNicEditor = new nicEditor();"-                callback=ifUserAdmin ++-                  "bkLib.onDomLoaded(function() {\-                     \    myNicEditor.addInstance('"++name++"');\-                     \});"-                param= ("'"++k  ++ "'+','+ document.getElementById('"++name++"').innerHTML")+   (ftag "div" mempty `attrs` [("id",ipanel)]) ++>+    wraw (ftag "span" content `attrs` [("id", name)]) -            requires  [JScriptFile "http://js.nicedit.com/nicEdit-latest.js" [nikeditor, callback]] -            return [("id", name),("ondblclick",  ifUserAdmin ++ ajaxjs param)] -    wraw $  (ftag "span" content `attrs` attribs)+installEditField=+          "\nfunction installEditField(muser,cookieuser,name,ipanel){\n\+            \if(muser== '' || document.cookie.search(cookieuser+'='+muser) != -1)\n\+                 \ bkLib.onDomLoaded(function() {\n\+                 \   var myNicEditor = new nicEditor({fullPanel : true, onSave : function(content, id, instance) {\+                 \        ajaxSendText(id,content);\n\+                 \        myNicEditor.removeInstance(name);\n\+                 \        myNicEditor.removePanel(ipanel);\n\+                 \      }});\n\+                 \   myNicEditor.addInstance(name);\n\+                 \   myNicEditor.setPanel(ipanel);\n\+                 \})};\n" --- | Read the field value and present it without edition.-tField :: (MonadIO m,Functor m, Executable m-       ,  FormInput v)+ajaxSendText = "\nfunction ajaxSendText(id,content){\n\+        \var arr= id.split('-');\n\+        \var k= arr[1];\n\+        \$.ajax({\n\+        \       type: 'POST',\n\+        \       url: '/_texts',\n\+        \       data: k + '='+ encodeURIComponent(content),\n\+        \       success: function (resp) {},\n\+        \       error: function (xhr, status, error) {\n\+        \                var msg = $('<div>' + xhr + '</div>');\n\+        \                id1.html(msg);\n\+        \       }\n\+        \   });\n\+        \return false;\n\+        \};\n"++-- | a text field. Read the cached  field value and present it without edition.+tField :: (MonadIO m,Functor m, Executable m, FormInput v)        => Key        -> View v m ()-tField  k    =  wfreeze k 0 $ do-    content <-  liftIO $ readtField (fromStrNoEncode "not found")  k+tField k = wfreeze k 0 $ do+    content <- liftIO $ readtField (fromStrNoEncode "not found")  k     wraw content  -- | A multilanguage version of tFieldEd. For a field with @key@ it add a suffix with the -- two characters of the language used.-mFieldEd k content= do+mFieldEd  muser k content= do   lang <- getLang-  tFieldEd (k ++ ('-':lang)) content+  tFieldEd  muser (k ++ ('-':lang)) content ++ -- | A multilanguage version of tField mField k= do   lang <- getLang   tField $ k ++ ('-':lang) +newtype IteratedId= IteratedId  String deriving Typeable++-- | 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+-- modifiers: The latter gets a widget and create a placeholder in the page that is updated+-- via ajax. The content of the update is the rendering of the widget at each iteration.+-- The former gets a wider widget which contains dField elements and permit the iteration.+-- Whenever a link or a form within the witerate widget is activated, the result is the+-- placeholders filled with the new  html content.  This content can be data, a input field,+-- a link or a widget. No navigation happens.+--+-- This permits even faster updates than autoRefresh.  since the latter refresh the whole+-- widget and it does not permits modifications of the layout at runtime.+--+-- When edTemplate or template is used on top of witerate, the result is editable at runtime,+-- and the span placeholders generated, that are updated via ajax can be relocated within+-- the layout of the template.+--+-- Additionally, contrary to some javascript frameworks, the pages generated with this+-- mechanism are searchable by web crawlers.++witerate+  :: (MonadIO m, Functor m, FormInput v) =>+      View v m a -> View v m a+witerate  w= do+   name  <- genNewId+   setSessionData $ IteratedId name+   st <- get+   let index= mfPIndex st+   let t= mfkillTime st+   let installAutoEval=+        "$(document).ready(function(){\n\+           \autoEvalLink('"++name++"','"++ show index ++"');\+           \autoEvalForm('"++name++"');\+           \})\n"+   let r = lookup ("auto"++name) $ mfEnv st+   ret <- case r of+    Nothing -> do+     requires [JScript     autoEvalLink+              ,JScript     autoEvalForm+              ,JScript     setId+              ,JScript     $ timeoutscript t+              ,JScriptFile jqueryScript [installAutoEval]]++     (ftag "div" <<< insertForm w) <! [("id",name)]+++    Just sind -> View $ do+         let t= mfToken st+         let index= read sind+         put st{mfPIndex= index}+         modify $ \s -> s{mfRequirements=[]}++         FormElm _ mr <- runView  w++         reqs <- return . map ( \(Requirement r) -> unsafeCoerce r) =<< gets mfRequirements+         let js = jsRequirements reqs+         liftIO . sendFlush t $ HttpData+                                (("Cache-Control", "no-cache, no-store"):mfHttpHeaders st)+                                (mfCookies st) (B.pack js)+         modify $ \st -> st{mfAutorefresh=True,inSync=True}+         return $ FormElm [] mr++   delSessionData $ IteratedId name+   return ret++autoEvalLink = "\nfunction autoEvalLink(id,ind){\n\+    \var id1= $('#'+id);\n\+    \var ida= $('#'+id+' a[class!=\"_noAutoRefresh\"]');\n\+    \ida.click(function () {\n\+    \ if (hadtimeout == true) return true;\n\+    \ var pdata = $(this).attr('data-value');\n\+    \ var actionurl = $(this).attr('href');\n\+    \ var dialogOpts = {\n\+    \       type: 'GET',\n\+    \       url: actionurl+'?bustcache='+ new Date().getTime()+'&auto'+id+'='+ind,\n\+    \       data: pdata,\n\+    \       success: function (resp) {\n\+    \           eval(resp);\n\+    \       },\n\+    \       error: function (xhr, status, error) {\n\+    \           var msg = $('<div>' + xhr + '</div>');\n\+    \           id1.html(msg);\n\+    \       }\n\+    \   };\n\+    \ $.ajax(dialogOpts);\n\+    \ return false;\n\+    \});\n\+  \}\n"++autoEvalForm = "\nfunction autoEvalForm(id) {\n\+    \var id1= $('#'+id);\n\+    \var idform= $('#'+id+' form[class!=\"_noAutoRefresh\"]');\n\+    \idform.submit(function (event) {\n\+        \if (hadtimeout == true) return true;\n\+        \event.preventDefault();\n\+        \var $form = $(this);\n\+        \var url = $form.attr('action');\n\+        \var pdata = $form.serialize();\n\+        \$.ajax({\n\+            \type: 'POST',\n\+            \url: url,\n\+            \data: 'auto'+id+'=true&'+pdata,\n\+            \success: function (resp) {\n\+                \eval(resp);\n\+            \},\n\+            \error: function (xhr, status, error) {\n\+                \var msg = $('<div>' + xhr + '</div>');\n\+                \id1.html(msg);\n\+            \}\n\+        \});\n\+       \});\n\+      \return false;\n\+     \}\n"++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+-- widget surrounded by a placeholder. subsequent iterations will send just the javascript code+-- necessary for the refreshing of the placeholder.+dField+  :: (Monad m, FormInput view) =>+     View view m  b -> View view m b+dField w= View $ do+    id <- genNewId+    FormElm vs mx <- runView w+    let render = mconcat vs+    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++"','" ++ B.unpack (toByteString $ render)++"')});\n"]]+       return $ FormElm[(ftag "span" render) `attrs` [("id",id)]] mx+     else do+       requires [JScript $  "setId('"++id++"','" ++ B.unpack (toByteString $ render)++"');\n"]+       return $ FormElm mempty mx++noid= "noid"++--edTemplateList+--  :: (MonadIO m, Functor m, Typeable b, FormInput view) =>+--     UserStr -> String -> (a ->View view m  b) -> [a] -> View view m b+--edTemplateList user  name w xs= View $ do+--    id <- genNewId+--    let ws= Prelude.map w xs+--    FormElm vx mx <- runView $+--          edTemplate user name ( Prelude.head ws) <|>+--          firstOf [template name w | w <- Prelude.tail ws]+--+--    let render = mconcat vx+--    st <- get+--    let t= mfkillTime st+--    let env =  mfEnv st+--    let insertResults= "insert('" ++ id ++ "',"++ show (B.unpack $ toByteString render) ++");"+--    IteratedId name <- getSessionData `onNothing` return (IteratedId noid)+--    let r =  lookup ("auto"++name) env           -- !> ("TIMEOUT="++ show t)+--    if r == Nothing || (name == noid && newAsk st== True)+--     then do+--         requires[JScript autoEvalLink+--                 ,JScript $ timeoutscript t+--                 ,JScript jsInsertList+--                 ,JScriptFile jqueryScript [insertResults]]+--         return $ FormElm[(ftag "span" render) `attrs` [("id",id)]] mx  !> "NOPARAM edTemplateList"+--     else do+--       modify $ \st -> st{mfRequirements= [],mfAutorefresh=True,inSync=True}+--       requires[JScript insertResults]+--             !> "VALIDATED edTemplateList"+--       return $ FormElm mempty mx+--++-- | load a template with the name equal to the second parameter in the texts folder. If no template+-- exist, it uses the widget rendering. If the first parameter match the name of the logged user,+-- the template will be editable at runtime. edTemplate will present an edition bar on the top of+-- the template. The changes in the template will be effective inmediately for all the users.+--+-- The return value is the one returned by the internal widget each time it is executed.+--+-- edTemplate can be used to enrich the content and layout of a widget, for example, by adding+-- extra links, text and formatting. Widgets with form fields work well with an 'edTemplate' mask+-- as long as the tags created by the widget are not deleted, but the validation messages will not appear+--+-- To add dynamic elements to the template for data presentation and//or input field validation+-- messages, combine it with 'witerate' and 'dField'+edTemplate+  :: (MonadIO m, FormInput v, Typeable a) =>+      UserStr -> Key -> View v m a -> View v m a+edTemplate muser k w=  View $ do+   nam     <- genNewId++   let ipanel= nam++"panel"+       name= nam++"-"++k+       install= "\ninstallEditField('"++muser++"','"++cookieuser++"','"++name++"','"++ipanel++"');\n"+++   requires [JScriptFile nicEditUrl [install]+            ,JScript     ajaxSendText+            ,JScript     installEditField+            ,JScriptFile jqueryScript []+            ,ServerProc  ("_texts",  transient getTexts)]++   FormElm text mx <- runView w+   content <- liftIO $ readtField (mconcat text) k++   return $ FormElm [ftag "div" mempty `attrs` [("id",ipanel)]+                    ,ftag "span" content `attrs` [("id", name)]]+                     mx+   where+   getTexts :: (Token -> IO ())+   getTexts token= do+     let (k,s):_ = tenv token+     liftIO $ do+       writetField k  $ (fromStrNoEncode s `asTypeOf` viewFormat w)+       flushCached k+       sendFlush token $ HttpData [] [] ""+       return()++   viewFormat :: View v m a -> v+   viewFormat= undefined -- is a type function++-- | Does the same than template but without the edition facility+template k w= View $ do+    FormElm text mx <- runView  w+    let content= unsafePerformIO $ readtField  (mconcat text) k+    return $ FormElm [content] mx++--edTemplateList+--  :: (Typeable a,FormInput view) =>+--     UserStr -> String  -> [View view Identity a] -> View view IO a+--edTemplateList user templ  ws=  do+--  let  id = templ+--  let wrapid=  "wrapper-" ++ id+--  text <- liftIO $ readtField  (ftag "div" mempty `attrs` [("id",wrapid)])  wrapid+--  let   vwrtext= B.unpack $ toByteString (text `asTypeOf` witness ws)+--+----  wrapperEd wrapid vwrtext **>+--  (ftag "div" <<< elems id wrapid vwrtext) <! [("id",wrapid)]+--  where+--  witness :: [View view Identity a] -> view+--  witness = undefined+--+--  elems id wrapid vwrtext= View $ do+--    let holder=  ftag "span" (fromStr "holder") `attrs` [("_holder",id)]+--+--    FormElm fedit _ <- runView $ tFieldEd user templ holder+--    frest  <- liftIO $ readtField holder  templ+--+--    forms <-  mapM (runView . changeMonad) ws+--    let vs   = map (\(FormElm v _) ->  mconcat v) forms+--    requires [JScriptFile jqueryScript+--              [+----               replacewrap+----              ,"replacewrap('"++ wrapid ++ "','" ++ vwrtext ++ "')",+--              jsInsertList+--              ,"$(document).ready(function() {\+--               \insert('" ++ id ++ "',"++ show (map ( B.unpack . toByteString) vs) ++");\n\+--               \});"]]+--+--    let res = filter isJust $ map (\(FormElm _ r) -> r) forms
+--        res1= if null res then Nothing else head res+--+--    return $ FormElm  (mconcat fedit: take (length vs -1) (repeat frest)) res1+--+jsInsertList =+      "\nfunction insert(id,vs){\n\+      \$('[_holder=\"'+id+'\"]').each(function(n,it) {\n\+      \  $(it).html(vs[n]);\n\+      \})};\n"++--  wrapperEd :: (FormInput view) => String -> view -> View view IO ()+--  wrapperEd  wrapid  wrtext = do -- autoRefresh . pageFlow "wrap" $ do+--        vwrtext <- liftIO $ readtField  (ftag "div" mempty `attrs` [("id",wrapid)])  wrapid+--        let wrtext= B.unpack $ toByteString (vwrtext `asTypeOf` witness)+--        nwrtext<- getString  (Just wrtext)+--                          <! [("id", wrapid++"-ed")]+--                   <** submitButton "OK"+--+--        liftIO $ writetField wrapid (fromStr nwrtext `asTypeOf` witness ws) !> nwrtext+++--  replacewrap = "\nfunction replacewrap(id,wrapcode){\n\+--          \   var selector= '#'+id;\n\+--          \   var children = $(selector).children();\n\+--          \   var nchildren;\n\+--          \   $(selector).replaceWith(wrapcode);\n\+--          \   $(selector).html(children);\n\+--          \   if(wrapcode.search('table') != -1)\n\+--          \        $(children[1].children).wrap('<tr><td></td></tr>')\n\+--          \};\n"++--          \   if(wrapcode.search('xx') != -1){\n\+--          \        children.each(function(n,it){\n\+--          \                      $(it).wrap('<li></li>')});\n\++--          \        })\n\++++------------------- JQuery widgets ------------------- -- | present the JQuery datepicker calendar to choose a date. -- The second parameter is the configuration. Use \"()\" by default. -- See http://jqueryui.com/datepicker/@@ -576,8 +917,7 @@      (ftag "div" <<< insertForm w) <! [("id",id),("title", title)] --+-- | 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@@ -608,6 +948,33 @@   -> View v m a autoRefresh w=  update "html" w +-- | In some cases, it is neccessary that a link or form inside a 'autoRefresh' or 'update' block+-- should not be autorefreshed, since it produces side effects in the rest of the page that+-- affect to the rendering of the whole. If you like to refresh the whole page, simply add+-- noAutoRefresh attribute to the widget to force the refresh of the whole page when it is activated.+--+-- That behaviour is common at the last sentence of the 'autoRefresh' block.+--+-- This is a cascade menu example.+--+-- > r <- page $ autoRefresh $ ul <<< do+-- >        li <<< wlink OptionA << "option A"+-- >        ul <<< li <<< (wlink OptionA1 << "Option A1" <! noAutoRefresh)+-- >           <|> li <<< (wlink OptionA2 << "Option A2" <! noAutoRefresh)+-- >        <|>...+-- >           maybe other content+-- >+-- > case r of+-- >    OptionA1 -> pageA1+-- >    OptionA2 -> pageA2+--+-- when @option A@ is clicked, the two sub-options appear with autorefresh. Only the two+-- lines are returned by the server using AJAX. but when Option A1-2 is pressed we want to+-- present other pages, so we add the noAutorefresh attribute.+--+-- NOTE: the noAutoRefresh attribute should be added to the <a/> or <form/> tags.+noAutoRefresh= [("class","_noAutoRefresh")]+ -- | does the same than autoRefresh but append the result of each request to the bottom of the widget appendUpdate  :: (MonadIO m,      FormInput v)@@ -622,6 +989,11 @@   -> View v m a prependUpdate= update "prepend" +update :: (MonadIO m,+     FormInput v)+  => B.ByteString+  -> View v m a+  -> View v m a update method w= do     id <- genNewId     st <- get@@ -633,34 +1005,35 @@                ++ "ajaxPostForm('"++id++"');"                ++ "})\n" -    r <- getParam1 ("auto"++id) $ mfEnv st           -- !> ("TIMEOUT="++ show t)+    let r= lookup ("auto"++id) $ mfEnv st           -- !> ("TIMEOUT="++ show t)     case r of-      NoParam -> do+      Nothing -> do          requires [JScript $ timeoutscript t                   ,JScript ajaxGetLink                   ,JScript ajaxPostForm                   ,JScriptFile jqueryScript [installscript]]          (ftag "div" <<< insertForm w) <! [("id",id)] 
 -      Validated (x :: String) -> View $ do+      Just sind -> View $ do          let t= mfToken st          FormElm form mr <- runView $ insertForm w          st <- get-         let HttpData ctype c s= toHttpData $ mconcat form+         let HttpData ctype c s= toHttpData $ method <> " " <> toByteString (mconcat form)+--                                            "$('#"<> B.pack id <>"')." <> method+--                                            <> "('" <> toByteString (mconcat form) <> "');"+--                                            <> "ajaxGetLink('" <> B.pack id  <> "');"+--                                            <> "ajaxPostForm('" <> B.pack id  <> "');"          liftIO . sendFlush t $ HttpData (ctype ++ ("Cache-Control", "no-cache, no-store"):mfHttpHeaders st) (mfCookies st ++ c) s-         put st{mfAutorefresh=True}+         put st{mfAutorefresh=True,inSync=True}          return $ FormElm [] mr    where -  timeoutscript t=-     "\nvar hadtimeout=false;\n\-     \setTimeout(function() {hadtimeout=true; }, "++show (t*1000)++");\n"    -- | adapted from http://www.codeproject.com/Articles/341151/Simple-AJAX-POST-Form-and-AJAX-Fetch-Link-to-Modal-  ajaxGetLink = "function ajaxGetLink(id){\n\+  ajaxGetLink = "\nfunction ajaxGetLink(id){\n\     \var id1= $('#'+id);\n\-    \var ida= $('#'+id+' a');\n\+    \var ida= $('#'+id+' a[class!=\"_noAutoRefresh\"]');\n\     \ida.click(function () {\n\     \if (hadtimeout == true) return true;\n\     \var pdata = $(this).attr('data-value');\n\@@ -670,8 +1043,13 @@     \       url: actionurl+'?bustcache='+ new Date().getTime()+'&auto'+id+'=true',\n\     \       data: pdata,\n\     \       success: function (resp) {\n\-    \         id1."++method++"(resp);\n\-    \         ajaxGetLink(id)\n\+    \            var ind= resp.indexOf(' ');\n\+    \            var dat = resp.substr(ind);\n\+    \            var method= resp.substr(0,ind);\n\+    \            if(method== 'html')id1.html(dat);\n\+    \            else if (method == 'append') id1.append(dat);\n\+    \            else id1.prepend(dat);\n\+    \            ajaxGetLink(id);\n\     \       },\n\     \       error: function (xhr, status, error) {\n\     \           var msg = $('<div>' + xhr + '</div>');\n\@@ -681,11 +1059,11 @@     \$.ajax(dialogOpts);\n\     \return false;\n\     \});\n\-  \}"+  \}\n" -  ajaxPostForm = "function ajaxPostForm(id) {\n\+  ajaxPostForm = "\nfunction ajaxPostForm(id) {\n\     \var id1= $('#'+id);\n\-    \var idform= $('#'+id+' form');\n\+    \var idform= $('#'+id+' form[class!=\"_noAutoRefresh\"]');\n\     \idform.submit(function (event) {\n\         \if (hadtimeout == true) return true;\n\         \event.preventDefault();\n\@@ -693,12 +1071,17 @@         \var url = $form.attr('action');\n\         \var pdata = $form.serialize();\n\         \$.ajax({\n\-            \type: 'GET',\n\+            \type: 'POST',\n\             \url: url,\n\             \data: 'auto'+id+'=true&'+pdata,\n\             \success: function (resp) {\n\-                \id1."++method++"(resp);\n\-                \ajaxPostForm(id)\n\+    \            var ind= resp.indexOf(' ');\n\+    \            var dat = resp.substr(ind);\n\+    \            var method= resp.substr(0,ind);\n\+    \            if(method== 'html')id1.html(dat);\n\+    \            else if (method == 'append') id1.append(dat);\n\+    \            else id1.prepend(dat);\n\+    \            ajaxPostForm(id);\n\             \},\n\             \error: function (xhr, status, error) {\n\                 \var msg = $('<div>' + xhr + '</div>');\n\@@ -707,8 +1090,13 @@         \});\n\        \});\n\       \return false;\n\-     \}"+     \}\n" +timeoutscript t=+     "\nvar hadtimeout=false;\n\+     \if("++show t++" > 0)setTimeout(function() {hadtimeout=true; }, "++show (t*1000)++");\n"++ data UpdateMethod= Append | Prepend | Html deriving Show  -- | continously execute a widget and update the content.@@ -795,8 +1183,6 @@         requires [ServerProc (procname, proc),                   JScript $ ajaxPush procname,                   JScriptFile jqueryScript [installscript]]--      (ftag "div" <<< noWidget) <! [("id",id)]       <++ ftag "div" mempty `attrs` [("id",id++"status")]

@@ -1,66 +1,66 @@------------------------------------------------------------------------------------ Module      :  Control.MessageFlow.Forms.XHtml--- Copyright   :  Alberto Gónez Corona--- License     :  BSD3------ Maintainer  :  agocorona@gmail.com--- Stability   :  experimental----------------------------------------------------------------------------------{- | Instances of `FormInput`  for  the 'Text.XHtml' module of the xhtml package--}--{-# OPTIONS -XMultiParamTypeClasses-            -XFlexibleInstances-            -XUndecidableInstances-            -XTypeSynonymInstances-            -XFlexibleContexts-            -XTypeOperators-            #-}---module MFlow.Forms.XHtml where--import MFlow (HttpData(..))-import MFlow.Forms-import MFlow.Cookies(contentHtml)-import Data.ByteString.Lazy.Char8(pack,unpack)--import Text.XHtml.Strict as X-import Control.Monad.Trans-import Data.Typeable--instance Monad m => ADDATTRS (View Html m a) where-  widget ! atrs= widget `wmodify`  \fs mx -> return ((head fs ! atrs:tail fs), mx)----instance FormInput  Html  where-    toByteString  =  pack. showHtmlFragment-    toHttpData = HttpData [contentHtml] []  . toByteString-    ftag t= tag t-    inred = X.bold ![X.thestyle "color:red"]-    finput n t v f c= X.input ! ([thetype t ,name  n, value  v] ++ if f then [checked]  else []-                              ++ case c of Just s ->[strAttr "onclick"  s]; _ -> [] )-    ftextarea name text= X.textarea ! [X.name  name] <<  text--    fselect name list = select ![ X.name  name] << list-    foption  name v msel=  X.option ! ([value  name] ++ selected msel) <<  v-            where-            selected msel = if  msel then [X.selected] else []--    attrs tag attrs = tag ! (map (\(n,v) -> strAttr  n  v)  attrs)----    formAction action form = X.form ! [X.action  action, method "post"] << form-    fromStr = stringToHtml-    fromStrNoEncode= primHtml--    flink  v str = toHtml $ hotlink  (  v) << str--instance Typeable Html where-     typeOf =  \_ -> mkTyConApp (mkTyCon3 "xhtml" "Text.XHtml.Strict" "Html") []--+-----------------------------------------------------------------------------
+--
+-- Module      :  Control.MessageFlow.Forms.XHtml
+-- Copyright   :  Alberto Gónez Corona
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+--
+-----------------------------------------------------------------------------
+{- | Instances of `FormInput`  for  the 'Text.XHtml' module of the xhtml package
+-}
+
+{-# OPTIONS -XMultiParamTypeClasses
+            -XFlexibleInstances
+            -XUndecidableInstances
+            -XTypeSynonymInstances
+            -XFlexibleContexts
+            -XTypeOperators
+            #-}
+
+
+module MFlow.Forms.XHtml where
+
+import MFlow (HttpData(..))
+import MFlow.Forms
+import MFlow.Cookies(contentHtml)
+import Data.ByteString.Lazy.Char8(pack,unpack)
+import qualified Data.Text as T
+import Text.XHtml.Strict as X
+import Control.Monad.Trans
+import Data.Typeable
+
+instance Monad m => ADDATTRS (View Html m a) where
+  widget ! atrs= widget `wmodify`  \fs mx -> return ((head fs ! atrs:tail fs), mx)
+
+
+
+instance FormInput  Html  where
+    toByteString  =  pack. showHtmlFragment
+    toHttpData = HttpData [contentHtml] []  . toByteString
+    ftag t= tag t
+    inred = X.bold ![X.thestyle "color:red"]
+    finput n t v f c= X.input ! ([thetype t ,name  n, value  v] ++ if f then [checked]  else []
+                              ++ case c of Just s ->[strAttr "onclick"  s]; _ -> [] )
+    ftextarea name text= X.textarea ! [X.name  name] <<  T.unpack text
+
+    fselect name list = select ![ X.name  name] << list
+    foption  name v msel=  X.option ! ([value  name] ++ selected msel) <<  v
+            where
+            selected msel = if  msel then [X.selected] else []
+
+    attrs tag attrs = tag ! (map (\(n,v) -> strAttr  n  v)  attrs)
+
+
+
+    formAction action form = X.form ! [X.action  action, method "post"] << form
+    fromStr = stringToHtml
+    fromStrNoEncode= primHtml
+
+    flink  v str = toHtml $ hotlink  (  v) << str
+
+instance Typeable Html where
+     typeOf =  \_ -> mkTyConApp (mkTyCon3 "xhtml" "Text.XHtml.Strict" "Html") []
+
+

@@ -38,18 +38,22 @@ import Data.Monoid
 import MFlow.Wai.Response
 import Network.Wai
-import Network.HTTP.Types hiding (urlDecode)
+import Network.HTTP.Types -- hiding (urlDecode)
 import Data.Conduit
 import Data.Conduit.Lazy
 import qualified Data.Conduit.List as CList
 import Data.CaseInsensitive
 import System.Time
-import qualified Data.Text as T
+import qualified Data.Text as T 
 
 
-flow=  "flow"
 
 
+--import Debug.Trace
+--(!>) = flip trace
+
+flow=  "flow"
+
 instance Processable Request  where
    pwfPath  env=  if Prelude.null sc then [noScript] else Prelude.map T.unpack sc
       where
@@ -62,7 +66,7 @@    
    puser env = fromMaybe anonymous $ fmap SB.unpack $ lookup ( mk $SB.pack cookieuser) $ requestHeaders env
                     
-   pind env= fromMaybe (error ": No FlowID") $ fmap SB.unpack $ lookup  (mk $ SB.pack flow) $ requestHeaders env
+   pind env= fromMaybe (error ": No FlowID") $ fmap SB.unpack $ lookup  (mk flow) $ requestHeaders env
    getParams=    mkParams1 . requestHeaders
      where
      mkParams1 = Prelude.map mkParam1
@@ -87,7 +91,7 @@ 
 waiMessageFlow  ::  Request ->  ResourceT IO Response
 waiMessageFlow req1=   do
-     let httpreq1= getParams  req1 
+     let httpreq1= requestHeaders  req1 
 
      let cookies = getCookies  httpreq1
 
@@ -97,7 +101,7 @@                      fl <- liftIO $ newFlow
                      return (fl,  [(flow,  fl, "/",Nothing):: Cookie])
                      
-{-  for state persistence in cookies 
+{-   for state persistence in cookies 
      putStateCookie req1 cookies
      let retcookies= case getStateCookie req1 of
                                 Nothing -> retcookies1
@@ -105,20 +109,24 @@ -}
 
      input <- case parseMethod $ requestMethod req1  of
-              Right POST -> if  lookup  ("Content-Type") httpreq1 == Just "application/x-www-form-urlencoded"
-                  then do
+              Right POST -> do
                    inp <- liftIO $ runResourceT (requestBody req1 $$ CList.consume)
-                   return .  urlDecode $ concatMap SB.unpack  inp
-                  else return []
+                   return . parseSimpleQuery $ SB.concat inp
+
                   
-              Right GET -> let tail1 s | s==SB.empty =s
-                               tail1 xs= SB.tail xs
-                           in return . urlDecode $  SB.unpack   . tail1 $ rawQueryString req1  --  !> (SB.unpack $ rawQueryString req1)
-              x ->  return []
-              
+                  
+              Right GET ->
+                   let tail1 s | s==SB.empty =s
+                       tail1 xs= SB.tail xs 
+                   in
+                   return . Prelude.map (\(x,y) -> (x,fromMaybe "" y)) $ queryString req1
+
+
+                                        
+               
      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= mkParams (input ++ cookies) ++ requestHeaders req1}  -- !> "REQ"
+          _  -> req1{requestHeaders= mkParams ((flow, flowval): input ++ cookies) ++ requestHeaders req1}  --  !> "REQ"
 
 
      (resp',th) <- liftIO $ msgScheduler req      -- !> (show $ requestHeaders req)

@@ -15,18 +15,14 @@ module MFlow.Wai.Blaze.Html.All (
  module Data.TCache
 ,module MFlow
-,module MFlow.Wai
 ,module MFlow.Forms
 ,module MFlow.Forms.Widgets
 ,module MFlow.Forms.Blaze.Html
 ,module MFlow.Forms.Admin
-,module Network.Wai
-,module Network.Wai.Handler.Warp
 ,module Control.Applicative
---,module Text.Blaze.Internal
 ,module Text.Blaze.Html5
 ,module Text.Blaze.Html5.Attributes
-,module Control.Monad.IO.Class+,module Control.Monad.IO.Class
 ,runNavigation
 ) where
 
@@ -42,8 +38,8 @@ import Network.Wai
 import Network.Wai.Handler.Warp
 import Data.TCache
-import Text.Blaze.Internal(text)-+import Text.Blaze.Internal(text)
+
 import Control.Workflow (Workflow, unsafeIOtoWF)
 
 
@@ -52,54 +48,29 @@ import System.Environment
 import Data.Maybe(fromMaybe)
 import Data.Char(isNumber)
------ | run a transient flow (see 'transient'). 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.
---runServerTransient :: FormInput view => FlowM view IO () -> IO Bool---runServerTransient f= do
---    addMessageFlows[("", transient $ runFlow f)]---    porti <- getPort---    wait $ run porti waiMessageFlow-------- | a more grandiloquent name for runServerTransient---------- > runNavigation= runServerTransient---runNavigation :: FormInput view => FlowM view IO () -> IO Bool---runNavigation= runServerTransient----- 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-    args <- getArgs-    port <- case args of-           port:xs -> return port-           _  -> do-               env <- getEnvironment-               return $ fromMaybe "80" $ lookup "PORT" env-    let porti= if and $ map isNumber port then fromIntegral $ read port-                                          else 80-    putStr "using port "-    print porti-    return porti---- | run a persistent flow. 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.-runNavigation :: String -> FlowM Html (Workflow IO) () -> IO Bool-runNavigation n f= do-    addMessageFlows[(n, runFlow f)]
-    porti <- getPort-    wait $ run porti waiMessageFlow-    
------- | a more grandiloquent synonym of runServerTransient---------- > runPersNavigation= runServer---runPersistentNavigation :: FormInput view => FlowM view (Workflow IO) () -> IO Bool
---runPersistentNavigation= runServer
 
+-- | 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
+    args <- getArgs
+    port <- case args of
+           port:xs -> return port
+           _  -> do
+               env <- getEnvironment
+               return $ fromMaybe "80" $ lookup "PORT" env
+    let porti= if and $ map isNumber port then fromIntegral $ read port
+                                          else 80
+    putStr "using port "
+    print porti
+    return porti
 
+-- | run a persistent flow. 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.
+runNavigation :: String -> FlowM Html (Workflow IO) () -> IO Bool
+runNavigation n f= do
+    addMessageFlows[(n, runFlow f)]
+    porti <- getPort
+    wait $ run porti waiMessageFlow
+    

@@ -11,7 +11,7 @@ import Data.Monoid
 import System.IO.Unsafe
 import Data.Map as M
---import Data.CaseInsensitive
+import Data.CaseInsensitive
 import Network.HTTP.Types
 import Control.Workflow(WFErrors(..))
 import Data.String
@@ -36,9 +36,9 @@               Nothing -> error $ "fragment of type " ++ show ( typeOf  y)  ++ " after fragment of type " ++ show ( typeOf x)
 
 
-contentHtml1= [mkparam contentHtml] -- [(mk $ SB.pack "Content-Type", SB.pack  "text/html")]
 mkParams = Prelude.map mkparam
-mkparam (x,y)= (fromString  x, fromString y)
+mkparam (x,y)= (mk  x, y)
+
 instance ToResponse TResp where
   toResponse (TResp x)= toResponse x
   toResponse (TRespR r)= toResponse r
@@ -47,13 +47,13 @@       toResponse = id
 
 instance ToResponse B.ByteString  where
-      toResponse x= responseLBS status200 contentHtml1 {-,("Content-Length",show $ B.length x) -} x
+      toResponse x= responseLBS status200 [mkparam contentHtml]  x
 
 instance ToResponse String  where
-      toResponse x= responseLBS status200 contentHtml1 {-,("Content-Length",show $ B.length x) -} $ B.pack x
+      toResponse x= responseLBS status200 [mkparam contentHtml]  $ B.pack x
 
 instance  ToResponse HttpData  where
-  toResponse (HttpData hs cookies x)= responseLBS status200 (mkParams ( hs ++ cookieHeaders cookies)) x
+  toResponse (HttpData hs cookies x)= responseLBS status200 (mkParams ( hs <> cookieHeaders cookies)) x
   toResponse (Error str)=  responseLBS status404 [("Content-Type", "text/html")] str
 
 --  toResponse $ error "FATAL ERROR: HttpData errors should not reach here: MFlow.Forms.Response.hs "