MFlow 0.2.0.0 → 0.2.0.1
raw patch · 7 files changed
+21/−302 lines, 7 files
Files
- Demos/ShoppingCart.Wai.hs +0/−51
- Demos/ShoppingCart.hs +0/−46
- Demos/demos.blaze.hs +15/−14
- Demos/demos.hs +0/−185
- MFlow.cabal +2/−3
- src/MFlow/Forms/Internals.hs +1/−1
- src/MFlow/Forms/Widgets.hs +3/−2
− Demos/ShoppingCart.Wai.hs
@@ -1,51 +0,0 @@-{-# OPTIONS -XDeriveDataTypeable -XScopedTypeVariables #-}-module Test where--{--A stateless flow example. Convert it into persistent by uncommenting {- step -} and see the differences.--after 10 seconds without user interaction, the process is killed (set by setTimeout)-:l demos\shoppingCart.Wai.hs--}--import MFlow.Wai-import MFlow.Forms-import Text.XHtml-import MFlow.Forms.XHtml-import Control.Concurrent-import Network.Wai.Handler.Warp-import MFlow.Forms.Admin-import qualified Data.Vector as V----main= do--- syncWrite SyncManual- addMessageFlows messageFlows- forkIO $ run 80 waiMessageFlow- adminLoop---messageFlows= [("", runFlow shopCart )- ,("stateless", stateless st)]--st _ = return "hi"----shopCart1 :: V.Vector Int -> FlowM (Workflow IO) b-shopCart = do- setTimeouts 10 0- shopCart1 (V.fromList [0,0,0:: Int])- where- shopCart1 cart= do- i <- {-step . -} ask- $ table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"]- <<< caption << "choose an item"- ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"]- ++> (tbody- <<< (tr <<< td <<< wlink 0 (bold <<"iphone") <++ td << ( bold << show ( cart V.! 0))- <|> tr <<< td <<< wlink 1 (bold <<"ipad") <++ td << ( bold << show ( cart V.! 1))- <|> tr <<< td <<< wlink 2 (bold <<"ipod") <++ td << ( bold << show ( cart V.! 2)))- )- let newCart= cart V.// [(i, cart V.! i + 1 )]- shopCart1 newCart-
− Demos/ShoppingCart.hs
@@ -1,46 +0,0 @@-{-# OPTIONS -XDeriveDataTypeable -XScopedTypeVariables #-}-module Test where--{--A stateless flow example. Convert it into persistent by uncommenting {- step -} and see the differences.--after 10 seconds without user interaction, the process is killed (set by setTimeout)---}--import MFlow.Hack.XHtml.All-import Control.Concurrent--import qualified Data.Vector as V----main= do--- syncWrite SyncManual- addMessageFlows messageFlows- forkIO $ run 80 hackMessageFlow- adminLoop----messageFlows= [("", runFlow shopCart )]-----shopCart1 :: V.Vector Int -> FlowM (Workflow IO) b-shopCart = do- setTimeouts 10 0- shopCart1 (V.fromList [0,0,0:: Int])- where- shopCart1 cart= do- i <- {-step . -} ask- $ table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"]- <<< caption << "choose an item"- ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"]- ++> (tbody- <<< (tr <<< td <<< wlink 0 (bold <<"iphone") <++ td << ( bold << show ( cart V.! 0))- <|> tr <<< td <<< wlink 1 (bold <<"ipad") <++ td << ( bold << show ( cart V.! 1))- <|> tr <<< td <<< wlink 2 (bold <<"ipod") <++ td << ( bold << show ( cart V.! 2)))- )- let newCart= cart V.// [(i, cart V.! i + 1 )]- shopCart1 newCart-
Demos/demos.blaze.hs view
@@ -1,15 +1,11 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveDataTypeable, NoMonomorphismRestriction #-} module Main where import MFlow.Wai.Blaze.Html.All-import MFlow.Forms.Internals import Text.Blaze.Html5 as El import Text.Blaze.Html5.Attributes as At hiding (step) import Data.String import Data.List-import MFlow-import MFlow.FileServer import Data.TCache-import Data.TCache.Memoization import Data.Typeable import Control.Monad.Trans import Control.Concurrent@@ -33,7 +29,7 @@ -- adminLoop -stdheader c= html << El.head << body << (p << text "You can press the back button" <> c)+stdheader c= docTypeHtml << El.head << body << (p << text "You can press the back button" <> c) data Options= CountI | CountS | Radio | Login | TextEdit |Grid | Autocomp | AutocompList@@ -42,7 +38,9 @@ mainmenu= do setHeader stdheader- r <- ask $ br ++> wlink CountI (b << text "increase an Int")+ setTimeouts 100 0+ r <- ask $ wcached "menu" 0 $+ br ++> wlink CountI (b << text "increase an Int") <|> br ++> wlink CountS (b << text "increase a String") <|> br ++> wlink Action (b << text "Example of action, executed when a widget is validated") <|> br ++> wlink Select (b << text "select options")@@ -55,11 +53,11 @@ <|> br ++> wlink ListEdit (b << text "list edition") <|> br ++> wlink Grid (b << text "grid") <|> br ++> wlink TextEdit (b << text "Content Management")-- <++ br <> br <> b << text "OTHERS"- <|> br ++> wlink Shop (b << text "example of transfer to another flow (shopping)")+ <++ br <> br <> b << text "STATEFUL PERSISTENT FLOW"+ <> br <> a ! href "shop" << text "shopping" -- ordinary Blaze.Html link+ <> br <> br <> b << text "OTHERS"+ <|> br ++> wlink Shop (b << text "Example of server-side redirection to another flow (shopping)") <|> br ++> wlink Login (b << text "login/logout")- <++ (br <> a ! href "shop" << text "shopping") -- ordinary Blaze.Html link case r of@@ -86,7 +84,7 @@ setOption "Red" (b << text "red") ) <! dosummit ask $ p << (r ++ " selected") ++> wlink () (p << text " menu") - mainmenu -- breturn() would do it as well+ mainmenu -- breturn() would do it as well where dosummit= [("onchange","this.form.submit()")] @@ -216,10 +214,13 @@ data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum,Read, Show, Typeable) --- A persistent flow (uses step). The process is killed after 10 seconds of inactivity--- but it is restarted automatically. if you restart the program, it remember the shopping cart--- defines a table with links enclosed that return ints and a link to the menu, that abandon this flow. shopCart = do+ setHeader $ \html -> El.span << text+ "A persistent flow (uses step). The process is killed after 10 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 10 0 shopCart1 (V.fromList [0,0,0:: Int]) where
− Demos/demos.hs
@@ -1,185 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, NoMonomorphismRestriction #-} -module Main where -<<<<<<< HEAD -import MFlow.Wai.XHtml.All -- hiding (ask) -======= -import MFlow.Hack.XHtml.All -- hiding (ask) ->>>>>>> 393fb07bfb3f14b6557dff6fb36fedfcbb786ac6 ---import MFlow.Forms.Test -import MFlow -import MFlow.FileServer -import MFlow.Forms.Ajax -import MFlow.Forms.Admin -import MFlow.Forms -<<<<<<< HEAD -import Text.XHtml -======= ->>>>>>> 393fb07bfb3f14b6557dff6fb36fedfcbb786ac6 -import Data.TCache -import Control.Monad.Trans -import Data.Typeable - -import Control.Concurrent -import Control.Exception as E -import qualified Data.ByteString.Char8 as SB -import qualified Data.Vector as V -import Data.Maybe - ---test= runTest [(15,"shop")] - -main= do - syncWrite SyncManual - setFilesPath "" - addFileServerWF - addMessageFlows [("" ,transient $ runFlow mainf), - ("shop" ,runFlow shopCart)] -<<<<<<< HEAD - wait $ run 80 waiMessageFlow --- adminLoop -- for debug - -stdheader c= thehtml << body << (p << "you can press the back button to go to the menu"+++ c) -======= - run 80 hackMessageFlow - - adminLoop - -stdheader c= thehtml << body << (p << "you can press the back button"+++ c) ->>>>>>> 393fb07bfb3f14b6557dff6fb36fedfcbb786ac6 - -data Options= CountI | CountS | TextEdit |Shop | Action | Ajax | Select deriving (Bounded, Enum,Read, Show,Typeable) - -mainf= do - setHeader stdheader - r <- ask $ br ++> wlink TextEdit (bold << "Content Management") - <|> br ++> wlink Shop (bold << "example of transfer to another flow (shopping)") - <|> br ++> wlink CountI (bold << "increase an Int") - <|> br ++> wlink CountS (bold << "increase a String") - <|> br ++> wlink Action (bold << "Example of a string widget with an action") - <|> br ++> wlink Ajax (bold << "Simple AJAX example") - <|> br ++> wlink Select (bold << "select options") - <++ (br +++ linkShop) -- this is an ordinary XHtml link - - - case r of - CountI -> clickn 0 - CountS -> clicks "1" - Action -> actions 1 - Ajax -> ajaxsample - Select -> options - TextEdit -> textEdit - Shop -> transfer "shop" - mainf - - where - linkShop= toHtml $ hotlink "shop" << "shopping" - -options= do - r <- ask $ getSelect (setSelectedOption "" (p <<"select a option") <|> - setOption "blue" (bold << "blue") <|> - setOption "Red" (bold << "red") ) <! dosummit - ask $ p << (r ++ " selected") ++> wlink () (p<< " menu") - breturn() - where - dosummit= [("onchange","this.form.submit()")] - -clickn (n :: Int)= do - setHeader stdheader - r <- ask $ wlink "menu" (p << "menu") - |+| getInt (Just n) <* submitButton "submit" - case r of - (Just _,_) -> breturn () - (_, Just n') -> clickn $ n'+1 - - -clicks s= do - setHeader stdheader - s' <- ask $ (getString (Just s) - <* submitButton "submit") - `validate` (\s -> return $ if length s > 5 then Just "length must be < 5" else Nothing ) - clicks $ s'++ "1" - - - -ajaxsample= do - let ajaxf n= return $ "document.getElementById('text1').value='"++show(read n +1)++"'" - ajaxc <- ajaxCommand "document.getElementById('text1').value" ajaxf - - ask $ requires[JScript ajaxScript] - >> getInt (Just 0) <! [("id","text1"),("onclick", ajaxc)] - breturn() - - -actions n=do - ask $ wlink () (p << "exit from action") - <**((getInt (Just (n+1)) <** submitButton "submit" ) `waction` actions ) - breturn () - -data ShopOptions= IPhone | IPod | IPad deriving (Bounded, Enum,Read, Show, Typeable) - --- A persistent flow (uses step). The process is killed after 10 seconds of inactivity --- but it is restarted automatically. if you restart the program, it remember the shopping cart --- defines a table with links enclosed that return ints and a link to the menu, that abandon this flow. -shopCart = do - setTimeouts 10 0 - shopCart1 (V.fromList [0,0,0:: Int]) - where - shopCart1 cart= do - o <- step . ask $ - table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"] - <<< caption << "choose an item" - ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"] - ++> (tbody - <<< tr ! [rowspan 2] << td << linkHome - ++> (tr <<< td <<< wlink IPhone (bold <<"iphone") <++ td << ( bold << show ( cart V.! 0)) - <|> tr <<< td <<< wlink IPad (bold <<"ipad") <++ td << ( bold << show ( cart V.! 1)) - <|> tr <<< td <<< wlink IPod (bold <<"ipod") <++ td << ( bold << show ( cart V.! 2))) - <++ tr << td << linkHome - ) - let i =fromEnum o - let newCart= cart V.// [(i, cart V.! i + 1 )] - shopCart1 newCart - - where - linkHome= (toHtml $ hotlink noScript << bold << "home") - - - - --- an example of content management -textEdit= do - setHeader $ \html -> thehtml << body << html - - let first= p << italics << - (thespan << "this is a page with" - +++ bold << " two " +++ thespan << "paragraphs") - - second= p << italics << "This is the original text of the second paragraph" - - pageEditable = (tFieldEd "first" first) - **> (tFieldEd "second" second) - - ask $ first - ++> second - ++> wlink () (p << "click here to edit it") - - setAdminUser "admin" "admin" - - ask $ p << "Please login with admin/admin to edit it" - ++> userWidget (Just "admin") userLogin - - ask $ p << "now you can click the field and edit them" - ++> p << bold << "to save the edited field, double click on it" - ++> pageEditable - **> wlink () (p << "click here to see it as a normal user") - - logout - - ask $ p << "the user sees the edited content. He can not edit" - ++> pageEditable - **> wlink () (p << "click to continue") - - ask $ p << "When text are fixed,the edit facility and the original texts can be removed. The content is indexed by the field key" - ++> tField "first" - **> tField "second" - **> p << "End of edit field demo" ++> wlink () (p << "click here to go to menu") - breturn ()
MFlow.cabal view
@@ -1,5 +1,5 @@ name: MFlow-version: 0.2.0.0+version: 0.2.0.1 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -44,8 +44,7 @@ category: Web, Application Server author: Alberto Gómez Corona data-dir: ""-extra-source-files: Demos/ShoppingCart.hs Demos/ShoppingCart.Wai.hs- Demos/demos.hs Demos/demos.blaze.hs+extra-source-files: Demos/demos.blaze.hs source-repository head type: git
src/MFlow/Forms/Internals.hs view
@@ -933,7 +933,7 @@ ""++ "xmlhttp.onreadystatechange=function()" ++ " {" ++- " if (xmlhttp.readyState + xmlhttp.status==204)" +++ " if (xmlhttp.readyState== 4 && xmlhttp.status==200)" ++ " { " ++ " eval(xmlhttp.responseText);" ++ " }" ++
src/MFlow/Forms/Widgets.hs view
@@ -53,7 +53,7 @@ readyJQuery="ready=function(){if(!window.jQuery){return setTimeout(ready,100)}};" -jqueryScript= "http://ajax.googleapis.com/ajax/libs/jquery/1.8.0/jquery.min.js"+jqueryScript= "http://ajax.googleapis.com/ajax/libs/jquery/1.8.3/jquery.min.js" jqueryCSS= "http://code.jquery.com/ui/1.9.1/themes/base/jquery-ui.css" @@ -322,7 +322,8 @@ \ $('#text1').keydown(function(){ \ \ if(event.keyCode == 13){ \ \ var v= $('#text1').attr('value'); \- \ event.preventDefault();" +++ \ if(event.preventDefault) event.preventDefault();\+ \ else if(event.returnValue) event.returnValue = false;" ++ ajaxc "'f'+v"++";"++ " $('#text1').val('');\ \ }\