diff --git a/Demos/ShoppingCart.Wai.hs b/Demos/ShoppingCart.Wai.hs deleted file mode 100644 --- a/Demos/ShoppingCart.Wai.hs +++ /dev/null @@ -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 - diff --git a/Demos/ShoppingCart.hs b/Demos/ShoppingCart.hs deleted file mode 100644 --- a/Demos/ShoppingCart.hs +++ /dev/null @@ -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 - diff --git a/Demos/demos.blaze.hs b/Demos/demos.blaze.hs --- a/Demos/demos.blaze.hs +++ b/Demos/demos.blaze.hs @@ -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") ) 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 diff --git a/Demos/demos.hs b/Demos/demos.hs deleted file mode 100644 --- a/Demos/demos.hs +++ /dev/null @@ -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") ) 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) 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 () diff --git a/MFlow.cabal b/MFlow.cabal --- a/MFlow.cabal +++ b/MFlow.cabal @@ -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 diff --git a/src/MFlow/Forms/Internals.hs b/src/MFlow/Forms/Internals.hs --- a/src/MFlow/Forms/Internals.hs +++ b/src/MFlow/Forms/Internals.hs @@ -933,7 +933,7 @@ ""++ "xmlhttp.onreadystatechange=function()" ++ " {" ++ - " if (xmlhttp.readyState + xmlhttp.status==204)" ++ + " if (xmlhttp.readyState== 4 && xmlhttp.status==200)" ++ " { " ++ " eval(xmlhttp.responseText);" ++ " }" ++ diff --git a/src/MFlow/Forms/Widgets.hs b/src/MFlow/Forms/Widgets.hs --- a/src/MFlow/Forms/Widgets.hs +++ b/src/MFlow/Forms/Widgets.hs @@ -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('');\ \ }\