MFlow 0.3.0.2 → 0.3.1.0

raw patch · 35 files changed

+1722/−1003 lines, 35 filesdep +hamletdep +monadlocPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hamlet, monadloc

API changes (from Hackage documentation)

Files

• Demos/Actions.hs +16/−0
• Demos/AjaxSample.hs +18/−0
• Demos/AutoCompList.hs +18/−0
• Demos/AutoComplete.hs +19/−0
• Demos/CheckBoxes.hs +17/−0
• Demos/Combination.hs +87/−0
• Demos/ContentManagement.hs +46/−0
• Demos/Counter.hs +34/−0
• Demos/Dialog.hs +20/−0
• Demos/Grid.hs +34/−0
• Demos/IncreaseInt.hs +19/−0
• Demos/IncreaseString.hs +16/−0
• Demos/ListEdit.hs +33/−0
• Demos/LoginSample.hs +27/−0
• Demos/Multicounter.hs +30/−0
• Demos/Options.hs +19/−0
• Demos/PreventGoingBack.hs +27/−0
• Demos/PushDecrease.hs +40/−0
• Demos/PushSample.hs +47/−0
• Demos/Radio.hs +13/−0
• Demos/ShopCart.hs +59/−0
• Demos/SumView.hs +24/−0
• Demos/TestREST.hs +45/−0
• Demos/TraceSample.hs +26/−0
• Demos/demos-blaze.hs +127/−433
• Demos/testREST.hs +0/−26
• MFlow.cabal +107/−70
• src/MFlow.hs +202/−114
• src/MFlow/Cookies.hs +4/−4
• src/MFlow/Forms.hs +124/−112
• src/MFlow/Forms/Internals.hs +195/−178
• src/MFlow/Forms/Test.hs +7/−9
• src/MFlow/Forms/Widgets.hs +212/−50
• src/MFlow/Wai.hs +6/−6
• src/MFlow/Wai/Response.hs +4/−1

@@ -0,0 +1,16 @@+
+module Actions (actions) where
+
+import MFlow.Wai.Blaze.Html.All
+
+actions n= do
+  r<- ask $   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"
+  where
+  action n=  ask $ getString (Just $ n ++ " action")<** submitButton "submit action"
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav actions

@@ -0,0 +1,18 @@+
+
+module AjaxSample ( ajaxsample) where
+import MFlow.Wai.Blaze.Html.All
+import Data.Monoid
+import Data.ByteString.Lazy.Char8 as B
+ajaxsample= do
+   r <- ask $   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"
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav ajaxsample

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

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

@@ -0,0 +1,17 @@+
+module CheckBoxes ( checkBoxes) where
+import MFlow.Wai.Blaze.Html.All
+import Data.Monoid
+
+checkBoxes= do
+   r <- ask $ 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")
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav checkBoxes

@@ -0,0 +1,87 @@+
+module Combination ( combination, wlogin) where
+import MFlow.Wai.Blaze.Html.All
+import Counter(counterWidget)
+import Data.String
+
+text= fromString
+
+combination =  ask $ 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 << "Counter widget" ++> autoRefresh (pageFlow "c" (counterWidget 0))  <++ hr
+     **> p << "Dynamic form widget" ++> autoRefresh (pageFlow "f" formWidget) <++ hr
+     **> wlink () << b << "exit"
+
+formWidget :: View Html IO ()
+formWidget=   do
+      (n,s) <- (,) <$> p << "Who are you?"
+                   ++> getString Nothing <! hint "name"     <++ br
+                   <*> getString Nothing <! hint "surname"  <++ br
+                   <** submitButton "ok" <++ br
+
+      flag <- b << "Do you " ++> getRadio[radiob "work?",radiob "study?"] <++ br
+
+      r<- case flag of
+         "work?" -> pageFlow "l"
+                     $ Left  <$> b << "do you enjoy your work? "
+                             ++> getBool True "yes" "no"
+                             <** submitButton "ok" <++ br
+
+         "study?"-> pageFlow "r"
+                     $ Right <$> b << "do you study in "
+                             ++> getRadio[radiob "University"
+                                         ,radiob "High School"]
+      u <-  getCurrentUser
+      p << ("You are "++n++" "++s)
+        ++> p << ("And your user is: "++ u)
+        ++> case r of
+             Left fl ->   p << ("You work and it is " ++ show fl ++ " that you enjoy your work")
+                            ++> noWidget
+
+             Right stu -> p << ("You study at the " ++ stu)
+                            ++> noWidget
+
+
+
+hint s= [("placeholder",s)]
+onClickSubmit= [("onclick","if(window.jQuery){\n\
+                                  \$(this).parent().submit();}\n\
+                           \else {this.form.submit()}")]
+radiob s n= wlabel (text s) $ setRadio s n <! onClickSubmit
+
+
+
+-- | If not logged, it present a page flow which ask 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)
+
+   `wcallback` (\name -> b << ("logged as " ++ name)
+                     ++> p << ("navigate away of this page before logging out")
+                     ++>  wlink "logout"  << b << " logout")
+   `wcallback`  const (logout >>  wlogin)
+
+focus = [("onload","this.focus()")]
+
+
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav  combination
+

@@ -0,0 +1,46 @@+
+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
+
+textEdit= do
+    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"
+        ++> 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
+        **> 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"
+
+    ask $   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

@@ -0,0 +1,34 @@+
+module Counter ( counter, counterWidget) where
+import MFlow.Wai.Blaze.Html.All
+import Data.Monoid
+import Data.String
+
+attr= fromString
+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
+       ++> pageFlow "c" (counterWidget 0) <++ br
+       <|> wlink () << p << "exit"
+
+counterWidget n= 
+      (h2 << show n     
+       ++> wlink "i" << b << " ++ "
+       <|> wlink "d" << b << " -- ")
+      `wcallback`
+        \op -> case op  of
+          "i" -> counterWidget (n + 1)                       
+          "d" -> counterWidget (n - 1)
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav counter

@@ -0,0 +1,20 @@+
+module Dialog (wdialog1) where
+
+import MFlow.Wai.Blaze.Html.All
+
+wdialog1= do
+   ask  wdialogw
+   ask (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"
+   wdialog "({modal: true})" "question"  $ 
+           p << ("Do your name is \""++r++"\"?") ++> getBool True "yes" "no" <** submitButton "ok"
+
+  `wcallback` \q -> if not q then wdialogw
+                      else  wlink () << b << "thanks, press here to exit from the page Flow"
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav wdialog1

@@ -0,0 +1,34 @@+
+module Grid ( grid) where
+
+import MFlow.Wai.Blaze.Html.All
+import Data.String
+import Text.Blaze.Html5.Attributes as At hiding (step)
+
+attr= fromString
+
+grid = do
+  r <- ask $   addLink
+           ++> wEditList table  row ["",""] "wEditListAdd"
+           <** submitButton "submit"
+           
+  ask $   p << (show r ++ " returned")
+      ++> wlink () (p <<  " back to menu")
+      
+  where
+  row _= tr <<< ( (,) <$> tdborder <<< getInt (Just 0)
+                          <*> tdborder <<< getTextBox (Just "")
+                          <++ tdborder << delLink)
+                          
+  addLink= a ! href (attr "#")
+             ! At.id (attr "wEditListAdd")
+             <<  "add"
+             
+  delLink= a ! href (attr "#")
+             ! onclick (attr "this.parentNode.parentNode.parentNode.removeChild(this.parentNode.parentNode)")
+             <<  "delete"
+             
+  tdborder= td ! At.style  (attr "border: solid 1px")
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav grid

@@ -0,0 +1,19 @@+
+module IncreaseInt ( clickn) where
+
+import MFlow.Wai.Blaze.Html.All
+
+-- |+| add a widget before and after another and return both results.
+-- in this case, a link wraps a form field
+
+clickn n= do
+   r <- ask $   p << b <<  "increase an Int"
+            ++> wlink "menu"  << p <<  "menu"      
+            |+| getInt (Just n)  <* submitButton "submit"
+
+   case r of
+    (Just _,_) -> return ()  --  ask $ wlink () << p << "thanks"
+    (_, Just n') -> clickn $ n'+1
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav sumWidget

@@ -0,0 +1,16 @@+
+module IncreaseString ( clicks) where
+
+import MFlow.Wai.Blaze.Html.All
+
+clicks s= do
+   s' <- ask $  p << b <<  "increase a String"
+             ++> p << b <<  "press the back button to go back to the menu"
+             ++>(getString (Just s)
+             <* submitButton "submit")
+             `validate` (\s -> return $ if length s   > 5 then Just (b << "length must be < 5") else Nothing )
+   clicks $ s'++ "1"
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav clicks "1"

@@ -0,0 +1,33 @@+
+module ListEdit ( wlistEd) where
+
+import MFlow.Wai.Blaze.Html.All
+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
+              ++> br
+              ++> (wEditList El.div getString1   ["hi", "how are you"] "wEditListAdd")
+              <++ br
+              <** submitButton "send"
+
+   ask $   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)")
+   getString1 mx= El.div  <<< delBox ++> getString  mx <++ br
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav wListEd
+

@@ -0,0 +1,27 @@+
+module LoginSample ( loginSample) where
+
+import MFlow.Wai.Blaze.Html.All
+import Data.Monoid
+
+loginSample= do
+    r <- ask $   p <<  "Please login with admin/admin"
+             ++> userWidget (Just "admin") 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"
+
+        if r
+          then do
+             logout
+             ask $ p << "logged out" ++> wlink () << "press here to exit"
+          else return ()
+  
+
+-- to run it alone:
+-- main= runNavigation "" $ transientNav loginSample

@@ -0,0 +1,30 @@+
+module Multicounter ( multicounter) where
+
+import MFlow.Wai.Blaze.Html.All
+import Data.Monoid
+import Data.String
+import Counter(counterWidget)
+
+text= fromString
+attr= fromString
+
+multicounter=
+ ask $   explain
+     ++> add (counterWidget 0) [1..4]
+     <|> wlink () << p << "exit"
+
+ where
+ explain= p << "This example emulates the"
+          <> a ! href (attr "http://www.seaside.st/about/examples/multicounter")
+                << " seaside example"
+          <> p << "It uses various copies of the " <> a ! href (attr "/noscript/counter") << "counter widget "
+          <> text "instantiated in the same page. This is an example of how it is possible to "
+          <> text "compose widgets with independent behaviours"
+
+
+ add widget list= firstOf [autoRefresh $ pageFlow (show i) widget <++ hr | i <- list]
+
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav multicounter

@@ -0,0 +1,19 @@+
+module Options (options) where
+
+import MFlow.Wai.Blaze.Html.All
+
+options= do
+   r <- ask $ 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")
+
+
+   where
+   dosummit= [("onchange","this.form.submit()")]
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav options

@@ -0,0 +1,27 @@+
+module PreventGoingBack ( preventBack) where
+import MFlow.Wai.Blaze.Html.All
+import System.IO.Unsafe
+import Control.Concurrent.MVar
+
+rpaid= unsafePerformIO $ newMVar (0 :: Int)
+
+
+preventBack= do
+    ask $ wlink () << 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"
+                           ++> wlink () << p << "Please press here to continue"
+                           
+    ask $   p << ("you paid "++ show paid)
+        ++> wlink () << p << "Press here to go to the menu or press the back button to verify that you can not pay again"
+    where
+    payIt= liftIO $ do
+      print "paying"
+      paid <- takeMVar  rpaid
+      putMVar rpaid $ paid + 100000
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav preventBack

@@ -0,0 +1,40 @@+{-# OPTIONS -XQuasiQuotes #-}
+module PushDecrease ( pushDecrease) where
+
+import MFlow.Wai.Blaze.Html.All
+import Control.Concurrent.STM
+import Text.Hamlet
+import Control.Concurrent
+
+
+atomic= liftIO . atomically
+
+pushDecrease= do
+ tv <- liftIO $ newTVarIO 10
+
+ page $
+      [shamlet|
+       <div>
+           <h2> Maxwell Smart push counter
+           <p> This example shows a reverse counter
+           <p> To avoid unnecessary load, the push process will be killed when reaching 0
+           <p> The last push message will be an script that will redirect to the menu"
+           <h3> This message will be autodestroyed within ...
+
+      |] ++> counter tv <++  b << "seconds"
+
+ where
+ counter tv = push Html 0 $ do
+      setTimeouts 2 0     -- kill  the thread when count finish
+      n <- atomic $ readTVar tv
+      if (n== -1)
+        then  do
+          script << "window.location='/'" ++> noWidget
+        else do
+          atomic $ writeTVar tv $ n - 1
+          liftIO $ threadDelay 1000000
+          h1 << (show n) ++> noWidget
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav pushDecrease
+

@@ -0,0 +1,47 @@+
+module PushSample (pushSample) where
+
+import MFlow.Wai.Blaze.Html.All
+import Control.Concurrent.STM
+
+
+pushSample=  do
+  tv <- liftIO $ newTVarIO $ Just "The content will be appended here"
+  page $   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"
+       ++> p << "The input box is configured with autoRefresh"
+       ++> hr
+
+       ++> pageFlow "push" (push Append 5000 (disp tv) <** input tv)
+       **> br
+       ++> br
+       ++> wlink () << b << "exit"
+
+  where
+  -- the widget being pushed:
+  disp tv= do
+      setTimeouts 100 0
+      line <- tget tv
+      p <<  line ++> noWidget
+
+  input tv= autoRefresh  $ do
+      line <- getString Nothing <** submitButton "Enter"
+      tput tv line
+
+
+  tput tv x = atomic $ writeTVar  tv ( Just x)
+
+  tget tv= atomic $ do
+      mr <- readTVar tv
+      case mr of
+         Nothing -> retry
+         Just r -> do
+          writeTVar tv Nothing
+          return r
+
+atomic= liftIO . atomically
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav pushSample

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

@@ -0,0 +1,59 @@+
+{-# OPTIONS  -XDeriveDataTypeable #-}
+module ShopCart ( shopCart) where
+
+import MFlow.Wai.Blaze.Html.All
+import Data.Typeable
+import qualified Data.Vector as V
+import Text.Blaze.Html5 as El
+import Text.Blaze.Html5.Attributes as At hiding (step)
+import Data.Monoid
+import Data.String
+import Data.Typeable
+
+data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum, Show,Read , Typeable)
+
+
+newtype Cart= Cart (V.Vector Int) deriving Typeable
+emptyCart= Cart $ V.fromList [0,0,0]
+
+shopCart  = 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."
+
+     <> 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"
+             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 <<  linkHome
+                  ))
+     let i =fromEnum o
+     Cart cart <- getSessionData `onNothing` return emptyCart
+     setSessionData . Cart $ cart V.// [(i, cart V.!  i + 1 )]
+     shopCart1
+
+    where
+    linkHome= a ! href  (attr $ "/" ++ noScript) << b <<  "home"
+    attr= fromString
+
+-- to run it alone:
+--main= runNavigation ""   shopCart

@@ -0,0 +1,24 @@+
+module SumView (sumInView) where
+
+import MFlow.Wai.Blaze.Html.All
+
+sumInView= ask $ 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
+               
+sumWidget=   pageFlow "sum" $ do
+      n <- do
+           n1 <- p << "Enter first number"  ++> getInt Nothing <++ br
+           n2 <- p << "Enter second number" ++> getInt Nothing <++ br
+           n3 <- p << "Enter third number"  ++> getInt Nothing <++ br
+           return (n1+ n2 + n3)
+
+          -- factoring out the button
+          <**  br ++> pageFlow "button" (submitButton "submit")
+           
+      p <<  ("The result is: "++show n)  ++>  wlink () << b << " menu"
+      <++ p << "you can change the numbers in the boxes to see how the result changes"
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav sumWidget

@@ -0,0 +1,45 @@+
+module TestREST where
+import MFlow.Wai.Blaze.Html.All
+import Data.Monoid
+import Data.String
+
+-- 9 pages , each page has a restful link (page = ask)
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav testREST
+
+
+testREST= do
+  setTimeouts 120 0
+
+  addHeader header1
+
+  option <- page $   wlink "a" << p << "letters " <++ p << "or"
+                 <|> wlink "1" << p << "numbers"
+
+  case option of
+    "1" -> do
+          page $ wlink "2" << contentFor "1"
+          page $ wlink "3" << contentFor "2"
+          page $ wlink "4" << contentFor "3"
+          page $ wlink ()  << "menu"
+
+    "a" -> do
+          page $ wlink "b" << contentFor "a"
+          page $ wlink "c" << contentFor "b"
+          page $ wlink "d" << contentFor "c"
+          page $ wlink ()  << "menu"
+
+
+contentFor x=
+        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"
+

@@ -0,0 +1,26 @@+{-# OPTIONS -F -pgmF MonadLoc #-}
+module TraceSample ( traceSample) where
+
+import MFlow.Wai.Blaze.Html.All
+import Control.Monad.Loc
+
+traceSample= do
+  page $   h2 << "Error trace example"
+       ++> p << "MFlow now produces execution traces in case of error by making use of the backtracking mechanism"
+       ++> p << "It is more detailed than a call stack"
+       ++> p << "this example has a deliberate error"
+       ++> br
+       ++> p << "You must be logged as admin to see the trace"
+       ++> wlink () << p << "pres here"
+
+  page $   p <<  "Please login with admin/admin"
+       ++> userWidget (Just "admin") userLogin
+
+  u <- getCurrentUser
+  page $   p << "The trace will appear after you press the link. press one of the options available at the bottom of the page"
+       ++> p << ("user="++ u) ++> br
+       ++> wlink () << "press here"
+  page $   error $ "this is the error"
+
+-- to run it alone:
+--main= runNavigation "" $ transientNav traceSample

@@ -1,58 +1,82 @@-{-# LANGUAGE  DeriveDataTypeable, QuasiQuotes #-}
+{-# OPTIONS  -XDeriveDataTypeable -XQuasiQuotes  -F -pgmF MonadLoc #-}
 module Main where
 import MFlow.Wai.Blaze.Html.All
 import Text.Blaze.Html5 as El
 import Text.Blaze.Html5.Attributes as At hiding (step)
-import Data.List
+
 import Data.Typeable
-import Control.Monad.Trans
 
-import qualified Data.ByteString.Lazy.Char8 as B
---import qualified Data.Text as T
-import qualified Data.Vector as V
-import Data.Maybe
 import Data.Monoid
-import System.IO.Unsafe
-import Debug.Trace import Data.String
-import Control.Concurrent.MVar--import Text.Hamlet 
----
---import Control.Monad.State
---import MFlow.Forms.Internals
-(!>) = const -- flip trace
+import Text.Hamlet
 
---test= runTest [(15,"shop")]
+-- For error traces
+import Control.Monad.Loc
 
+import TestREST
+import Actions
+import IncreaseInt
+import ShopCart
+import AjaxSample
+import IncreaseString
+import AutoCompList
+import ListEdit
+import AutoComplete
+import LoginSample
+import CheckBoxes
+import Multicounter
+import Combination
+import Options
+import ContentManagement
+import PreventGoingBack
+import Counter
+import PushDecrease
+import Dialog
+import PushSample
+import Grid
+import Radio
+import SumView
+
+
+
 main= do
    setAdminUser "admin" "admin"
    syncWrite SyncManual
-   setFilesPath ""
-   addMessageFlows  [("shop", runFlow shopCart)]+   setFilesPath "Demos/"
+   addMessageFlows  [("shop"      , runFlow $ shopCart  `showSource` "ShopCart.hs")
+                    ,("navigation", runFlow $ transientNav testREST `showSource` "TestREST.hs")]
+
    runNavigation "" $  transientNav mainmenu
 
+
 attr= fromString
-text = toMarkup
+text= fromString
 
 data Options= CountI | CountS | Radio
             | Login | TextEdit |Grid | Autocomp | AutocompList
             | ListEdit |Shop | Action | Ajax | Select
             | CheckBoxes | PreventBack | Multicounter
             | Combination
-            | FViewMonad | Counter | WDialog
+            | FViewMonad | Counter | WDialog |Push |PushDec |Trace
             deriving (Bounded, Enum,Read, Show,Typeable)
 
 
 mainmenu=   do
-       setHeader stdheader
+       setHeader stdheader 
        setTimeouts 100 0
-       r <- ask $  do-              -- includes an style
-              requires[CSSFile "http://jqueryui.com/resources/demos/style.css"]
-              wcached "menu" 0 $
-               b <<  "BASIC"
+       r <- ask $  wcached "menu" 0 $
+               b <<  "PUSH"
+               ++> br ++> wlink Push    << b << "Example of a widget with push"
+               <|> br ++> wlink PushDec << b << "A push counter"
+               <|> br ++> br
+                 ++> b <<  "ERROR TRACES"
+               ++> br ++> wlink Trace << b << "Execution traces for errors"
+               <|> br ++> br ++>
+               b <<  "DIFFERENT KINDS OF FLOWS"
+               ++> br ++>  a ! href (attr "/navigation") <<  "REST navigation"   -- ordinary Blaze.Html link
+               ++> br ++>  a ! href (attr "/shop") <<  "stateful flow: shopping"   -- ordinary Blaze.Html link
+                       
+               ++>  br ++> br ++> b <<  "BASIC"
                ++>  br ++> wlink CountI       << b <<  "increase an Int"
                <|>  br ++> wlink CountS       << b <<  "increase a String"
                <|>  br ++> wlink Select       << b <<  "select options"
@@ -67,438 +91,108 @@                <|>  br ++> wlink Combination  << b <<  "combination of three active widgets"
                <|>  br ++> wlink WDialog      << b <<  "modal dialog"
 
-               <++  br <>  br                 <> b <<  "DYNAMIC WIDGETS"
-               <|>  br ++> wlink Ajax         << b <<  "AJAX example"
+               <|>  br ++>  br               ++> b <<  "DYNAMIC WIDGETS"
+               ++>  br ++> wlink Ajax         << b <<  "AJAX example"
                <|>  br ++> wlink Autocomp     << b <<  "autocomplete"
                <|>  br ++> wlink AutocompList << b <<  "autocomplete List"
                <|>  br ++> wlink ListEdit     << b <<  "list edition"
                <|>  br ++> wlink Grid         << b <<  "grid"
                <|>  br ++> wlink TextEdit     << b <<  "Content Management"
-               <++  br <>  br                 <> b <<  "STATEFUL PERSISTENT FLOW"
-                 <> br <>  a ! href (attr "/shop") <<  "shopping"   -- ordinary Blaze.Html link
 
-                 <> br <>  br <> b <<  "OTHERS"
-               <|>  br ++> wlink Login        << b <<  "login/logout"
+               <|>  br ++>  br ++> b <<  "OTHERS"
+               ++>  br ++> wlink Login        << b <<  "login/logout"
                <|>  br ++> wlink PreventBack  << b <<  "Prevent going back after a transaction"
 
 
 
        case r of
-             CountI    ->  clickn  (0 :: Int)
-             CountS    ->  clicks "1"
-             Action    ->  actions 1
-             Ajax      ->  ajaxsample
-             Select    ->  options
-             CheckBoxes -> checkBoxes
-             TextEdit  ->  textEdit
-             Grid      ->  grid
-             Autocomp  ->  autocomplete1
-             AutocompList -> autocompList
-             ListEdit  ->  wlistEd
-             Radio     ->  radio
-             Login     ->  loginSample
-             PreventBack -> preventBack
-             Multicounter-> multicounter
-             FViewMonad  -> sumInView
-             Counter    -> counter
-             Combination -> combination
-             WDialog     -> wdialog1
-
-wdialog1= do-   ask  wdialogw-   ask (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"
-   wdialog "({modal: true})" "question"  $ 
-           p << ("Do your name is \""++r++"\"?") ++> getBool True "yes" "no" <** submitButton "ok"
--  `wcallback` \q -> if not q then wdialogw-                      else  wlink () << b << "thanks, press here to exit from the page Flow"
-
-
-sumInView= ask $ 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
-
-formWidget :: View Html IO ()
-formWidget=   do
-      (n,s) <- (,) <$> p << "Who are you?"
-                   ++> getString Nothing <! hint "name"     <++ br
-                   <*> getString Nothing <! hint "surname"  <++ br
-                   <** submitButton "ok" <++ br
-
-      flag <- b << "Do you " ++> getRadio[radiob "work?",radiob "study?"] <++ br
-
-      r<- case flag of
-         "work?" -> pageFlow "l"
-                     $ Left  <$> b << "do you enjoy your work? "
-                             ++> getBool True "yes" "no"
-                             <** submitButton "ok" <++ br
-
-         "study?"-> pageFlow "r"
-                     $ Right <$> b << "do you study in "
-                             ++> getRadio[radiob "University"
-                                         ,radiob "High School"]
-      u <-  getCurrentUser
-      p << ("You are "++n++" "++s)
-        ++> p << ("And your user is: "++ u)
-        ++> case r of
-             Left fl ->   p << ("You work and it is " ++ show fl ++ " that you enjoy your work")
-                            ++> noWidget
-
-             Right stu -> p << ("You study at the " ++ stu)
-                            ++> noWidget
-
-
-hint s= [("placeholder",s)]
-onClickSubmit= [("onclick","if(window.jQuery){\n\
-                                  \$(this).parent().submit();}\n\
-                           \else {this.form.submit()}")]
-radiob s n= wlabel (text s) $ setRadio s n <! onClickSubmit
-
-sumWidget= pageFlow "sum" $ do
-      n1 <- p << "Enter first number"  ++> getInt Nothing <** submitButton "enter" <++ br
-      n2 <- p << "Enter second number" ++> getInt Nothing <** submitButton "enter" <++ br
-      n3 <- p << "Enter third number"  ++> getInt Nothing <** submitButton "enter" <++ br
-      p <<  ("The result is: "++show (n1 + n2 + n3))  ++>  wlink () << b << " menu"
-      <++ p << "you can change the numbers in the boxes to see how the result changes"
-
-
-
-combination =  ask $ 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 << "Counter widget" ++> autoRefresh (pageFlow "c" (counterWidget 0))  <++ hr
-     **> p << "Dynamic form widget" ++> autoRefresh (pageFlow "f" formWidget) <++ hr
-     **> wlink () << b << "exit"
-
-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)
-
-   `wcallback` (\name -> b << ("logged as " ++ name)
-                     ++> p << ("navigate away of this page before logging out")
-                     ++>  wlink "logout"  << b << " logout")
-   `wcallback`  const (logout >>  wlogin)
-
-focus = [("onload","this.focus()")]
-
-
-multicounter= do
- let explain= p << "This example emulates the"
-              <> a ! href (attr "http://www.seaside.st/about/examples/multicounter?_k=yBJEDEGp")
-                    << " seaside example"
-              <> p << "It uses various copies of the " <> a ! href (attr "/noscript/counter") << "counter widget "
-              <> text "instantiated in the same page. This is an example of how it is possible to "
-              <> text "compose widgets with independent behaviours"
-
- ask $ explain ++> add (counterWidget 0) [1..4] <|> wlink () << p << "exit"
-
-
-add widget list= firstOf [autoRefresh $ pageFlow (show i) widget <++ hr | i <- list]
-
-counter1= do
-    ask $ wlink "p" <<p<<"press here"
-    ask $ pageFlow "c" $ ex  [ wlink i << text (show (i :: Int)) | i <- [1..] ]
-               where
-
-               ex (a:as)= a >> ex as
-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 ++> pageFlow "c" (counterWidget 0) <++ br <|> wlink () << p << "exit"
-
-counterWidget n= do
-  (h2 << show n !> show n
-   ++> wlink "i" << b << " ++ "
-   <|> wlink "d" << b << " -- ")
-  `wcallback`
-    \op -> case op  of
-      "i" -> counterWidget (n + 1)    !> "increment"
-      "d" -> counterWidget (n - 1)    !> "decrement"
-
-rpaid= unsafePerformIO $ newMVar (0 :: Int)
-
-
-preventBack= do
-    ask $ wlink () << 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"
-                           ++> wlink () << p << "Please press here to continue"
-    ask $   p << ("you paid "++ show paid)
-        ++> wlink () << p << "Press here to go to the menu or press the back button to verify that you can not pay again"
-    where
-    payIt= liftIO $ do
-      print "paying"
-      paid <- takeMVar  rpaid
-      putMVar rpaid $ paid + 100000
-
-options= do
-   r <- ask $ getSelect (setSelectedOption ""  (p <<  "select a option") <|>
-                         setOption "red"  (b <<  "red")     <|>
-                         setSelectedOption "blue" (b <<  "blue")    <|>
-                         setOption "Green"  (b <<  "Green")  )
-                         <! dosummit
-   ask $ p << (r ++ " selected") ++> wlink () (p <<  " menu")
-
-
-   where
-   dosummit= [("onchange","this.form.submit()")]
-
-checkBoxes= do
-   r <- ask $ 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")
-
-
-autocomplete1= do
-   r <- ask $   p <<  "Autocomplete "
-            ++> p <<  "when su press submit, the box value  is returned"
-            ++> wautocomplete Nothing filter1 <! hint "red,green or blue"
-            <** submitButton "submit"
-   ask $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
-
-   where
-   filter1 s = return $ filter (isPrefixOf s) ["red","reed rose","green","green grass","blue","blues"]
-
-autocompList= do
-   r <- ask $   p <<  "Autocomplete with a list of selected entries"
-            ++> p <<  "enter  and press enter"
-            ++> p <<  "when su press submit, the entries are returned"
-            ++> wautocompleteList "red,green,blue" filter1 ["red"]
-            <** submitButton "submit"
-   ask $ p << ( show r ++ " selected")  ++> wlink () (p <<  " menu")
-
-   where
-   filter1 s = return $ filter (isPrefixOf s) ["red","reed rose","green","green grass","blue","blues"]
-
-grid = do
-  let row _= tr <<< ( (,) <$> tdborder <<< getInt (Just 0)
-                          <*> tdborder <<< getTextBox (Just "")
-                          <++ tdborder << delLink)
-      addLink= a ! href (attr "#")
-                 ! At.id (attr "wEditListAdd")
-                 <<  "add"
-      delLink= a ! href (attr "#")
-                 ! onclick (attr "this.parentNode.parentNode.parentNode.removeChild(this.parentNode.parentNode)")
-                 <<  "delete"
-      tdborder= td ! At.style  (attr "border: solid 1px")
-
-  r <- ask $ addLink ++> ( wEditList table  row ["",""] "wEditListAdd") <** submitButton "submit"
-  ask $   p << (show r ++ " returned")
-      ++> wlink () (p <<  " back to menu")
-
-
-
-wlistEd= do
-   r <-  ask  $   addLink
-              ++> br
-              ++> (wEditList El.div getString1   ["hi", "how are you"] "wEditListAdd")
-              <++ br
-              <** submitButton "send"
-
-   ask $   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)")
-   getString1 mx= El.div  <<< delBox ++> getString  mx <++ br
-
-
-clickn n= do
-   r <- ask $   p << b <<  "increase an Int"
-            ++> wlink "menu"  << p <<  "menu"
-            |+|  getInt (Just n)  <* submitButton "submit"
-   case r of
-    (Just _,_) -> return ()  --  ask $ wlink () << p << "thanks"
-    (_, Just n') -> clickn $ n'+1
-
-
-clicks s= do
-   s' <- ask $  p << b <<  "increase a String"
-             ++> p << b <<  "press the back button to go back to the menu"
-             ++>(getString (Just s)
-             <* submitButton "submit")
-             `validate` (\s -> return $ if length s   > 5 then Just (b << "length must be < 5") else Nothing )
-   clicks $ s'++ "1"
-
-
-radio = do
-   r <- ask $    p << b <<  "Radio buttons"
-             ++> getRadio [\n -> fromStr v ++> setRadioActive v n | v <- ["red","green","blue"]]
-
-   ask $ p << ( show r ++ " selected")  ++> wlink ()  << p <<  " menu"
-
-ajaxsample= do
-   r <- ask $   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"
-
-
----- recursive action
---actions n=do
---  ask $ wlink () (p <<  "exit from action")
---     <**((getInt (Just (n+1)) <** submitButton "submit" ) `waction` actions )
-
-
-actions n= do
-  r<- ask $   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"
-  where
-  action n=  ask $ getString (Just $ n ++ " action")<** submitButton "submit action"
-
-data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum, Show,Read , Typeable)
-
-newtype Cart= Cart (V.Vector Int) deriving Typeable
-emptyCart= Cart $ V.fromList [0,0,0]
-
-shopCart  = do
-
-   setHeader $ \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 enclosed 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."
-
-     <> 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"
-             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 <<  linkHome
-                  ))
-     let i =fromEnum o
-     Cart cart <- getSessionData `onNothing` return emptyCart
-     setSessionData . Cart $ cart V.// [(i, cart V.!  i + 1 )]
-     shopCart1
-
-    where
-    linkHome= a ! href  (attr $ "/" ++ noScript) << b <<  "home"
-
-
-loginSample= do
-    ask $ p <<  "Please login with admin/admin"
-            ++> userWidget (Just "admin") userLogin
-    user <- getCurrentUser
-    ask $ b <<  ("user logged as " <>  user) ++> wlink ()  << p <<  " logout and go to menu"
-    logout
-
-
-
-textEdit= do
-    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"
-        ++> first
-        ++> second
-        ++> wlink ()  << p <<  "click here to edit it"
+             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"
 
 
-    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
-        **> wlink ()  << p <<  "click here to see it as a normal user"
-
-    logout
+showSource w filename = do
+      host <- getRawParam "Host" `onNothing` return "mflowdemo.herokuapp.com/"
+      let path=  attr $ "http://" <> host <> ('/':filename)
+      addHeader $ source path
+      w
+      where
+      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;"
 
-    ask $   p <<  "the user sees the edited content. He can not edit"
-        ++> tFieldEd "first"  first
-        **> tFieldEd "second" second
-        **> wlink ()  << p <<  "click to continue"
+traceSample= do
+  page $   h2 << "Error trace example"
+       ++> p << "MFlow now produces execution traces in case of error by making use of the backtracking mechanism"
+       ++> p << "It is more detailed than a call stack"
+       ++> p << "this example has a deliberate error"
+       ++> br
+       ++> p << "You must be logged as admin to see the trace"
+       ++> wlink () << p << "pres here"
 
-    ask $   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"
+  page $   p <<  "Please login with admin/admin"
+       ++> userWidget (Just "admin") userLogin
 
+  u <- getCurrentUser
+  page $   p << "The trace will appear after you press the link. press one of the options available at the bottom of the page"
+       ++> p << ("user="++ u) ++> br
+       ++> wlink () << "press here"
+  page $   error $ "this is the error"
 
 
---stdheader= html . body
-
-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"))+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  "/html/MFlow/index.html") << h1 <<  "MFlow"
+      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;") $
-          h2 <<  "Example of some features."
---       <> h3 <<  "This demo uses warp and blaze-html"
-
-       <> br <> c)
+          br <> c)
    <> (El.div ! At.style (attr "float:right;width:45%;overflow:auto;") $
-          h2 <<  "Documentation"
-       <> br
+
+       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/demos-blaze.hs") <<  "download demo source code"
+       <> 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"
-       <> [shamlet| <script type="text/javascript" src="http://output18.rssinclude.com/output?type=js&amp;id=727700&amp;hash=8aa6c224101cac4ca2a7bebd6e28a2d7"></script>|]-+       <> [shamlet| <script type="text/javascript" src="http://output18.rssinclude.com/output?type=js&amp;id=727700&amp;hash=8aa6c224101cac4ca2a7bebd6e28a2d7"></script>|]
+
               ))

@@ -1,26 +0,0 @@-import MFlow.Wai.Blaze.Html.All---- 9 pages , each page has a restful link (page = ask)-main= runNavigation "" $ transientNav $ do-  liftIO $ print "start/restart"--  setHeader $ html . body--  option <- page $   wlink "a" << p << "letters " <++ p << "or"-                 <|> wlink "1" << p << "numbers"--  case option of-    "1" -> do-          page $ wlink "2" << cont "1"-          page $ wlink "3" << cont "2"-          page $ wlink "4" << cont "3"-          page $ wlink ()  <<  "menu"--    "a" -> do-          page $ wlink "b" << cont "a"-          page $ wlink "c" << cont "b"-          page $ wlink "d" << cont "c"-          page $ wlink ()  <<  "menu"---cont x= p << ("page for " ++ x ++ " goto next page")

@@ -1,5 +1,5 @@ name: MFlow
-version: 0.3.0.2
+version: 0.3.1.0
 cabal-version: >=1.8
 build-type: Simple
 license: BSD3
@@ -8,77 +8,109 @@ stability: experimental
 Bug-reports: https://github.com/agocorona/MFlow/issues
 synopsis: stateful, RESTful web framework
-description: MFlow run stateful server processes. This version is the first stateful web framework-             that is as RESTful as a web framework can be.-             .-             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.-             .-             All the flow of requests and responses are coded by the programmer in a single procedure.
-             Allthoug single request-response flows are possible. Therefore, the code is
-             more understandable. It is not continuation based. It uses a log for thread state persistence and backtracking for
-             handling the back button. Back button state syncronization is supported out-of-the-box-             .-             The MFlow architecture is scalable, since the state is serializable and small
-             .
-             The processes are stopped and restarted by the
-             application server on demand, including the execution state (if the Wokflow monad is used).
-             Therefore session management is automatic. State consistence and transactions are given by the TCache package.
-             .
-             The processes interact trough widgets, that are an extension of formlets with
-             additional applicative combinators, formatting, link management, callbacks, modifiers, caching,
-             byteString conversion and AJAX. All is coded in pure haskell.-             .-             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
-             .
-             It is designed for applications that can be run with no deployment with runghc in order
-             to speed up the development process. see <http://haskell-web.blogspot.com.es/2013/05/a-web-application-in-tweet.html>-             .-             This release includes:-             .-             - /RESTful/ URLs-             .-             - Automatic independent refreshing of widgets via Ajax. (see <http://haskell-web.blogspot.com.es/2013/06/and-finally-widget-auto-refreshing.html>)-             .-             - Now each widget can be monadic so it 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>)-             .-             - Per-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: spinner, datepicker
-             .
-             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 added transparent back button management, cached widgets, callbacks, modifiers, heterogeneous formatting, AJAX,
-             and WAI integration.
-             .
-             See "MFlow.Forms" for details
-             .             .
-             To do:
-             .
-             -Clustering-             .-             -Automatic error traces
-             .-             In this release I commented out the build of the demo/test program.+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/7>             
 category: Web, Application Server
 author: Alberto Gómez Corona
 data-dir: ""
 extra-source-files: Demos/demos-blaze.hs-                  , Demos/testREST.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
+                  , src/MFlow/Forms/HSP.hs+                  
 
 
 source-repository head
@@ -86,14 +118,14 @@     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+                   random -any,  blaze-html -any, blaze-markup -any,+                   monadloc -any, hamlet -any                   
 
     exposed-modules: MFlow MFlow.Wai.Blaze.Html.All
@@ -101,19 +133,24 @@                      MFlow.Cookies  MFlow.Wai
                      MFlow.Wai.XHtml.All MFlow.Forms.XHtml
                      MFlow.Forms.Blaze.Html MFlow.Forms.Test
-                     MFlow.Forms.Widgets
-    other-modules: MFlow.Forms.Internals MFlow.Wai.Response
+                     MFlow.Forms.Widgets+                     MFlow.Forms.Internals+                     
+    other-modules:  MFlow.Wai.Response
     exposed: True
     buildable: True
     hs-source-dirs: src .
 
--- executable demos-blaze+--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+--                   text -any, transformers -any, vector -any,  hamlet -any,+--                   monadloc -any+ --    main-is: "demos-blaze.hs" --    ghc-options:+--        -iDemos --        -threaded --        -rtsopts --    buildable: True

@@ -54,6 +54,7 @@               ,RecordWildCards
               ,OverloadedStrings
               ,ScopedTypeVariables
+              ,TemplateHaskell
                #-}  
 module MFlow (
 Flow, Params, HttpData(..),Processable(..)
@@ -67,11 +68,14 @@ -- * ByteString tags
 -- | very basic but efficient tag formatting
 btag, bhtml, bbody,Attribs, addAttrs
-
+-- * user
+, userRegister, setAdminUser, getAdminName
 -- * static files
 ,setFilesPath
 -- * internal use
 ,addTokenToList,deleteTokenInList, msgScheduler,serveFile,newFlow
+,UserStr,PasswdStr, User(..),eUser
+
 )
 where
 import Control.Concurrent.MVar 
@@ -80,7 +84,7 @@ import Data.Typeable
 import Data.Maybe(isJust, isNothing, fromMaybe, fromJust)
 import Data.Char(isSeparator)
-import Data.List(isPrefixOf,isSuffixOf,isInfixOf, elem , span, (\\))
+import Data.List(isPrefixOf,isSuffixOf,isInfixOf, elem , span, (\\),intersperse)
 import Control.Monad(when)
 
 import Data.Monoid
@@ -92,7 +96,7 @@ import Data.TCache
 import Data.TCache.DefaultPersistence  hiding(Indexable(..))
 import Data.TCache.Memoization
-import  Data.ByteString.Lazy.Char8 as B  (readFile,ByteString, concat,pack, unpack,empty,append,cons,fromChunks)
+import  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.Map as M
 import System.IO
@@ -101,63 +105,12 @@ import MFlow.Cookies
 import Control.Monad.Trans
 import qualified Control.Exception as CE
-
-import Debug.Trace
-(!>) x y = x  -- flip trace
-
-type Flow= (Token -> Workflow IO ())
-
-data HttpData = HttpData Params [Cookie] ByteString | Error WFErrors ByteString deriving (Typeable, Show)
-
---instance ToHttpData HttpData where
--- toHttpData= id
---
---instance ToHttpData ByteString where
--- toHttpData bs= HttpData [] [] bs
-
-instance Monoid HttpData where
- mempty= HttpData [] [] 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
-type ProcList = WorkflowList IO Token ()
-
-
-data Req  = forall a.( Processable a, Typeable a)=> Req a   deriving Typeable
-
-type Params =  [(String,String)]
-
-class Processable a where
-     pwfname :: a -> String
-     pwfname s= head $ pwfPath s !> "head mf"
-     pwfPath :: a -> [String]
-     puser :: a -> String
-     pind :: a -> String
-     getParams :: a -> Params
---     getServer ::a -> String
---     getPath :: a -> String
---     getPort :: a -> Int
-
-instance Processable Token where
-     pwfname = twfname
-     pwfPath = tpath
-     puser = tuser
-     pind = tind
-     getParams = tenv
+import Data.RefSerialize hiding (empty)
 
-instance Processable  Req   where 
-    pwfname (Req x)= pwfname x
-    pwfPath (Req x)= pwfPath x
-    puser (Req x)= puser x
-    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
+import System.Posix.Internals
 
-data Resp  = Fragm HttpData
-           | EndFragm HttpData
-           | Resp HttpData
+--import Debug.Trace
+--(!>)  =   flip trace
 
 
 -- | a Token identifies a flow that handle messages. The scheduler compose a Token with every `Processable`
@@ -166,8 +119,8 @@ 
 instance Indexable  Token  where
      key (Token w u i _ _ _ _  )=
-          if u== anonymous then  u++ i   -- ++ "@" ++ w
-                           else  u       -- ++ "@" ++ w
+          if u== anonymous then  u ++ i   -- ++ "@" ++ w
+                          else  u       -- ++ "@" ++ w
 
 instance Show Token where
      show t = "Token " ++ key t
@@ -207,15 +160,70 @@       let mqs = M.lookup ( i  ++ w  ++ u) qmap
       case mqs of
               Nothing  -> do
-                 q <-   newEmptyMVar  -- `debug` (i++w++u)
-                 qr <-  newEmptyMVar
+                 q  <- newEmptyMVar  -- `debug` (i++w++u)
+                 qr <- newEmptyMVar
                  let token= Token w u i ppath penv q qr
                  addTokenToList token
                  return token
 
-              Just token-> return token{tpath= ppath, tenv= penv}
+              Just token -> return token{tpath= ppath, tenv= penv}
 
 
+type Flow= (Token -> Workflow IO ())
+
+data HttpData = HttpData Params [Cookie] ByteString | Error  ByteString deriving (Typeable, Show)
+
+
+--instance ToHttpData HttpData where
+-- toHttpData= id
+--
+--instance ToHttpData ByteString where
+-- toHttpData bs= HttpData [] [] bs
+
+instance Monoid HttpData where
+ mempty= HttpData [] [] 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
+type ProcList = WorkflowList IO Token ()
+
+
+data Req  = forall a.( Processable a, Typeable a)=> Req a   deriving Typeable
+
+type Params =  [(String,String)]
+
+class Processable a where
+     pwfname :: a -> String
+     pwfname s= Prelude.head $ pwfPath s 
+     pwfPath :: a -> [String]
+     puser :: a -> String
+     pind :: a -> String
+     getParams :: a -> Params
+
+instance Processable Token where
+     pwfname = twfname
+     pwfPath = tpath
+     puser = tuser
+     pind = tind
+     getParams = tenv
+
+instance Processable  Req   where 
+    pwfname (Req x)= pwfname x
+    pwfPath (Req x)= pwfPath x
+    puser (Req x)= puser x
+    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
+
+data Resp  = Fragm HttpData
+           | EndFragm HttpData
+           | Resp HttpData
+
+
+
+
 -- | The anonymous user
 anonymous= "anon#"
 
@@ -239,7 +247,7 @@ sendFragment ::  Token  -> HttpData -> IO()
 sendFragment (Token _ _ _ _ _ _ qresp) msg=   putMVar qresp  . Fragm $  msg
 
-{-# DEPRECATED sendEndFragment "use send to end a fragmented response instead" #-}
+{-# DEPRECATED sendEndFragment "use \"send\" to end a fragmented response instead" #-}
 sendEndFragment ::   Token  -> HttpData -> IO()
 sendEndFragment (Token _ _ _ _ _ _ qresp  ) msg=  putMVar qresp  $ EndFragm   msg
 
@@ -249,11 +257,11 @@ 
 flushRec t@(Token _ _ _ _ _ queue _)= do
    empty <-  isEmptyMVar  queue
-   when (not empty) $ takeMVar queue >> return ()
+   when (not empty) $ takeMVar queue >> return ()    -- !> "flushRec"
 
 
 receiveReq ::  Token -> IO Req
-receiveReq t@(Token _ _ _ _ _ queue _)=   readMVar queue  -- !> (">>>>>> receive "++ thread t)
+receiveReq t@(Token _ _ _ _ _ queue  _)=   readMVar queue   -- !> (">>>>>> receiveReq "++ thread t)
 
 fromReq :: Typeable a => Req -> a
 fromReq  (Req x) = x' where
@@ -262,7 +270,6 @@            Just y  -> y
 
 
-
 receiveReqTimeout :: Int
                   -> Integer
                   -> Token
@@ -310,7 +317,7 @@   emptyFList= M.empty  :: WorkflowList  IO Token ()
 
 -- | add a list of flows to be scheduled. Each entry in the list is a pair @(path, flow)@
-addMessageFlows wfs=  modifyMVar_ _messageFlows(\ms ->  return $ M.union ms  (M.fromList $ map flt wfs))
+addMessageFlows wfs=  modifyMVar_ _messageFlows(\ms ->  return $ M.union (M.fromList $ map flt wfs)ms)
   where flt ("",f)= (noScript,f)
         flt e= e
 
@@ -324,19 +331,18 @@ 
 sendToMF Token{..} msg= putMVar tsendq $ Req msg
 
---tellToWF :: (Typeable a,  Typeable c, Processable a) => Token -> a -> IO c
-tellToWF t@(Token _ _ _ _ _ queue qresp ) msg = do  
-    putMVar queue (Req msg)              -- !> (">>>>> telltowf"++ thread t)
-    m <-  takeMVar qresp                 -- !> ("<<<<<< tellTowf"++ thread t)
+--recFromMF :: (Typeable a,  Typeable c, Processable a) => Token -> a -> IO c
+recFromMF Token{..}  = do  
+    m <-  takeMVar trecq                  -- !> ("<<<<<< recFromMF"++ thread t)
     case m  of
-        Resp r  ->  return  r            -- !> ("recibido  tellTowf"++ thread t)
+        Resp r  ->  return  r              -- !> ("recibido  recFromMF"++ thread t)
         Fragm r -> do
                    result <- getStream   r
                    return  result
 
     where
     getStream r =  do
-         mr <-  takeMVar qresp 
+         mr <-  takeMVar trecq 
          case mr of
             Fragm h -> do
                  rest <- unsafeInterleaveIO $  getStream  h
@@ -363,50 +369,68 @@   => a  -> IO (HttpData, ThreadId)
 msgScheduler x  = do
   token <- getToken x
-  let wfname= takeWhile (/='/') $ pwfname x
+  let wfname = takeWhile (/='/') $ pwfname x
+  sendToMF token x
   th <- startMessageFlow wfname token
-  r  <- tellToWF token  x                         --  !> let HttpData _ _ r1=r in unpack r1 
+  r  <- recFromMF token                          -- !> let HttpData _ _ r1=r in unpack r1 
   return (r,th)
   where
   --start the flow if not started yet
   startMessageFlow wfname token = 
    forkIO $ do
         wfs <- getMessageFlows
-        r <- startWF wfname  token   wfs                      -- !>( "init wf " ++ wfname)
+        r   <- startWF wfname  token   wfs          -- !>( "init wf " ++ wfname)
         case r of
           Left NotFound -> do
                  (sendFlush token =<<  serveFile  (pwfname x))
                     `CE.catch`\(e:: CE.SomeException) -> showError wfname token (show e)
 --               sendFlush token (Error NotFound $ "Not found: " <> pack wfname)
                  deleteTokenInList token
-          Left AlreadyRunning -> return ()                    -- !> ("already Running " ++ wfname)
-          Left Timeout -> do
 
-              hFlush stdout                                      !>  "TIMEOUT in msgScheduler"
-              return()
-          Left (WFException e)-> showError wfname token e
-
-
+          Left AlreadyRunning -> return ()                    -- !> ("already Running " ++ wfname)
 
+          Left Timeout -> do
+              hFlush stdout                                       -- !>  ("TIMEOUT in msgScheduler" ++ (show $ unsafePerformIO myThreadId))
+              deleteTokenInList token
+             
+          Left (WFException e)-> do
+              showError wfname token e
+              deleteTokenInList token                       -- !> "DELETETOKEN"
+              
           Right _ ->  delMsgHistory token >> return ()      -- !> ("finished " ++ wfname)
 
 
 
 showError wfname token@Token{..} e= do
                let user= key token
-               let msg= e ++ ": "++twfname++ " "++tuser ++" "++ tind++" "++ show tpath ++ show tenv
-               putStrLn msg
-               logError user wfname e
+               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
-               sendFlush token $ fresp (key token)  msg
+               admin <- getAdminName
+               sendFlush token . Error $ fresp (user== admin)  $  Prelude.concat[ "<br/>"++ s | s <- lines msg]
 
 
+errorMessage t e u path env=
+     "\n---------------------ERROR-------------------------\
+     \\nTIME=" ++ t ++"\n\n" ++
+     e++
+     "\n\nUSER= " ++ u ++
+     "\n\nPATH= " ++ path ++
+     "\n\nREQUEST:\n\n"++
+     show env
 
-logError u wf e= do
+line= unsafePerformIO $ newMVar ()
+
+logError err= do
+     takeMVar line
+     putStrLn err
      hSeek hlog SeekFromEnd 0
-     t <- return . calendarTimeToString =<< toCalendarTime =<< getClockTime
-     hPutStrLn hlog (","++show [u, t,wf,e])  >> hFlush hlog
+     hPutStrLn hlog err
+     hFlush hlog
+     putMVar line ()
 
 logFileName= "errlog"
 
@@ -415,42 +439,93 @@ -- | The handler of the error log
 hlog= unsafePerformIO $ openFile logFileName ReadWriteMode
 
+------ USER MANAGEMENT -------
 
-defNotFoundResponse user msg=
-  HttpData [("Content-Type", "text/html")] []
-     $ fresp
-     $ case user of
-           "admin" -> pack msg
-           _       -> "The administrator has been notified"
+--instance Serialize a => Serializable a where
+--  serialize=  runW . showp
+--  deserialize=   runR readp
+
+data User= User
+            { userName :: String
+            , upassword :: String
+            } deriving (Read, Show, Typeable)
+
+eUser= User (error1 "username") (error1 "password")
+
+error1 s= error $ s ++ " undefined"
+
+userPrefix= "user/"
+instance Indexable User where
+   key User{userName= user}= keyUserName user
+
+-- | Return  the key name of an user
+keyUserName n= userPrefix++n
+
+instance Serialize a => Serializable a where
+  serialize= runW . showp
+  deserialize= runR  readp
+
+-- | Register an user/password 
+userRegister :: MonadIO m => String -> String  -> m (DBRef User)
+userRegister user password  = liftIO . atomically $ newDBRef $ User user password
+
+
+data Config = Config UserStr deriving (Read, Show, Typeable)
+
+keyConfig= "mflow.config"
+instance Indexable Config where key _= keyConfig
+rconf= getDBRef keyConfig
+
+
+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
+
+getAdminName :: MonadIO m => m UserStr
+getAdminName= liftIO $ atomically ( readDBRef rconf `onNothing` error "admin user not set" ) >>= \(Config u) -> return u
+
+
+--------------- ERROR RESPONSES --------
+
+defNotFoundResponse isAdmin msg= fresp $
+     case isAdmin of
+           True -> pack msg
+           _    -> "The administrator has been notified"
   where
   fresp msg=
-   "<html><h4>Error 404: Page not found or error ocurred</h4><h3>" <> msg <>
-   "</h3><br/>" <> opts <> "<br/><a href=\"/\" >press here to go home</a></html>"
+   "<html><h4>Error 404: Page not found or error ocurred</h4> <p style=\"font-family:courier\">" <> msg <>"</p>" <>
+   "<br/>" <> opts <> "<br/><a href=\"/\" >press here to go home</a></html>"
 
    
   paths= Prelude.map B.pack . M.keys $ unsafePerformIO getMessageFlows
   opts=  "options: " <> B.concat (Prelude.map  (\s ->
-                          "<a href=\"/"<>  s <>"\">"<> s <>"</a>, ") paths)
+                          "<a href=\"/"<>  s <>"\">"<> s <>"</a>, ") $ filter (\s -> B.head s /= '_') paths)
 
 notFoundResponse=  unsafePerformIO $ newIORef defNotFoundResponse
 
--- | set the  404 "not found" response.------ The parameter is as follows:---    (String     The user identifier. The username when logged
+-- | set the  404 "not found" response.
+--
+-- The parameter is as follows:
+--    (Bool        Either if the user is Administrator or not
 --  -> String      The error string
 --  -> HttpData)   The response. See `defNotFoundResponse` code for an example
 
 setNotFoundResponse :: 
-    (String    
+    (Bool    
   -> String     
-  -> HttpData)  
+  -> ByteString)  
   -> IO ()
 
 setNotFoundResponse f= liftIO $ writeIORef notFoundResponse  f
 getNotFoundResponse= liftIO $ readIORef notFoundResponse
 
--- basic bytestring  tags
+--------------- BASIC BYTESTRING TAGS -------------------
+
+
 type Attribs= [(String,String)]
 -- | 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".
@@ -479,7 +554,7 @@ addAttrs other _ = error  $ "addAttrs: byteString is not a tag: " ++ show other
 
 
---- basic file server ----
+------------------- FILE SERVER -----------
 
 -- | Set the path of the files in the web server. The links to the files are relative to it.
 -- The files are cached (memoized) according with the "Data.TCache" policies in the program space. This avoid the blocking of
@@ -487,13 +562,13 @@ -- in the context of heavy concurrence.
 -- It uses 'Data.TCache.Memoization'. 
 -- The caching-uncaching follows the `setPersist` criteria
-setFilesPath :: String -> IO ()
-setFilesPath path= writeIORef rfilesPath path
+setFilesPath :: MonadIO m => String -> m ()
+setFilesPath path= liftIO $ writeIORef rfilesPath path
 
 rfilesPath= unsafePerformIO $ newIORef "files/"
 
 serveFile path'= do
-     when(let hpath= head path' in hpath == '/' || hpath =='\\') $ error noperm
+     when(let hpath= Prelude.head path' in hpath == '/' || hpath =='\\') $ error noperm
      when(not(".." `isSuffixOf` path') && ".." `isInfixOf` path') $ error noperm
      filesPath <- readIORef rfilesPath
      let path= filesPath ++ path'
@@ -511,12 +586,12 @@    ioerr x= \(e :: CE.IOException) ->  x
    setMime x= ("Content-Type",x)
 
+--------------------- FLOW ID GENERATOR ------------
+
 data NFlow= NFlow !Integer deriving (Read, Show, Typeable)
 
-instance Serializable NFlow where
-  serialize= B.pack . show
-  deserialize= read . B.unpack
 
+
 instance Indexable NFlow where
   key _= "Flow"
 
@@ -729,3 +804,16 @@     ("z",	"application/x-compress")
 
  ]
+--
+-- -- inspired by Pepe Iborra withLocTH
+--locTH :: Q Exp
+--locTH = do
+--  loc <- qLocation
+--  let loc_msg = showLoc loc
+--  [|loc_msg |]
+--
+--showLoc :: Loc -> String
+--showLoc Loc{loc_module=mod, loc_filename=filename, loc_start=start} =
+--         {- text package <> char '.' <> -}
+--         printf "%s (%s). %s" mod filename (show start)
+

@@ -12,13 +12,12 @@ import Data.Maybe(fromJust) import Unsafe.Coerce import Data.Monoid--- import Text.Parsec import Control.Monad.Identity---import Text.Parsec.Token +--import Debug.Trace+--(!>)= flip trace+ contentHtml= ("Content-Type", "text/html")  type Cookie=  (String,String,String,Maybe String)@@ -211,3 +210,4 @@ 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)

@@ -12,6 +12,7 @@              -XTypeFamilies              -XTypeOperators              -XOverloadedStrings+             -XTemplateHaskell 
 #-}
 
@@ -54,26 +55,6 @@ It is designed for applications that can be run with no deployment with runghc in order
 to speed up the development process. see <http://haskell-web.blogspot.com.es/2013/05/a-web-application-in-tweet.html> -This release (0.3) includes:-- - /RESTful/ URLs-- - Automatic independent refreshing of widgets via Ajax. (see <http://haskell-web.blogspot.com.es/2013/06/and-finally-widget-auto-refreshing.html>)-- - Now each widget can be monadic so it 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>)-- - Per-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 wrappers for jQuery widgets as MFlow widgets: spinner, datepicker
-
-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 added transparent back button management, cached widgets, callbacks, modifiers, heterogeneous formatting, AJAX,
-and WAI integration.
- This module implement  stateful processes (flows) that are optionally persistent. This means that they automatically store and recover his execution state. They are executed by the MFlow app server. defined in the "MFlow" module.@@ -131,20 +112,28 @@  * NEW IN THIS RELEASE ++{@Auto-Refresh@] 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.  [@Page flows@] each widget-formlet can have its own independent behaviour within the page. They can refresh independently trough AJAX by means of 'autoRefresh'. Additionally, 'pageFlow' initiates the page flow mode or a subpage flow by adding a well know indetifier prefix for links and form parameters.-'wdialog' present a widget within a modal or non modal jQuery dialog. while a monadic++[@Modal Dialogs@] 'wdialog' present a widget within a modal or non modal jQuery dialog. while a monadic widget-formlet can add different form elements depending on the user responses, 'wcallback' can substitute the widget by other. (See 'Demos/demos.blaze.hs' for some examples)  [@JQuery widgets@] with MFlow interface: 'getSpinner', 'datePicker', 'wdialog' -* IN PREVIOUS RELEASES- [@WAI interface@] Now MFlow works with Snap and other WAI developments. Include "MFlow.Wai" or "MFlow.Wai.Blaze.Html.All" to use it.  [@blaze-html support@] see <http://hackage.haskell.org/package/blaze-html> import "MFlow.Forms.Blaze.Html" or "MFlow.Wai.Blaze.Html.All" to use Blaze-Html@@ -253,16 +242,20 @@ ,btag,bhtml,bbody  -- * Normalization-, flatten, normalize+,flatten, normalize 
 -- * Running the flow monad
-,runFlow, transientNav,runFlowOnce,runFlowIn,runFlowConf,MFlow.Forms.Internals.step, goingBack,breturn, preventGoingBack+,runFlow, transientNav,runFlowOnce,runFlowIn+,runFlowConf,MFlow.Forms.Internals.step+-- * controlling backtracking+,goingBack,returnIfForward, breturn, preventGoingBack 
 -- * Setting parameters
 ,setHeader+,addHeader+,getHeader ,setSessionData-,getSessionData-,getHeader
+,getSessionData
 ,setTimeouts 
 -- * Cookies
@@ -281,8 +274,8 @@ ,FailBack ,fromFailBack ,toFailBack--- * The monster of the deep-,MFlowState
+,getRawParam+
 )
 where
 @@ -312,7 +305,6 @@ import Data.Char(isNumber,toLower) import Network.HTTP.Types.Header
 - 
 -- | Validates a form or widget result against a validating procedure
 --
@@ -359,7 +351,7 @@   where   flowToView x=           View $ do-              r <- runBackT $ runFlowM  x+              r <- runSup $ runFlowM  x               case r of                 NoBack x ->                      return (FormElm [] $ Just x)@@ -369,6 +361,7 @@                      modify $ \s ->s{notSyncInAction= True}                      return (FormElm [] Nothing) +-- | change the rendering and the return value of a page. This is superseeded by page flows. wmodify :: (Monad m, FormInput v)         => View v m a         -> ([v] -> Maybe a -> WState v m ([v], Maybe b))@@ -377,20 +370,6 @@    FormElm f mx <- runView  formt 
    (f',mx') <-  act f mx    return $ FormElm f' mx'-
-
---
---instance (FormInput view, FormLet a m view , FormLet b m view )
---          => FormLet (a,b) m view  where
---  digest  mxy  = do
---      let (x,y)= case mxy of Nothing -> (Nothing, Nothing); Just (x,y)-> (Just x, Just y)
---      (,) <$> digest x   <*> digest  y
---
---instance (FormInput view, FormLet a m view , FormLet b m view,FormLet c m view )
---          => FormLet (a,b,c) m view  where
---  digest  mxy  = do
---      let (x,y,z)= case mxy of Nothing -> (Nothing, Nothing, Nothing); Just (x,y,z)-> (Just x, Just y,Just z)
---      (,,) <$> digest x  <*> digest  y  <*> digest  z
  -- | Display a text box and return a non empty String
 getString  :: (FormInput view,Monad m) =>
@@ -417,6 +396,7 @@ getPassword = getParam Nothing "password" Nothing
  newtype Radio a= Radio a+ -- | Implement a radio button that perform a submit when pressed. -- the parameter is the name of the radio group setRadioActive :: (FormInput view,  MonadIO m,@@ -488,7 +468,7 @@   put st{needForm= True}   let env = mfEnv st       strs= map snd $ filter ((==) n . fst) env-      mn= if null strs then Nothing else Just $ head strs !> "head 3"+      mn= if null strs then Nothing else Just $ head strs       val = inSync st   let ret= case val of                    -- !> show val of         True  -> Just $ CheckBoxes  strs  -- !> show strs@@ -555,6 +535,8 @@      Maybe a ->  View view m a
 getTextBox ms  = getParam Nothing "text" ms
 +-- | return the value of a parameter from the environment+getRawParam p=   gets mfEnv >>=   getParam1 p >>= return . valToMaybe 
 getParam
   :: (FormInput view,
@@ -765,7 +747,7 @@ infixl 8 <! widget <! attribs= View $ do       FormElm fs  mx <- runView widget-      return $ FormElm  (head fs `attrs` attribs:tail fs) mx !> "head 4"+      return $ FormElm  (head fs `attrs` attribs:tail fs) mx --      case fs of --        [hfs] -> return $ FormElm  [hfs `attrs` attribs] mx --        _ -> error $ "operator <! : malformed widget: "++ concatMap (unpack. toByteString) fs@@ -828,6 +810,15 @@    rus <-  return . tuser =<< gets mfToken
    return . not $ rus ==  anonymous +-- | return the result if going forward+--+-- If the process is backtraking, it does not validate,+-- in order to continue the backtracking+returnIfForward :: (Monad m, FormInput view) => b -> View view m b+returnIfForward x = do+     back <- goingBack+     if back then noWidget else return x+ -- | 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.@@ -841,8 +832,8 @@ userWidget muser formuser= do    user <- getCurrentUser    if muser== Just user || isNothing muser && user/= anonymous-         then return user-         else formuser `validate` val muser `waction` login1 
+         then returnIfForward user+         else formuser `validate` val muser `wcallback` login1 
    where    val _ (Nothing,_) = return . Just $ fromStr "Plese fill in the user/passwd to login, or user/passwd/passwd to register" @@ -876,32 +867,31 @@   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'+-- 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) 
-     return ()   + -- | 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-         moveState (twfname t) t t'-         put st{mfToken= t'}-         liftIO $ deleteTokenInList t-         liftIO $ addTokenToList t'-+--     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'}+--         liftIO $ deleteTokenInList t+--         liftIO $ addTokenToList t'          setCookie cookieuser   anonymous "/" (Just $ -1000) 
 -- | If not logged, perform login. otherwise return the user@@ -923,7 +913,24 @@           -> View view IO (Maybe (UserStr,PasswdStr), Maybe String)           -> FlowM view IO String
 getUser mu form= ask $ userWidget mu form
++-- | 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"
 
 -- | Join two widgets in the same page
 -- the resulting widget, when `ask`ed with it, return a 2 tuple of their validation results
@@ -1020,8 +1027,8 @@   :: (FormInput view) =>       View view IO a -> FlowM view IO a
 ask w =  do-  st1 <- get-+ st1 <- get+ if not . null $ mfTrace st1 then fail "" else do   -- AJAX   let env= mfEnv st1       mv1= lookup "ajax" env@@ -1042,33 +1049,37 @@ 
      st' <- get      if notSyncInAction st' then put st'{notSyncInAction=False}>> ask w-      else if mfAutorefresh st' then resetState st st' >>  FlowM (lift  nextMessage) >> ask w++       else-      case mx of
+      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+         breturn x                                       -- !> "RETURN" 
        Nothing ->          if  not (inSync st')  && not (newAsk st')-                                                        !> ("pageIndex="++ show (mfPageIndex st'))-                                                        !> ("insinc="++show (inSync st'))-                                                        !> ("newask="++show (newAsk st'))-                                                        !> ("mfPIndex="++ show( mfPIndex st'))+--                                                        !> ("pageIndex="++ show (mfPageIndex st'))+--                                                        !> ("insinc="++show (inSync st'))+--                                                        !> ("newask="++show (newAsk st'))+--                                                        !> ("mfPIndex="++ show( mfPIndex st'))           then do             let index = mfPIndex st'                 nindex= if index== 0 then 1 else index - 1-            put st'{mfPIndex= nindex}  !> "BACKTRACK"-            fail ""+            put st'{mfPIndex= nindex}                     -- !> "BACKTRACK"+            fail ""                                       -- !> "FAIL**********"+          else if mfAutorefresh st' then do+                     resetState st st'+                     FlowM (lift  nextMessage)+                     ask w                              --  !> "EN AUTOREFRESH"           else do-             reqs <-  FlowM $ lift installAllRequirements+             reqs <-  FlowM $ lift installAllRequirements     -- !> "REPEAT"              let header= mfHeader st'                  t= mfToken st'              cont <- case (needForm st') of@@ -1083,7 +1094,7 @@               resetState st st'              
 -             FlowM $ lift  nextMessage+             FlowM $ lift  nextMessage       -- !> "NEXTMESSAGE"              ask w     where     resetState st st'=@@ -1121,34 +1132,34 @@          t1= mfkillTime st          t2= mfSessionTime st      msg <- liftIO ( receiveReqTimeout t1 t2  t)-     let req= getParams msg-         env=   updateParams inPageFlow (mfEnv st) req -- !> show req-         npath=  pwfPath msg--         path= mfPath st+     let req=   getParams msg+         env=   updateParams inPageFlow (mfEnv st) req+         npath= pwfPath msg+         path=  mfPath st          inPageFlow= isJust $ mfPageIndex st  
      put st{ mfPath= npath-           , mfPIndex= case mfPageIndex st !>  ("mfPageIndex=" ++ show (mfPageIndex st)) of+           , mfPIndex= case mfPageIndex st of                          Just n -> n-                         Nothing  ->-                             comparePaths  (mfPIndex st) 1 (tail path) (tail npath)+                         Nothing ->+                             comparePaths (mfPIndex st) 1 (tail path) (tail npath) --           , mfPageIndex= Nothing-           , mfEnv= env }+           , mfEnv= env }                        -- !> show req        where      updateParams :: Bool -> Params -> Params -> Params-     updateParams False _ req= req   !> "NOT IN PAGE FLOW"+     updateParams False _ req= req      updateParams True env req=         let params= takeWhile isparam env-            fs= fst $ head req !> "head 1"+            fs= fst $ head req             parms= (case findIndex (\p -> fst p == fs)  params of                       Nothing -> params                       Just  i -> take i params)                     ++  req-        in parms !> "IN PAGE FLOW"  !>  ("parms=" ++ show parms )-                                    !>  ("env=" ++ show env)-                                    !>  ("req=" ++ show req)+        in parms+--                 !> "IN PAGE FLOW"  !>  ("parms=" ++ show parms )+--                                    !>  ("env=" ++ show env)+--                                    !>  ("req=" ++ show req)  
 @@ -1220,6 +1231,7 @@ newtype AjaxSessionId= AjaxSessionId String deriving Typeable  -- | Install the server code and return the client code for an AJAX interaction.+-- It is very lightweight, It does no t need jQuery. -- -- This example increases the value of a text box each time the box is clicked --@@ -1308,33 +1320,33 @@           back =  True -- not $ inSync st  || (inSync st && linkMatched st)        let path=   currentPath back index lpath verb ++ ('/':name)-                                       !> (show $ mfPath st)
+                                       -- !> (show $ mfPath st)
           toSend = flink path v         r <- if linkMatched st then return Nothing            else-           if isJust $ mfPageIndex st !> (show $ mfPageIndex st)+           if isJust $ mfPageIndex st -- !> (show $ mfPageIndex st)              then-             case  M.lookup name $ mfLinks st !> (show $ mfLinks st)of+             case  M.lookup name $ mfLinks st of                  Just 0 -> do                      modify $ \st -> st{ inSync= True}-                     return Nothing  !> (name ++ " 0 Fail")+                     return Nothing  -- !> (name ++ " 0 Fail")                   Just n ->  do                      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")+                 Nothing -> return Nothing  -- !> (name ++ " 0 Fail")              else              case  index < length lpath && name== lpath !! index  of              True -> do                   modify $ \s -> s{inSync= True-                                  , linkMatched= True, mfPIndex= index+1 }  !> (name ++ "<-" ++show index++ " MATCHED")+                                 ,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                                        -- !> (name++"<-" ++show index++ " "++(if index < length lpath then lpath !! index else ""))        return $ FormElm [toSend] r
 @@ -1382,7 +1394,7 @@       forms <- mapM runView  xs
       let vs  = concatMap (\(FormElm v _) ->  [mconcat v]) forms
           res = filter isJust $ map (\(FormElm _ r) -> r) forms
-          res1= if null res then Nothing else head res !> "head 2"
+          res1= if null res then Nothing else head res 
       return $ FormElm  vs res1
  -- | from a list of widgets, it return the validated ones.@@ -1582,21 +1594,21 @@        put s{mfPrefix= str ++ mfPrefix s             ,mfSequence=0             ,mfLinks= acum M.empty $ drop (mfPIndex s) (mfPath s)-            ,mfPageIndex= Just $ mfPIndex s }                                                      !> ("PARENT pageflow. prefix="++ str)+            ,mfPageIndex= Just $ mfPIndex s }                                                      -- !> ("PARENT pageflow. prefix="++ str)         flow <** (modify (\s' -> s'{mfSequence= mfSequence s-                                 ,mfPrefix= mfPrefix s})-                                                                                                                      !> ("END PARENT pageflow. prefix="++ str))+                                 ,mfPrefix= mfPrefix s}))+                                                                                                   -- !> ("END PARENT pageflow. prefix="++ str))          else do        put s{mfPrefix= str++ mfPrefix s             ,mfLinks= acum M.empty $ drop (fromJust $ mfPageIndex s) (mfPath s)-            ,mfSequence=0}                                                                                  !> ("CHILD pageflow. prefix="++ str)+            ,mfSequence=0}                                                                         --  !> ("CHILD pageflow. prefix="++ str)         flow <** (modify (\s' -> s'{mfSequence= mfSequence s-                                 ,mfPrefix= mfPrefix s})-                                                                                                                      !> ("END CHILD pageflow. prefix="++ str))+                                 ,mfPrefix= mfPrefix s}))+                                                                                                   -- !> ("END CHILD pageflow. prefix="++ str))   

@@ -20,7 +20,8 @@              -XGeneralizedNewtypeDeriving
              -XFlexibleContexts
              -XOverlappingInstances
-             -XRecordWildCards
+             -XRecordWildCards+             -XTemplateHaskell
 #-}
 
 module MFlow.Forms.Internals where
@@ -44,74 +45,18 @@ import Control.Monad.Identity
 import Data.List
 import System.IO.Unsafe
-import Control.Concurrent.MVar
-
--- for traces
---import Language.Haskell.TH.Syntax(qLocation, Loc(..), Q, Exp, Quasi)
---import Text.Printf
-
-
-import Debug.Trace
-(!>) = const --   flip trace
-
-instance Serialize a => Serializable a where
-  serialize=  runW . showp
-  deserialize=   runR readp
-
-type UserStr= String
-type PasswdStr= String
-
-data User= User
-            { userName :: String
-            , upassword :: String
-            } deriving (Read, Show, Typeable)
-
-eUser= User (error1 "username") (error1 "password")
-
-error1 s= error $ s ++ " undefined"
-
-userPrefix= "user/"
-instance Indexable User where
-   key User{userName= user}= keyUserName user
-
--- | Return  the key name of an user
-keyUserName n= userPrefix++n
-
--- | Register an user/password 
-userRegister :: MonadIO m => String -> String  -> m (DBRef User)
-userRegister user password  = liftIO . atomically $ newDBRef $ User user password
-
--- | 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"
-
-data Config = Config UserStr deriving (Read, Show, Typeable)
-
-keyConfig= "mflow.config"
-instance Indexable Config where key _= keyConfig
-rconf= getDBRef keyConfig
-
-setAdminUser :: MonadIO m => UserStr -> PasswdStr -> m ()
-setAdminUser user password= liftIO $  atomically $ do
-  newDBRef $ User user password
-  writeDBRef rconf $ Config user
+import Control.Concurrent.MVar+import Control.Workflow(WFErrors(Timeout))
+--
+---- for traces
+--++import Control.Exception as CE(catch,SomeException,AsyncException,throw,fromException)+import Control.Concurrent+import Control.Monad.Loc
 
-getAdminName :: MonadIO m => m UserStr
-getAdminName= liftIO $ atomically ( readDBRef rconf `onNothing` error "admin user not set" ) >>= \(Config u) -> return u
+--import Debug.Trace
+--(!>) =    flip trace
 
 
 data FailBack a = BackPoint a | NoBack a | GoBack   deriving (Show,Typeable)
@@ -132,32 +77,36 @@ repeatPlease= "G"
 noFailBack= "N"
 
-newtype BackT m a = BackT { runBackT :: m (FailBack a ) }
+newtype Sup m a = Sup { runSup :: m (FailBack a ) }
++class MonadState s m => Supervise s m where
+   supBack     :: s -> m ()+   supBack = const $ return ()+   
+   supervise ::    m (FailBack a) -> m (FailBack a)+   supervise= id
 
-instance (Monad m, HandleBacktracking s m)=> Monad (BackT  m) where
-    fail   _ = BackT . return $ GoBack
-    return x = BackT . return $ NoBack x
-    x >>= f  = BackT $ loop
+--instance Monad m => Supervise () m where
+--   handle= const $ return ()
+
+instance (Supervise s m)=> Monad (Sup  m) where
+    fail   _ = Sup . return $ GoBack
+    return x = Sup . return $ NoBack x
+    x >>= f  = Sup $ loop
      where
      loop = do
         s <- get
-        v <-  runBackT x                         -- !> "loop"
+        v <-  supervise $ runSup x                         -- !> "loop"
         case v of
-            NoBack y  -> runBackT (f y)         -- !> "runback"
+            NoBack y  -> supervise $ runSup (f y)         -- !> "runback"
             BackPoint y  -> do
-                 z <- runBackT (f y)            -- !> "BACK"
+                 z <- supervise $ runSup (f y)            -- !> "BACK"
                  case z of
-                  GoBack  -> handle s >> loop            --   !> "BACKTRACKING"
+                  GoBack  -> supBack s >> loop            --   !> "BACKTRACKING"
                   other   -> return other
             GoBack  ->  return  $ GoBack
 
-class MonadState s m => HandleBacktracking s m where
-   handle :: s -> m ()
---   supervise ::    m (FailBack a) -> m (FailBack a)
 
---instance Monad m => HandleBacktracking () m where
---   handle= const $ return ()
-
 fromFailBack (NoBack  x)   = x
 fromFailBack (BackPoint  x)= x
 
@@ -170,32 +119,32 @@ -- This way when the user press the back button, the computation will execute back, to
 -- the returned code, according with the user navigation.
 breturn :: (Monad m) => a -> FlowM v m a
-breturn = flowM . BackT . return . BackPoint           -- !> "breturn"
+breturn = flowM . Sup . return . BackPoint           -- !> "breturn"
 
 
-instance (HandleBacktracking s m,MonadIO m) => MonadIO (BackT  m) where
-  liftIO f= BackT $ liftIO  f >>= \ x -> return $ NoBack x
+instance (Supervise s m,MonadIO m) => MonadIO (Sup  m) where
+  liftIO f= Sup $ liftIO  f >>= \ x -> return $ NoBack x
 
-instance (Monad m,Functor m) => Functor (BackT m) where
-  fmap f g= BackT $ do
-     mr <- runBackT g
+instance (Monad m,Functor m) => Functor (Sup m) where
+  fmap f g= Sup $ do
+     mr <- runSup g
      case mr of
       BackPoint x  -> return . BackPoint $ f x
       NoBack x     -> return . NoBack $ f x
       GoBack       -> return $ GoBack
 
 
-liftBackT f = BackT $ f  >>= \x ->  return $ NoBack x
-instance MonadTrans BackT where
-  lift f = BackT $ f  >>= \x ->  return $ NoBack x
+liftSup f = Sup $ f  >>= \x ->  return $ NoBack x
+instance MonadTrans Sup where
+  lift f = Sup $ f  >>= \x ->  return $ NoBack x
 
 
-instance (HandleBacktracking s m,MonadState s m) => MonadState s (BackT m) where
+instance (Supervise s m,MonadState s m) => MonadState s (Sup m) where
    get= lift get                                -- !> "get"
    put= lift . put
 
 type WState view m = StateT (MFlowState view) m
-type FlowMM view m=  BackT (WState view m)
+type FlowMM view m=  Sup (WState view m)
 
 data FormElm view a = FormElm [view] (Maybe a) deriving Typeable
 
@@ -241,43 +190,96 @@ --  page is refreshed two times (because @formlet2@ has failed, see above),then @ioaction1@ is executed two times.  newtype View v m a = View { runView :: WState v m (FormElm v a)}
+ 
-instance Monad m => HandleBacktracking (MFlowState v) (WState v m) where
-   handle st= do
+instance  Monad m => Supervise (MFlowState v) (WState v m) where
+   supBack st= do
       MFlowState{..} <- get
-      case mfTrace of
-           Nothing ->
-             put  st{mfEnv= mfEnv,mfToken=mfToken, mfPath=mfPath,mfPIndex= mfPIndex, mfData=mfData,inSync=False,newAsk=False}
---           Just trace -> do
---             -- inspired by Pepe Iborra withLocTH
---             loc <- qLocation
---             let loc_msg = showLoc loc
---             put st{mfTrace= Just(loc_msg:trace)}
+      put  st{ mfEnv= mfEnv,mfToken=mfToken+                    , mfPath=mfPath,mfPIndex= mfPIndex+                    , mfData=mfData+                    , mfTrace= mfTrace+                    , inSync=False,newAsk=False} 
 
---   supervise f= f `WF.catch` handler
---      where
---      handler e= do
---              loc <- qLocation
---              let loc_msg = showLoc loc
---              modify $ \st -> st{mfTrace= Just [loc_msg++" exception: " ++show e]}
---              return GoBack
-
---showLoc :: Loc -> String
---showLoc Loc{loc_module=mod, loc_filename=filename, loc_start=start} =
---         {- text package <> char '.' <> -}
---         printf "%s (%s). %s" mod filename (show start)
++--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++ 
---instance (MonadIO m, Functor m) => Quasi (StateT (MFlowState v) m) where
---    qLocation  = badIO "currentLocation"
++++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++       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+--+--       where
+--       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+                                             `CE.catch` (handler1  loc s)
+                       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 ->+                  return (FormElm [] Nothing, s{mfTrace= [show e]}) -- !> loc
+ 
 
-badIO :: MonadIO m => String -> StateT (MFlowState v) m a
-badIO op = do
-    liftIO $ putStrLn  $ "Template Haskell error: " ++"Can't do `" ++ op ++ "' in the IO monad"
-    fail "Template Haskell failure"
-
--- | the FlowM monad executes the page navigation. It perform backtracking when necessary to syncronize+-- | 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. --@@ -309,7 +311,7 @@ 
   
 instance (Functor m, Monad m) => Applicative (View view m) where
-  pure a  = View $  return (FormElm  [] $ Just a)
+  pure a  = View $  return (FormElm [] $ Just a)
   View f <*> View g= View $
                    f >>= \(FormElm form1 k) ->
                    g >>= \(FormElm form2 x) ->
@@ -320,7 +322,6 @@   View f <|> View g= View $ do
                    FormElm form1 k <- f
                    FormElm form2 x <- g
-
                    return $ FormElm (form1 ++ form2) (k <|> x)
 
 
@@ -329,7 +330,7 @@                    FormElm form1 mk <- x
                    case mk of
                      Just k  -> do
-                        modify $ \st -> st{linkMatched= False} !> "------M--------"
+                        modify $ \st -> st{linkMatched= False} 
                         FormElm form2 mk <- runView $ f k
                         return $ FormElm (form1 ++ form2) mk
 
@@ -340,7 +341,7 @@                    FormElm form1 mk <- x
                    case mk of
                      Just k  -> do
-                        modify $ \st -> st{linkMatched= False} !> "------M--------"
+                        modify $ \st -> st{linkMatched= False} 
                         FormElm form2 mk <- runView  f 
                         return $ FormElm (form1 ++ form2) mk
 
@@ -359,13 +360,13 @@ 
 -- | It is a callback in the view monad. The callback rendering substitutes the widget rendering
 -- when the latter is validated, without afecting the rendering of other widgets. This allow
--- the simultaneous execution of different behaviours in different widgets simultaneously in the
+-- the simultaneous execution of different behaviours in different widgets in the
 -- same page. The inspiration is the callback primitive in the Seaside Web Framework
 -- that allows similar functionality (See <http://www.seaside.st>)
 --
 -- This is the visible difference with 'waction' callbacks, which execute a
 -- a flow in the FlowM monad that takes complete control of the navigation, while wactions are
--- executed whithin the same ask statement.
+-- executed whithin the same page.
 wcallback
   :: Monad m =>
      View view m a -> (a -> View view m b) -> View view m b
@@ -373,10 +374,11 @@    FormElm form1 mk <- x
    case mk of
      Just k  -> do
-       modify $ \st -> st{linkMatched= False} !> "-------C-------"
+       modify $ \st -> st{linkMatched= False} 
        runView (f k)
      Nothing -> return $ FormElm form1 Nothing
-
++   
 --incLink :: MonadState (MFlowState view) m => m()
 --incLink= modify $ \st -> st{mfPIndex= if linkMatched st then mfPIndex  st + 1 else mfPIndex st
 --                ,linkMatched= False}  -- !> "<-inc"
@@ -409,7 +411,7 @@   lift f = View $  (lift  f) >>= \x ->  return $ FormElm [] $ Just x
 
 instance MonadTrans (FlowM view) where
-  lift f = FlowM $ lift (lift  f) >>= \x ->  return x
+  lift f = FlowM $ lift (lift  f) -- >>= \x ->  return x
 
 instance  (Monad m)=> MonadState (MFlowState view) (View view m) where
   get = View $  get >>= \x ->  return $ FormElm [] $ Just x
@@ -461,17 +463,14 @@ -- However this is very specialized. Normally the back button detection is not necessary.
 -- In a persistent flow (with step) even this default entry option would be completely automatic,
 -- since the process would restar at the last page visited. No setting is necessary.
-goingBack :: (MonadIO m,MonadState (MFlowState view) m) => m Bool
+goingBack :: MonadState (MFlowState view) m => m Bool
 goingBack = do
     st <- get
-    liftIO $ do
-      print $"Insync=" ++ show (inSync st)
-      print $ "newAsk st=" ++ show (newAsk st)
     return $ not (inSync st) && not (newAsk st)
 
--- | Will prevent the backtrack beyond the point where 'preventGoingBack' is located.
+-- | Will prevent the Suprack beyond the point where 'preventGoingBack' is located.
 -- If the  user press the back button beyond that point, the flow parameter is executed, usually
--- it is an ask statement with a message. If the flow is not going back, it does nothing. It is a cut in backtracking
+-- it is an ask statement with a message. If the flow is not going back, it does nothing. It is a cut in Supracking
 --
 -- It is useful when an undoable transaction has been commited. For example, after a payment.
 --
@@ -486,12 +485,11 @@ -- >   payIt= liftIO $ print "paying"
 
 preventGoingBack
-  :: (Functor m, MonadIO m, FormInput v) => FlowM v m () -> FlowM v m ()
+  :: ( Functor m, MonadIO m,  FormInput v) => FlowM v m () -> FlowM v m ()
 preventGoingBack msg= do
    back <- goingBack
-   liftIO $ putStr "BACK= ">> print back
    if not back  then breturn() else do
-         breturn()  -- will not go back bellond this
+         breturn()  -- will not go back beyond this
          clearEnv
          modify $ \s -> s{newAsk= True}
          msg
@@ -531,7 +529,7 @@    mfLinks          :: M.Map String Int,
 
    mfAutorefresh   :: Bool,
-   mfTrace          :: Maybe [String]
+   mfTrace          :: [String]
    }
    deriving Typeable
 
@@ -540,7 +538,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 Nothing
+                0 0 [] [] stdHeader False [] M.empty  Nothing 0 False    []   ""   1 Nothing False M.empty False []
 
 
 -- | Set user-defined data in the context of the session.
@@ -646,9 +644,14 @@ 
 
 -- | Return the current header
-getHeader :: (Monad m) => FlowM view m (view -> view)
+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+  
 -- | Set an HTTP cookie
 setCookie :: MonadState (MFlowState view) m
           => String  -- ^ name
@@ -668,15 +671,20 @@     modify $ \st -> st{mfHttpHeaders=  (n,v):mfHttpHeaders st }
 
 
--- | Set 1) the timeout of the flow execution since the last user interaction.
--- Once passed, the flow executes from the begining. 2). In persistent flows
+-- | Set+--  1) the timeout of the flow execution since the last user interaction.
+-- 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.
 -- persistent flows (that use `step`) restart at the las saved execution point, unless
 -- the session time has expired for the user.
-setTimeouts :: Monad m => Int -> Integer -> FlowM view m ()
+setTimeouts :: ( MonadState (MFlowState v) m) => Int -> Integer ->  m ()
 setTimeouts kt st= do
  fs <- get
  put fs{ mfkillTime= kt, mfSessionTime= st}
@@ -778,14 +786,15 @@ cachedWidget :: (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
+        -> Int     -- ^ Timeout of the caching. Zero means the whole server run
         -> View view Identity a   -- ^ The cached widget, in the Identity monad
         -> View view m a          -- ^ The cached result
 cachedWidget key t mf =  View .  StateT $ \s ->  do
         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
+                   ,mfRequirements=mfRequirements s2+                   ,mfPath= mfPath s2
                    ,mfSeqCache= mfSeqCache s + mfSeqCache s2 - sec}
         return $ (mfSeqCache s'') `seq`  ((FormElm form mx2), s'')
         -- !> ("enter: "++show (mfSeqCache s) ++" exit: "++ show ( mfSeqCache s2))
@@ -868,24 +877,24 @@ runFlow :: (FormInput view, MonadIO m)
         => FlowM view m () -> Token -> m () 
 runFlow  f t=
-  loop (runFlowOnce1  f) t --evalStateT (runBackT . runFlowM $ breturn() >>  f)  mFlowState0{mfToken=t,mfEnv= tenv t}  >> return ()  -- >> return ()
+  loop (runFlowOnce1  f) t --evalStateT (runSup . runFlowM $ breturn() >>  f)  mFlowState0{mfToken=t,mfEnv= tenv t}  >> return ()  -- >> return ()
   where
   loop f t = do
     t' <- f t
     let t''= t'{tpath=[twfname t']}
     liftIO $ do
        flushRec t''
-       sendToMF t'' t'' -- !> "SEND"
-    loop  f t''         -- !> "LOOPAGAIN"
+       sendToMF t'' t''  -- !> "SEND"
+    loop  f t''          -- !> "LOOPAGAIN"
 
 
 
-runFlowOnce :: (FormInput view,  Monad m)
+runFlowOnce :: (MonadIO m, FormInput view,  Monad m)
         => FlowM view m () -> Token -> m ()
 runFlowOnce f t= runFlowOnce1 f t  >> return ()
 
 runFlowOnce1  f t  =
-  evalStateT (runBackT . runFlowM $ do
+  evalStateT (runSup . runFlowM $ do
         backInit
         f
         getToken)
@@ -894,9 +903,17 @@                    ,mfEnv= tenv t} >>= return . fromFailBack
 
   where
-  backInit= do
-     modify $ \s -> s{mfEnv=[], newAsk= True}
-     breturn ()
+  backInit= do+     s <- get                       -- !> "BackInit"+     case mfTrace s of+       [] -> do
+         modify $ \s -> s{mfEnv=[], newAsk= True}
+         breturn ()+       tr -> do+         th <- liftIO myThreadId+         error $ show th ++ 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
 
 
@@ -913,10 +930,10 @@   -> FlowM view m b
 runFlowIn wf f= do
   t <- gets mfToken
-  FlowM .  BackT $ liftIO $ WF.exec1nc wf $ runFlow1 f t
+  FlowM .  Sup $ liftIO $ WF.exec1nc wf $ runFlow1 f t
 
   where
-  runFlow1 f t=   evalStateT (runBackT . runFlowM $ f)  mFlowState0{mfToken=t,mfEnv= tenv t}  -- >>= return . fromFailBack  -- >> return ()
+  runFlow1 f t=   evalStateT (runSup . runFlowM $ f)  mFlowState0{mfToken=t,mfEnv= tenv t}  -- >>= return . fromFailBack  -- >> return ()
 
 -- | to unlift a FlowM computation. useful for executing the configuration generated by runFLowIn
 -- outside of a web application
@@ -926,7 +943,7 @@   q  <- liftIO newEmptyMVar  -- `debug` (i++w++u)
   qr <- liftIO newEmptyMVar
   let t=  Token "" "" "" [] [] q  qr
-  evalStateT (runBackT . runFlowM $   f )  mFlowState0{mfToken=t} >>= return . fromFailBack   -- >> return ()
+  evalStateT (runSup . runFlowM $   f )  mFlowState0{mfToken=t} >>= return . fromFailBack   -- >> return ()
 
 
 
@@ -946,10 +963,10 @@       -> FlowM view (Workflow m) a
 step f= do
    s <- get
-   flowM $ BackT $ do
-        (r,s') <-  lift . WF.step $ runStateT (runBackT $ runFlowM f) s
+   flowM $ Sup $ do
+        (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}
+        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@@ -964,8 +981,8 @@       -> FlowM view (Workflow IO) a
 transientNav f= do
    s <- get
-   flowM $ BackT $ do
-        (r,s') <-  lift . unsafeIOtoWF $ runStateT (runBackT $ runFlowM f) s+   flowM $ Sup $ do
+        (r,s') <-  lift . unsafeIOtoWF $ runStateT (runSup $ runFlowM f) s         put s'
         return r
 
@@ -979,17 +996,17 @@ --      -> FlowM view (Workflow m) (WFRef (FailBack a),a)
 --stepWFRef f= do
 --   s <- get
---   flowM $ BackT $ do
---        (r,s') <-  lift . WF.stepWFRef $ runStateT (runBackT $ runFlowM f) s
+--   flowM $ Sup $ do
+--        (r,s') <-  lift . WF.stepWFRef $ runStateT (runSup $ runFlowM f) s
 --        -- when recovery of a workflow, the MFlow state is not considered
 --        when( mfSequence s' >0) $ put s'
 --        return r
 
 --step f= do
 --   s <- get
---   flowM $ BackT $ do
+--   flowM $ Sup $ do
 --        (r,s') <-   do
---               (br,s') <- runStateT (runBackT $ runFlowM f) s
+--               (br,s') <- runStateT (runSup $ runFlowM f) s
 --               case br of
 --                 NoBack r    -> WF.step $ return  r
 --                 BackPoint r -> WF.step $ return  r
@@ -1009,7 +1026,7 @@ --      Typeable a) =>
 --      FlowM view m a
 --      -> FlowM view (Workflow m) a
---stepDebug f= BackT  $ do
+--stepDebug f= Sup  $ do
 --      s <- get
 --      (r, s') <- lift $ do
 --              (r',stat)<- do
@@ -1018,7 +1035,7 @@ --                          True ->do (r',  s'') <- getStep 0
 --                                    return (r',s{mfEnv= mfEnv (s'' `asTypeOf`s)})
 --                          False -> return (undefined,s)
---              (r'', s''') <- WF.stepDebug  $ runStateT  (runBackT f) stat >>= \(r,s)-> return (r, s)
+--              (r'', s''') <- WF.stepDebug  $ runStateT  (runSup f) stat >>= \(r,s)-> return (r, s)
 --              return $ (r'' `asTypeOf` r', s''' )
 --     put s'
 --     return r
@@ -1102,7 +1119,7 @@ 
  installAllRequirements1 v []= return v
  installAllRequirements1 v rs= do
-   let typehead= case head rs !> "head i1" of {Requirement r -> typeOf  r}
+   let typehead= case head rs  of {Requirement r -> typeOf  r}
        (rs',rs'')= partition1 typehead  rs
    v' <- installRequirements2 rs'
    installAllRequirements1 (v `mappend` v') rs''
@@ -1244,10 +1261,10 @@                False -> return (mempty,mempty)
      return $ formAction (path ++ anchor ) $  mconcat ( anchorf:form)  -- !> anchor
 
-currentPath isInBackTracking index lpath verb =
+currentPath insInBackTracking index lpath verb =
     (if null lpath then verb
-     else case isInBackTracking of
-        True   -> concat $ take index  ['/':v | v <- lpath]  !> ("index= " ++ show index)
+     else case insInBackTracking of
+        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

@@ -48,9 +48,7 @@ import Data.Dynamic
 import Data.TCache.Memoization
 
-import Debug.Trace
-
-(!>)= flip trace
+ 
 class Generate a where
   generate :: IO a
@@ -142,7 +140,7 @@ --  it is a substitute of 'ask' from "MFlow.Forms" for testing purposes.
 
 -- execute 'runText' to initiate threads under different load conditions.
-ask :: (Generate a, MonadIO m, Functor m, FormInput v,Typeable v) => View v m a -> FlowM v m a
+ask :: (Generate a, MonadIO m,  Functor m, FormInput v,Typeable v) => View v m a -> FlowM v m a
 ask w = do
     FormElm forms mx <- FlowM . lift $ runView  w
     r <- liftIO generate
@@ -166,7 +164,7 @@ --
 -- It forces the web page rendering, since it is monadic so it can contain
 -- side effects and load effects to be tested.
-askt :: (MonadIO m,FormInput v) => (Int -> a) -> View v m a -> FlowM v m a
+askt :: (MonadIO m, FormInput v) => (Int -> a) -> View v m a -> FlowM v m a
 askt v w =  do
     FormElm forms mx <- FlowM . lift $ runView  w
     n <- getTestNumber
@@ -243,7 +241,7 @@ --    in  getPar form
 --
 
-waction ::(Functor m, MonadIO m,Generate a, FormInput view)
+waction :: (Functor m, MonadIO m,Generate a, FormInput view)
      => View view m a
      -> (a -> FlowM view m b)
      -> View view m b
@@ -272,14 +270,14 @@          put st{mfToken= t'}
          return ()
    
-getUserSimple :: ( FormInput view, Typeable view
-                 , MonadIO m, Functor m)
+getUserSimple :: ( MonadIO m, FormInput view, Typeable view
+                 ,  Functor m)
               => FlowM view m String
 getUserSimple= getUser Nothing userFormLine
 
 
 getUser :: ( FormInput view, Typeable view
-           , MonadIO m, Functor m)
+           ,  Functor m,MonadIO m)
           => Maybe String
           -> View view m (Maybe (String,String), Maybe String)
           -> FlowM view m String

@@ -7,16 +7,22 @@  {-# LANGUAGE UndecidableInstances,ExistentialQuantification             , FlexibleInstances, OverlappingInstances, FlexibleContexts-            , OverloadedStrings, DeriveDataTypeable , ScopedTypeVariables #-}+            , OverloadedStrings, DeriveDataTypeable , ScopedTypeVariables+            , TemplateHaskell #-}     module MFlow.Forms.Widgets (+-- * Ajax refreshing of widgets+autoRefresh, appendUpdate, prependUpdate, push, UpdateMethod(..)+ -- * JQueryUi widgets-datePicker, getSpinner, wautocomplete, wdialog,+,datePicker, getSpinner, wautocomplete, wdialog,+ -- * User Management userFormOrName,maybeLogout,+ -- * Active widgets wEditList,wautocompleteList , wautocompleteEdit,@@ -24,14 +30,13 @@ -- * Editing widgets delEdited, getEdited ,prependWidget,appendWidget,setWidget+ -- * Content Management ,tField, tFieldEd, tFieldGen  -- * Multilanguage ,mFieldEd, mField -,autoRefresh- ) where import MFlow import MFlow.Forms@@ -52,9 +57,12 @@ import Data.IORef import MFlow.Cookies import Data.Maybe+import Data.Char import Control.Monad.Identity+import Control.Workflow(killWF)  + readyJQuery="ready=function(){if(!window.jQuery){return setTimeout(ready,100)}};"  jqueryScript1= "http://ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js"@@ -90,7 +98,6 @@           fromStr " " ++> ((wlink () (fromStr "logout")) <![("onclick",cmd "''")]) `waction` const logout       else noWidget ---- active widgets  data Medit view m a = Medit (M.Map B.ByteString [(String,View view m a)]) instance (Typeable view, Typeable a)@@ -258,29 +265,29 @@     delEdited sel ws'     return r -wpush-  :: (Typeable a,-      FormInput v) =>-     (v -> v)-     -> String-     -> String-     -> String-     -> (String -> View v IO a)-     -> View v IO a-wpush  holder modifier addId expr w = do-    id1<- genNewId-    let sel= "$('#" <>  B.pack id1 <> "')"-    callAjax <- ajax $ \s ->  appendWidget sel ( changeMonad $ w s)-    let installevents= "$(document).ready(function(){\-              \$('#"++addId++"').click(function(){"++callAjax expr ++ "});})"--    requires [JScriptFile jqueryScript [installevents] ]--    ws <- getEdited sel--    r <-  holder  <<< firstOf ws  <! [("id",id1)]-    delEdited sel ws-    return r+--wpush+--  :: (Typeable a,+--      FormInput v) =>+--     (v -> v)+--     -> String+--     -> String+--     -> String+--     -> (String -> View v IO a)+--     -> View v IO a+--wpush  holder modifier addId expr w = do+--    id1 <- genNewId+--    let sel= "$('#" <>  B.pack id1 <> "')"+--    callAjax <- ajax $ \s ->  appendWidget sel ( changeMonad $ w s)+--    let installevents= "$(document).ready(function(){\+--              \$('#"++addId++"').click(function(){"++callAjax expr ++ "});})"+--+--    requires [JScriptFile jqueryScript [installevents] ]+--+--    ws <- getEdited sel+--+--    r <-  holder  <<< firstOf ws  <! [("id",id1)]+--    delEdited sel ws+--    return r   @@ -485,7 +492,7 @@     content <- liftIO $ getcontent  k     admin   <- getAdminName     ajaxjs  <- ajax  $ \str -> do-              let (k,s)= break (==',')    str !> str+              let (k,s)= break (==',')    str  -- !> str               liftIO  . create  k  $ fromStrNoEncode (tail s)               liftIO $ flushCached k               return "alert('saved')"@@ -586,11 +593,12 @@   --- | Capture the form submissions and the links of the enclosed widget and send them via AJAX.--- The response is the new presentation of the widget, that is updated. No navigation occur.--- So a widget with autoRefresh can be used in heavyweight pages.--- If AJAX or javascript is not available, the widget is refresh normally, via a new page.--- The enclosed widget if has form elements, must include the form action tag, not a part of it.+-- | Capture the form submissions and the links of the enclosed widget and send them via jQuery AJAX.+-- The response is the new presentation of the widget, that is updated. No new page is generated+-- but the functionality is equivalent. Only the activated widget is executed in the server and updated+-- in the client, so a widget with autoRefresh can be used in heavyweight pages.+-- If AJAX/JavaScript are not available, the widget is refreshed normally, via a new page.+-- If has form elements, the enclosed widget must be a complete form and it must include the form action tag. -- For this purpose, autoRefresh encloses the widget in a form tag if there are form elements on it -- and the programmer has not enclosed them in a 'wform' element. autoRefresh@@ -598,8 +606,26 @@      FormInput v)   => View v m a   -> View v m a-autoRefresh w=  do+autoRefresh w=  update "html" w++-- | does the same than autoRefresh but append the result of each request to the bottom of the widget+appendUpdate  :: (MonadIO m,+     FormInput v)+  => View v m a+  -> View v m a+appendUpdate= update "append"++-- | does the same than autoRefresh but prepend the result of each request before the current widget content+prependUpdate   :: (MonadIO m,+     FormInput v)+  => View v m a+  -> View v m a+prependUpdate= update "prepend"++update method w= do     id <- genNewId+    st <- get+    let t = mfkillTime st -1      let installscript=             "$(document).ready(function(){\n"@@ -607,40 +633,44 @@                ++ "ajaxPostForm('"++id++"');"                ++ "})\n" -    st <- get--    r <- getParam1 ("auto"++id) $ mfEnv st+    r <- getParam1 ("auto"++id) $ mfEnv st           -- !> ("TIMEOUT="++ show t)     case r of       NoParam -> do-         requires [JScript ajaxGetLink+         requires [JScript $ timeoutscript t+                  ,JScript ajaxGetLink                   ,JScript ajaxPostForm                   ,JScriptFile jqueryScript [installscript]]-         (ftag "div" <<< insertForm w) <! [("id",id)]
+         (ftag "div" <<< insertForm w) <! [("id",id)] 
        Validated (x :: String) -> View $ do          let t= mfToken st          FormElm form mr <- runView $ insertForm w          st <- get          let HttpData ctype c s= toHttpData $ mconcat form-         liftIO . sendFlush t $ HttpData (ctype ++ mfHttpHeaders st) (mfCookies st ++ c) s+         liftIO . sendFlush t $ HttpData (ctype ++ ("Cache-Control", "no-cache, no-store"):mfHttpHeaders st) (mfCookies st ++ c) s          put st{mfAutorefresh=True}          return $ FormElm [] mr    where-  -- | adapted from http://www.codeproject.com/Articles/341151/Simple-AJAX-POST-Form-and-AJAX-Fetch-Link-to-Modal +  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\     \var id1= $('#'+id);\n\-   \var ida= $('#'+id+' a');\n\+    \var ida= $('#'+id+' a');\n\     \ida.click(function () {\n\-    \   var pdata = $(this).attr('data-value');\n\-    \   var actionurl = $(this).attr('href');\n\-    \   var dialogOpts = {\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+'=true',\n\     \       data: pdata,\n\     \       success: function (resp) {\n\-    \         id1.html(resp);\n\+    \         id1."++method++"(resp);\n\     \         ajaxGetLink(id)\n\     \       },\n\     \       error: function (xhr, status, error) {\n\@@ -648,8 +678,8 @@     \           id1.html(msg);\n\     \       }\n\     \   };\n\-    \   $.ajax(dialogOpts);\n\-    \   return false;\n\+    \$.ajax(dialogOpts);\n\+    \return false;\n\     \});\n\   \}" @@ -657,6 +687,7 @@     \var id1= $('#'+id);\n\     \var idform= $('#'+id+' form');\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\@@ -666,7 +697,7 @@             \url: url,\n\             \data: 'auto'+id+'=true&'+pdata,\n\             \success: function (resp) {\n\-                \id1.html(resp);\n\+                \id1."++method++"(resp);\n\                 \ajaxPostForm(id)\n\             \},\n\             \error: function (xhr, status, error) {\n\@@ -678,6 +709,137 @@       \return false;\n\      \}" +data UpdateMethod= Append | Prepend | Html deriving Show++-- | continously execute a widget and update the content.+-- The update method specify how the update is done. 'Html' means a substitution of content.+-- The second parameter is the delay for the next retry in case of disconnection, in milliseconds.+--+-- It can be used to show data updates in the server. The widget is executed in a different process than+--  the one of the rest of the page. Although the process is initiated with the session context,+-- updates in the session context are not seen by the push widget+-- To communicate with te widget, use DBRef's or TVar and the+-- STM semantics for waiting updates using 'retry'.+--+-- Widgets in a push can have links and forms, but since they are asunchonous, they can not+-- return validated inputs. but they can modify the server state.+-- push ever return invalid to the calling widget, so it never+-- triggers the advance of the navigation.+--+--+-- This example is a counter increased each second:+--+-- > pushIncrease= do+-- >   tv <- liftIO $ newTVarIO 0+-- >   page $ push 0 Html $ do+-- >       n <- atomic $ readTVar tv+-- >       atomic $ writeTVar tv $ n + 1+-- >       liftIO $ threadDelay 1000000+-- >       b << (show n) ++> noWidget+--+--+-- This other  simulates a console output that echoes what is entered in a text box+-- below. It has two widgets: a push output in append mode and a text box input.+-- The communication it uses a TVar. The push widget wait for updates in the TVar.+-- because the second widget uses autoRefresh, all happens in the same page.+--+-- It is recommended to add a timeout to the push widget, like in the example:+--+-- >  pushSample=  do+-- >   tv <- liftIO $ newTVarIO $ Just "init"+-- >   page $ push Append 1000 (disp tv) <** input tv+-- >+-- >   where+-- >   disp tv= do+-- >       setTimeouts 100 0+-- >       line <- tget tv+-- >       p <<  line ++> noWidget+-- >+-- >   input tv= autoRefresh $ do+-- >       line <- getString Nothing <** submitButton "Enter"
+-- >       tput tv line+-- >+-- >   tput tv x = atomic $ writeTVar  tv ( Just x)  !> "WRITE"+-- >+-- >   tget tv= atomic $ do+-- >       mr <- readTVar tv+-- >       case mr of+-- >          Nothing -> retry+-- >          Just r -> do+-- >           writeTVar tv Nothing+-- >           return r++push :: FormInput v+  => UpdateMethod+  -> Int+  -> View v IO ()+  -> View v IO ()+push method' wait w= push' . map toLower $ show method'+ where+ push' method= do+    id <- genNewId+    st <- get+    let token= mfToken st+        dat= mfData st+        procname= "_push" ++ tind token ++ id+        installscript=+            "$(document).ready(function(){\n"+               ++ "ajaxPush('"++id++"',"++show wait++");"+               ++ "})\n"++    new <- gets newAsk++    when new  $ do+        killWF procname token{twfname= procname}+        let proc= transient . runFlow . ask $ w' dat+        requires [ServerProc (procname, proc),+                  JScript $ ajaxPush procname,+                  JScriptFile jqueryScript [installscript]]++++    (ftag "div" <<< noWidget) <! [("id",id)]+      <++ ftag "div" mempty `attrs` [("id",id++"status")]++   where+   w' dat= do+     modify $ \s -> s{inSync= True,newAsk=True,mfData=dat}+     w+++   ajaxPush procname=" function ajaxPush(id,waititime){\n\+    \var cnt=0; \n\+    \var id1= $('#'+id);\n\+    \var idstatus= $('#'+id+'status');\n\+    \var ida= $('#'+id+' a');\n\+    \   var actionurl='/"++procname++"';\n\+    \   var dialogOpts = {\n\+    \       cache: false,\n\+    \       type: 'GET',\n\+    \       url: actionurl,\n\+    \       data: '',\n\+    \       success: function (resp) {\n\+    \         idstatus.html('')\n\+    \         cnt=0;\n\+    \         id1."++method++"(resp);\n\+    \         ajaxPush1();\n\+    \       },\n\+    \       error: function (xhr, status, error) {\n\+    \            cnt= cnt + 1;\n\+    \            if (cnt > 6)\n\+    \               idstatus.html('no more retries');\n\+    \            else {\n\+    \               idstatus.html('waiting');\n\+    \               setTimeout(function() { idstatus.html('retrying');ajaxPush1(); }, waititime);\n\+    \            }\n\+    \       }\n\+    \   };\n\+    \function ajaxPush1(){\n\+    \   $.ajax(dialogOpts);\n\+    \   return false;\n\+    \ }\n\+    \ ajaxPush1();\n\+  \}"  -- | show the jQuery spinner widget. the first parameter is the configuration . Use \"()\" by default. -- See http://jqueryui.com/spinner

@@ -44,7 +44,7 @@ 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"
@@ -89,7 +89,7 @@ waiMessageFlow req1=   do
      let httpreq1= getParams  req1 
 
-     let cookies=getCookies  httpreq1
+     let cookies = getCookies  httpreq1
 
      (flowval , retcookies) <-  case lookup flow cookies of
               Just fl -> return  (fl, [])
@@ -125,7 +125,7 @@ 
      let resp= case (resp',retcookies) of
             (_,[]) -> resp'
-            (error@(Error _ _),_) -> error
+            (error@(Error _),_) -> error
             (HttpData hs co str,_) -> HttpData hs (co++ retcookies)  str
 
      return $ toResponse resp
@@ -154,9 +154,9 @@       Just str -> do
         swapMVar tvresources Nothing
         return $  Just  (statCookieName,  str , "/")
---+
+
+
     
 {-
 persistInCookies= setPersist  PersistStat{readStat=readResource, writeStat=writeResource, deleteStat=deleteResource}

@@ -54,6 +54,9 @@ 
 instance  ToResponse HttpData  where
   toResponse (HttpData hs cookies x)= responseLBS status200 (mkParams ( hs ++ cookieHeaders cookies)) x
-  toResponse (Error NotFound str)=  error "FATAL ERROR: HttpData errors should not reach here: MFlow.Forms.Response.hs " -- responseLBS status404 [] $ (unsafePerformIO  getNotFoundResponse) str
+  toResponse (Error str)=  responseLBS status404 [("Content-Type", "text/html")] str
+
+--  toResponse $ error "FATAL ERROR: HttpData errors should not reach here: MFlow.Forms.Response.hs "
+