MFlow 0.4.5.9 → 0.4.5.10
raw patch · 17 files changed
+504/−469 lines, 17 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- MFlow.Forms: instance [incoherent] Typeable1 MFOption
- MFlow.Forms.Internals: instance [overlap ok] Typeable1 FailBack
- MFlow.Forms.Internals: instance [overlap ok] Typeable1 MFlowState
- MFlow.Forms.Internals: instance [overlap ok] Typeable2 FormElm
- MFlow.Forms.Widgets: instance [overlap ok] (Typeable view, Typeable a) => Typeable (Medit view m a)
+ MFlow.Forms: instance [incoherent] Typeable MFOption
+ MFlow.Forms.Internals: instance [overlap ok] Typeable FailBack
+ MFlow.Forms.Internals: instance [overlap ok] Typeable FormElm
+ MFlow.Forms.Internals: instance [overlap ok] Typeable MFlowState
+ MFlow.Forms.Widgets: instance [overlap ok] Typeable Identity
+ MFlow.Forms.Widgets: instance [overlap ok] Typeable Medit
- MFlow: addMessageFlows :: [([Char], Token -> Workflow IO ())] -> IO ()
+ MFlow: addMessageFlows :: [(String, Token -> Workflow IO ())] -> IO ()
- MFlow: noScript :: [Char]
+ MFlow: noScript :: String
- MFlow: sendToMF :: (Typeable a, Processable a) => Token -> a -> IO ()
+ MFlow: sendToMF :: (Processable a, Typeable * a) => Token -> a -> IO ()
- MFlow: setNoScript :: [Char] -> IO ()
+ MFlow: setNoScript :: String -> IO ()
- MFlow.Cookies: getCookies :: (Eq a, IsString a) => [(a, ByteString)] -> [(ByteString, ByteString)]
+ MFlow.Cookies: getCookies :: (IsString a, Eq a) => [(a, ByteString)] -> [(ByteString, ByteString)]
- MFlow.Forms: (<!) :: (Monad m, FormInput view) => View view m a -> Attribs -> View view m a
+ MFlow.Forms: (<!) :: (FormInput view, Monad m) => View view m a -> Attribs -> View view m a
- MFlow.Forms: absLink :: (Show a, Typeable a, MonadIO m, FormInput v) => a -> v -> View v m a
+ MFlow.Forms: absLink :: (FormInput v, MonadIO m, Typeable * a, Show a) => a -> v -> View v m a
- MFlow.Forms: allOf :: (Functor m, IsString view, MonadIO m, FormInput view) => [View view m a] -> View view m [a]
+ MFlow.Forms: allOf :: (FormInput view, MonadIO m, IsString view, Functor m) => [View view m a] -> View view m [a]
- MFlow.Forms: delSessionData :: (Typeable a, MonadState (MFlowState view) m) => a -> m ()
+ MFlow.Forms: delSessionData :: (MonadState (MFlowState view) m, Typeable * a) => a -> m ()
- MFlow.Forms: encryptedLogin :: (MonadIO m, MonadState (MFlowState view) m) => String -> m ()
+ MFlow.Forms: encryptedLogin :: (MonadState (MFlowState view) m, MonadIO m) => String -> m ()
- MFlow.Forms: encryptedLogout :: (MonadIO m, MonadState (MFlowState view) m) => m ()
+ MFlow.Forms: encryptedLogout :: (MonadState (MFlowState view) m, MonadIO m) => m ()
- MFlow.Forms: encryptedUserWidget :: (Functor m, MonadIO m, FormInput view) => Maybe String -> View view m (Maybe (UserStr, PasswdStr), Maybe [Char]) -> View view m String
+ MFlow.Forms: encryptedUserWidget :: (FormInput view, MonadIO m, Functor m) => Maybe String -> View view m (Maybe (UserStr, PasswdStr), Maybe [Char]) -> View view m String
- MFlow.Forms: getKeyValueParam :: (Read a, Typeable a, MonadState (MFlowState view) m, FormInput view) => String -> m (Maybe a)
+ MFlow.Forms: getKeyValueParam :: (FormInput view, MonadState (MFlowState view) m, Typeable * a, Read a) => String -> m (Maybe a)
- MFlow.Forms: login :: (MonadIO m, MonadState (MFlowState view) m) => String -> m ()
+ MFlow.Forms: login :: (MonadState (MFlowState view) m, MonadIO m) => String -> m ()
- MFlow.Forms: logout :: (MonadIO m, MonadState (MFlowState view) m) => m ()
+ MFlow.Forms: logout :: (MonadState (MFlowState view) m, MonadIO m) => m ()
- MFlow.Forms: paranoidLogin :: (MonadIO m, MonadState (MFlowState view) m) => String -> m ()
+ MFlow.Forms: paranoidLogin :: (MonadState (MFlowState view) m, MonadIO m) => String -> m ()
- MFlow.Forms: paranoidLogout :: (MonadIO m, MonadState (MFlowState view) m) => m ()
+ MFlow.Forms: paranoidLogout :: (MonadState (MFlowState view) m, MonadIO m) => m ()
- MFlow.Forms: paranoidUserWidget :: (Functor m, MonadIO m, FormInput view) => Maybe String -> View view m (Maybe (UserStr, PasswdStr), Maybe [Char]) -> View view m String
+ MFlow.Forms: paranoidUserWidget :: (FormInput view, MonadIO m, Functor m) => Maybe String -> View view m (Maybe (UserStr, PasswdStr), Maybe [Char]) -> View view m String
- MFlow.Forms: requires :: (Show a, Typeable a, MonadState (MFlowState view) m, Requirements a) => [a] -> m ()
+ MFlow.Forms: requires :: (Requirements a, MonadState (MFlowState view) m, Typeable * a, Show a) => [a] -> m ()
- MFlow.Forms.Internals: delSessionData :: (Typeable a, MonadState (MFlowState view) m) => a -> m ()
+ MFlow.Forms.Internals: delSessionData :: (MonadState (MFlowState view) m, Typeable * a) => a -> m ()
- MFlow.Forms.Internals: formPrefix :: (MonadState (MFlowState view1) m, FormInput b) => MFlowState view -> b -> Bool -> m b
+ MFlow.Forms.Internals: formPrefix :: (FormInput b, MonadState (MFlowState view1) m) => MFlowState view -> b -> Bool -> m b
- MFlow.Forms.Internals: getKeyValueParam :: (Read a, Typeable a, MonadState (MFlowState view) m, FormInput view) => String -> m (Maybe a)
+ MFlow.Forms.Internals: getKeyValueParam :: (FormInput view, MonadState (MFlowState view) m, Typeable * a, Read a) => String -> m (Maybe a)
- MFlow.Forms.Internals: insertForm :: (Monad m, FormInput view) => View view m a -> View view m a
+ MFlow.Forms.Internals: insertForm :: (FormInput view, Monad m) => View view m a -> View view m a
- MFlow.Forms.Internals: requires :: (Show a, Typeable a, MonadState (MFlowState view) m, Requirements a) => [a] -> m ()
+ MFlow.Forms.Internals: requires :: (Requirements a, MonadState (MFlowState view) m, Typeable * a, Show a) => [a] -> m ()
- MFlow.Forms.Internals: runFlowOnce1 :: (Monad m, FormInput v) => FlowM v (WF Stat m) a -> Token -> WF Stat m (FailBack Token, MFlowState v)
+ MFlow.Forms.Internals: runFlowOnce1 :: (FormInput v, Monad m) => FlowM v (WF Stat m) a -> Token -> WF Stat m (FailBack Token, MFlowState v)
- MFlow.Forms.Internals: setEncryptedCookie' :: (Functor f, Show a, MonadState (MFlowState view) m) => String -> String -> String -> f a -> ((ByteString, ByteString, ByteString, f ByteString) -> IO Cookie) -> m ()
+ MFlow.Forms.Internals: setEncryptedCookie' :: (MonadState (MFlowState view) m, Show a, Functor f) => String -> String -> String -> f a -> ((ByteString, ByteString, ByteString, f ByteString) -> IO Cookie) -> m ()
- MFlow.Forms.Internals: strRequirement :: (MonadIO m, MonadState (MFlowState view) m) => WebRequirement -> m [Char]
+ MFlow.Forms.Internals: strRequirement :: (MonadState (MFlowState view) m, MonadIO m) => WebRequirement -> m [Char]
- MFlow.Forms.Internals: strRequirement' :: (MonadIO m, MonadState (MFlowState view) m) => WebRequirement -> m [Char]
+ MFlow.Forms.Internals: strRequirement' :: (MonadState (MFlowState view) m, MonadIO m) => WebRequirement -> m [Char]
- MFlow.Forms.WebApi: (<?>) :: (Monad m, Functor m, FormInput v) => View v m a -> v -> View v m a
+ MFlow.Forms.WebApi: (<?>) :: (FormInput v, Functor m, Monad m) => View v m a -> v -> View v m a
- MFlow.Forms.WebApi: rest :: (Eq b, Monad m, Functor m, Read b, Typeable b, FormInput v) => b -> View v m b
+ MFlow.Forms.WebApi: rest :: (FormInput v, Typeable * b, Read b, Functor m, Monad m, Eq b) => b -> View v m b
- MFlow.Forms.WebApi: wparam :: (Monad m, Read a, Typeable a, FormInput v) => String -> View v m a
+ MFlow.Forms.WebApi: wparam :: (FormInput v, Typeable * a, Read a, Monad m) => String -> View v m a
- MFlow.Forms.Widgets: appendWidget :: (Typeable a, MonadIO m, Executable m, FormInput v) => ByteString -> View v Identity a -> View v m ByteString
+ MFlow.Forms.Widgets: appendWidget :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m) => ByteString -> View v Identity a -> View v m ByteString
- MFlow.Forms.Widgets: delEdited :: (Typeable v, Typeable a, MonadIO m, MonadState (MFlowState view) m) => ByteString -> [View v m1 a] -> m ()
+ MFlow.Forms.Widgets: delEdited :: (Typeable v, Typeable a, MonadIO m, Typeable m1, MonadState (MFlowState view) m) => ByteString -> [View v m1 a] -> m ()
- MFlow.Forms.Widgets: getEdited :: (Typeable v, Typeable a, MonadState (MFlowState view) m) => ByteString -> m [View v m1 a]
+ MFlow.Forms.Widgets: getEdited :: (Typeable v, Typeable a, Typeable m1, MonadState (MFlowState view) m) => ByteString -> m [View v m1 a]
- MFlow.Forms.Widgets: insertForm :: (Monad m, FormInput view) => View view m a -> View view m a
+ MFlow.Forms.Widgets: insertForm :: (FormInput view, Monad m) => View view m a -> View view m a
- MFlow.Forms.Widgets: mField :: (Functor m, Executable m, MonadIO m, FormInput v) => [Char] -> View v m ()
+ MFlow.Forms.Widgets: mField :: (FormInput v, MonadIO m, Executable m, Functor m) => [Char] -> View v m ()
- MFlow.Forms.Widgets: mFieldEd :: (Functor m, Executable m, MonadIO m, FormInput v) => UserStr -> [Char] -> v -> View v m ()
+ MFlow.Forms.Widgets: mFieldEd :: (FormInput v, MonadIO m, Executable m, Functor m) => UserStr -> [Char] -> v -> View v m ()
- MFlow.Forms.Widgets: prependWidget :: (Typeable a, MonadIO m, Executable m, FormInput v) => ByteString -> View v Identity a -> View v m ByteString
+ MFlow.Forms.Widgets: prependWidget :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m) => ByteString -> View v Identity a -> View v m ByteString
- MFlow.Forms.Widgets: readtField :: FormInput a => a -> [Char] -> IO a
+ MFlow.Forms.Widgets: readtField :: FormInput a => a -> String -> IO a
- MFlow.Forms.Widgets: setEdited :: (Typeable view1, Typeable a, MonadState (MFlowState view) m) => ByteString -> [(String, View view1 m1 a)] -> m ()
+ MFlow.Forms.Widgets: setEdited :: (MonadState (MFlowState view) m, Typeable * a, Typeable * view1, Typeable (* -> *) m1) => ByteString -> [(String, View view1 m1 a)] -> m ()
- MFlow.Forms.Widgets: setWidget :: (Typeable a, MonadIO m, Executable m, FormInput v) => ByteString -> View v Identity a -> View v m ByteString
+ MFlow.Forms.Widgets: setWidget :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m) => ByteString -> View v Identity a -> View v m ByteString
- MFlow.Forms.Widgets: userFormOrName :: (Functor m, MonadIO m, FormInput [t], FormInput t) => Maybe String -> View [t] m (Maybe (UserStr, PasswdStr), Maybe String) -> View [t] m String
+ MFlow.Forms.Widgets: userFormOrName :: (FormInput [t], FormInput t, MonadIO m, Functor m) => Maybe String -> View [t] m (Maybe (UserStr, PasswdStr), Maybe String) -> View [t] m String
- MFlow.Forms.Widgets: wEditList :: (Typeable a, Read a, FormInput view, Functor m, MonadIO m, Executable m) => (view -> view) -> (Maybe a -> View view Identity a) -> [a] -> String -> View view m [a]
+ MFlow.Forms.Widgets: wEditList :: (Typeable a, Read a, FormInput view, Functor m, MonadIO m, Executable m, Typeable m, Typeable Identity) => (view -> view) -> (Maybe a -> View view Identity a) -> [a] -> String -> View view m [a]
- MFlow.Forms.Widgets: wautocompleteEdit :: (Typeable a, MonadIO m, Functor m, Executable m, FormInput v) => String -> (String -> IO [String]) -> (Maybe String -> View v Identity a) -> [String] -> View v m [a]
+ MFlow.Forms.Widgets: wautocompleteEdit :: (Typeable a, MonadIO m, Functor m, Executable m, FormInput v, Typeable m, Typeable Identity) => String -> (String -> IO [String]) -> (Maybe String -> View v Identity a) -> [String] -> View v m [a]
- MFlow.Forms.Widgets: wautocompleteList :: (Functor m, MonadIO m, Executable m, FormInput v) => String -> (String -> IO [String]) -> [String] -> View v m [String]
+ MFlow.Forms.Widgets: wautocompleteList :: (Functor m, MonadIO m, Executable m, FormInput v, Typeable m, Typeable Identity) => String -> (String -> IO [String]) -> [String] -> View v m [String]
Files
- MFlow.cabal +97/−30
- src/MFlow.hs +83/−85
- src/MFlow/Cookies.hs +5/−5
- src/MFlow/Forms.hs +87/−87
- src/MFlow/Forms/Admin.hs +1/−6
- src/MFlow/Forms/Blaze/Html.hs +2/−9
- src/MFlow/Forms/Cache.hs +20/−20
- src/MFlow/Forms/Internals.hs +84/−95
- src/MFlow/Forms/Test.hs +20/−19
- src/MFlow/Forms/WebApi.hs +5/−8
- src/MFlow/Forms/Widgets.hs +56/−57
- src/MFlow/Forms/XHtml.hs +0/−2
- src/MFlow/Hack.hs +14/−14
- src/MFlow/Hack/Response.hs +2/−2
- src/MFlow/Wai.hs +8/−7
- src/MFlow/Wai/Blaze/Html/All.hs +18/−18
- src/MFlow/Wai/Response.hs +2/−5
MFlow.cabal view
@@ -1,5 +1,5 @@ name: MFlow -version: 0.4.5.9 +version: 0.4.5.10 cabal-version: >=1.8 build-type: Simple license: BSD3 @@ -8,46 +8,113 @@ stability: experimental bug-reports: https://github.com/agocorona/MFlow/issues synopsis: stateful, RESTful web framework -description: MFlow is a Web Framework that turns Web programing back into just ordinary programming by automating all the extra - complexities. +description: MFlow is a web framework that turns the mess of web programming from handlers and configuration files back into sane and normal programming. Your code is the website. . - 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. + The goals of MFlow are. + ~~~ + -Inverting back the inversion of control of web applications and turn web programming into ordinary, intuitive, imperative-like programming. . - -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. + -At the same time, maintaining for the programmer all the freedom that they have in web applications. MFlow keeps out of your way. . - -For REST advocates, to maintain the elegant notation of REST urls and the statelessness of GET requests. + -For scalability-sensitive applications, no fat state snapshots that other continuation-based frameworks need to cope with these two previous requirements. State replication and horizontal scalability are central to MFlow's philosophy. . - -For expert haskell programmers, to reuse the already existent web libraries and techniques. + -For REST advocates, MFlow maintains the elegant notation of REST URLs and the statelessness of GET requests. . - -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 expert Haskell programmers, reuse of already existing web libraries and techniques is trivial. . - -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. + -For beginner programmers and for software engineers, MFlow provides a high level DSL of reusable and self contained widgets for the user interface, and multipage procedures that work together provided that they statically typecheck with zero configuration. . - -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> + -For highly interactive applications, MFlow gives dynamic widgets that have their own behaviors in the page and they communicate without the need of explicit JavaScript programming. . - 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. + -No deployment, speed up the development process. see <http://haskell-web.blogspot.com.es/2013/05/a-web-application-in-tweet.html> . - 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. + How navigation works + ~~~ + MFlow solves the problem of re-inversion of control by using a different approach, routes are expressed as normal monadic Haskell code in the FlowM monad, local links point to alternative routes within this monadic computation, this means any GET page is directly reachable by means of a RESTful URL. . - 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. + 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 paths partially match. From this position on the execution goes forward until the rest of the paths match. Thus, no matter the previous state of the server process it will recover the state of execution appropriate for the request. This way the server process is virtually stateless for any GET request. It is also possible to store a session state, which may backtrack or not, when the navigation goes back and forth. MFlow keeps it all in sync, synchronization between server state and web browser state is supported out-of-the-box. . - 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. + When the state matters, and user interactions can last for long period of time, such are shopping carts etc., MFlow uses a log for thread state persistence. The server process shuts itself down after a programmer defined timeout, once a new request of the same user arrives, 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. This solves the problem of fat state snapshots and give a very lightweight way to handle state. . - 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. + Data tier + ~~~ + State consistency and transactions are handled by the TCache package. . - 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 - .- 0.4.5.8 added rawSend+ www.hackage.haskell.org/package/TCache . - The version 0.4.5.4 add compatibility with ghc 7.8 + It is data cache within the STM monad (Software Transactional Memory), serialization and deserialization of data is programmer defined. TCache can adapt to any database, default persistence in files comes out of the box for rapid development purposes, but you can switch to a variety of backends when needed, see the database examples for more details. . + . + Widgets + ~~~ + The processes interact through widgets, which are an extension of formlets with additional applicative combinators, formatting, link management, callbacks, modifiers, caching, and AJAX. All of it is coded in pure Haskell and you use pure Haskell to make your own widgets. Each widget return statically typed data, they can dynamically modify themselves using AJAX internally (just prefix it with auto refresh), 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 behaviors that use the monadic syntax and callbacks. When you combine widgets, everything is type checked and making large websites by gluing together small reusable building blocks is the entire aim of the MFlow project. + . + . + Modularity + ~~~ + The interfaces and communications are abstract and there are bindings for blaze-HTML, HSP, Text.XHtml, ByteString, Hack, and WAI. So it can be extended to non web based architectures. + . + Bindings for hack, and HSP >= 0.8, are not installed by default, but are included in the package files. To use them, add them 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> + . + . + Features + ~~~ + . + -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 + . + -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) + . + -Besides applicative syntax (declarative-like) each widget can use the monadic syntax (imperative-like) so widgets can express their own behavior 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 dialogues (using jQuery dialog) + . + -Other jQuery widgets as MFlow widgets + . + -WAI integration + . + -Content management and multilanguage + . + -blaze-html support + . + -Ajax + . + -User-defined data in sessions + . + -Widget requirements for automatic installation of scripts, CSS and server flows. + . + -Transparent back button management + . + -Cached widgets + . + -Callbacks + . + -Lazy load of widgets + . + -Web Services + . + . + Changelog + ~~~ + . + 0.4.5.10 compatibility with ghc 7.10 + . + 0.4.5.8 added rawSend + . + The version 0.4.5.4 add compatibility with GHC 7.8 + . The version 0.4.5 composable HTTP caching, lazy load, caching datasets in the browser HTTP cache . The version 0.4.0 add encrypted cookies, secure sessions, add REST web services, fixes UTF8 errors, pageFlow fixes, add onBacktrack, compensate @@ -56,7 +123,7 @@ . The version 0.3.2 add runtime templates. It also add witerate and dField, two modifiers for single page development. dField creates a placeholder for a widget that is updated via implicit AJAX by witerate. - http://haskell-web.blogspot.com.es/2013/11/more-composable-elements-for-single.html + www.haskell-web.blogspot.com.es/2013/11/more-composable-elements-for-single.html . The version 0.3.1 included: . @@ -69,15 +136,15 @@ . - 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) + - Page flows: Monadic widgets that can express his own behavior 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) + - Widgets in modal and non modal dialogues (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.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. . @@ -110,8 +177,8 @@ utf8-string , wai , wai-extra, resourcet, case-insensitive , http-types , conduit ,conduit-extra, text , parsec , warp , warp-tls , random , blaze-html , blaze-markup , - monadloc, clientsession, pwstore-fast- + monadloc, clientsession, pwstore-fast + exposed-modules: MFlow MFlow.Wai.Blaze.Html.All MFlow.Forms MFlow.Forms.Admin MFlow.Cookies MFlow.Wai MFlow.Forms.Blaze.Html MFlow.Forms.Test @@ -122,7 +189,7 @@ hs-source-dirs: src . other-modules: MFlow.Wai.Response - + --executable demos-blaze -- build-depends: MFlow , RefSerialize , TCache , -- tcache-AWS , directory , Workflow , base ,
src/MFlow.hs view
@@ -1,45 +1,46 @@ {- | Non monadic low level primitives that implement the MFlow application server. See "MFlow.Form" for the higher level interface that you may use. -it implements an scheduler of 'Processable' messages that are served according with +It implements a scheduler of 'Processable' messages that are served according to the source identification and the verb invoked. -The scheduler executed the appropriate workflow (using the workflow package). +The scheduler executes the appropriate workflow (using the workflow package). The workflow will send additional messages to the source and wait for the responses. -The diaglog is identified by a 'Token', which is associated to the flow. -. The computation state is optionally logged. On timeout, the process is killed. When invoked again, +The dialog is identified by a 'Token', which is associated to the 'Flow'. +The computation state is optionally logged, on timeout the process is killed, when invoked again, the execution state is recovered as if no interruption took place. -There is no asumption about message codification, so instantiations +There is no assumption about message codification, so instantiations of this scheduler for different infrastructures is possible, -including non-Web based ones as long as they support or emulate cookies. +including non-web based ones as long as they support or emulate cookies. "MFlow.Hack" is an instantiation for the Hack interface in a Web context. "MFlow.Wai" is a instantiation for the WAI interface. -"MFlow.Forms" implements a monadic type safe interface with composabe widgets and and applicative -combinator as well as an higher comunication interface. +"MFlow.Forms" implements a monadic type safe interface with composable widgets and an applicative +combinator with a higher-level communication interface. "MFlow.Forms.XHtml" is an instantiation for the Text.XHtml format -"MFlow.Forms.Blaze.Html" is an instantaiation for blaze-html - "MFlow.Forms.HSP" is an instantiation for the Haskell Server Pages format +"MFlow.Forms.Blaze.Html" is an instantiation for blaze-html. Use this instead of XHtml and HSP, +which are for backwards compat reasons. + There are some @*.All@ packages that contain a mix of these instantiations. -For exmaple, "MFlow.Wai.Blaze.Html.All" includes most of all necessary for using MFlow with +For example, "MFlow.Wai.Blaze.Html.All" includes most of all necessary for using MFlow with Wai <http://hackage.haskell.org/package/wai> and Blaze-html <http://hackage.haskell.org/package/blaze-html> In order to manage resources, there are primitives that kill the process and its state after a timeout. -All these details are hidden in the monad of "MFlow.Forms" that provides an higher level interface. +All these details are hidden in the monad of "MFlow.Forms" which provides an higher level interface. -Fragment based streaming: 'sendFragment' are provided only at this level. +Fragment based streaming: 'sendFragment' are provided only at this level. -'stateless' and 'transient' server processeses are also possible. the first are request-response - . `transient` processes do not persist after timeout, so they restart anew after a timeout or a crash. +'stateless' and 'transient' server processes are also possible. 'stateless' are request-response processes. +While 'transient' processes do not persist after timeout, they restart anew after a timeout or a crash. -} @@ -55,11 +56,11 @@ ,OverloadedStrings ,ScopedTypeVariables ,BangPatterns - #-} + #-} module MFlow ( Flow, Params, HttpData(..),Processable(..) , Token(..), ProcList --- * low level comunication primitives. Use `ask` instead +-- * low level comunication primitives. Use 'ask' instead ,flushRec, flushResponse, receive, receiveReq, receiveReqTimeout, send, sendFlush, sendFragment , sendEndFragment, sendToMF -- * Flow configuration @@ -80,14 +81,14 @@ ) where -import Control.Concurrent.MVar +import Control.Concurrent.MVar import Data.IORef import GHC.Conc(unsafeIOToSTM) import Data.Typeable import Data.Maybe(isJust, isNothing, fromMaybe, fromJust) -import Data.Char(isSeparator) +import Data.Char(isSeparator) import Data.List(isPrefixOf,isSuffixOf,isInfixOf, elem , span, (\\),intersperse) -import Control.Monad(when) +import Control.Monad(when) import Data.Monoid import Control.Concurrent(forkIO,threadDelay,killThread, myThreadId, ThreadId) @@ -119,8 +120,8 @@ --(!>) = flip trace --- | a Token identifies a flow that handle messages. The scheduler compose a Token with every `Processable` --- message that arrives and send the mesage to the appropriate flow. +-- | A 'Token' identifies a 'Flow' that handle messages. The scheduler composes a 'Token' with every 'Processable' +-- message that arrives and sends the message to the appropriate 'Flow'. data Token = Token{twfname,tuser, tind :: String , tpath :: [String], tenv:: Params, tblock:: MVar Bool, tsendq :: MVar Req, trecq :: MVar Resp} deriving Typeable instance Indexable Token where @@ -196,7 +197,7 @@ class Processable a where pwfname :: a -> String - pwfname s= Prelude.head $ pwfPath s + pwfname s= Prelude.head $ pwfPath s pwfPath :: a -> [String] puser :: a -> String pind :: a -> String @@ -209,14 +210,14 @@ pind = tind getParams = tenv -instance Processable Req where +instance Processable Req where pwfname (Req x)= pwfname x pwfPath (Req x)= pwfPath x puser (Req x)= puser x - pind (Req x)= pind x + pind (Req x)= pind x getParams (Req x)= getParams x -- getServer (Req x)= getServer x --- getPort (Req x)= getPort x +-- getPort (Req x)= getPort x data Resp = Fragm HttpData | EndFragm HttpData @@ -225,18 +226,18 @@ --- | The anonymous user +-- | The anonymous user. anonymous= "anon#" --- | It is the path of the root flow +-- | The path of the root flow. noScriptRef= unsafePerformIO $ newIORef "noscript" noScript= unsafePerformIO $ readIORef noScriptRef --- | set the flow to be executed when the URL has no path. The home page. +-- | Set the flow to be executed when the URL has no path. The home page. -- -- By default it is "noscript". --- Although it is changed by `runNavigation` to his own flow name. +-- Although it is changed by `runNavigation` to it's own flow name. setNoScript scr= writeIORef noScriptRef scr {- @@ -245,14 +246,14 @@ x <- iox return $ debug x (str++" => Workflow "++ show x) -} --- | send a complete response +-- | Send a complete response. --send :: Token -> HttpData -> IO() send t@(Token _ _ _ _ _ _ _ qresp) msg= do - ( putMVar qresp . Resp $ msg ) -- !> ("<<<<< send "++ show t) + ( putMVar qresp . Resp $ msg ) -- !> ("<<<<< send "++ show t) sendFlush t msg= flushRec t >> send t msg -- !> "sendFlush " --- | send a response fragment. Useful for streaming. the last packet must be sent trough 'send' +-- | Send a response fragment, useful for streaming. The last packet must be sent trough 'send'. sendFragment :: Token -> HttpData -> IO() sendFragment (Token _ _ _ _ _ _ _ qresp) msg= putMVar qresp . Fragm $ msg @@ -293,14 +294,14 @@ delMsgHistory t = do let statKey= keyWF (twfname t) t -- !> "wf" --let qnme= keyWF wfname t delWFHistory1 statKey -- `debug` "delWFHistory" - --- | executes a simple request-response computation that receive the params and return a response + +-- | Executes a simple request-response computation that receive the params and return a response. -- --- It is used with `addMessageFlows` +-- It is used with 'addMessageFlows' -- --- There is a higuer level version @wstateless@ in "MFLow.Forms" +-- There is a higher level version @wstateless@ in "MFLow.Forms" stateless :: (Params -> IO HttpData) -> Flow stateless f = transient proc where @@ -313,11 +314,11 @@ --- | Executes a monadic computation that send and receive messages, but does --- not store its state in permanent storage. The process once stopped, will restart anew +-- | Executes a monadic computation that are send and receive messages, but does +-- not store it's state in permanent storage. The process once stopped, will restart anew -- ---- It is used with `addMessageFlows` `hackMessageFlow` or `waiMessageFlow` -transient :: (Token -> IO ()) -> Flow +transient :: (Token -> IO ()) -> Flow transient f= unsafeIOtoWF . f -- WF(\s -> f t>>= \x-> return (s, x) ) @@ -326,12 +327,12 @@ where emptyFList= M.empty :: WorkflowList IO Token () --- | add a list of flows to be scheduled. Each entry in the list is a pair @(path, flow)@ +-- | 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 (M.fromList $ map flt wfs)ms) where flt ("",f)= (noScript,f) flt e= e --- | return the list of the scheduler +-- | Return the list of the scheduler. getMessageFlows = readMVar _messageFlows delMessageFlow wfname= modifyMVar_ _messageFlows (\ms -> return $ M.delete wfname ms) @@ -340,7 +341,7 @@ sendToMF Token{..} msg= putMVar tsendq (Req msg) -- !> "sendToMF" --recFromMF :: (Typeable a, Typeable c, Processable a) => Token -> a -> IO c -recFromMF t@Token{..} = do +recFromMF t@Token{..} = do m <- takeMVar trecq -- !> "recFromMF <<<<<< " case m of Resp r -> return r -- !> "<<<<<< recFromMF" @@ -350,12 +351,12 @@ where getStream r = do - mr <- takeMVar trecq + mr <- takeMVar trecq case mr of Fragm h -> do rest <- unsafeInterleaveIO $ getStream h let result= mappend r rest - return result + return result EndFragm h -> do let result= mappend r h return result @@ -367,11 +368,11 @@ --- | The scheduler creates a Token with every `Processable` --- message that arrives and send the mesage to the appropriate flow, then wait for the response --- and return it. +-- | The scheduler creates a 'Token' with every 'Processable' +-- message that arrives and sends the message to the appropriate flow, then waits for the response +-- and returns it. -- --- It is the core of the application server. "MFLow.Wai" and "MFlow.Hack" use it +-- This is the core of the application server. "MFLow.Wai" and "MFlow.Hack" use it msgScheduler :: (Typeable a,Processable a) => a -> IO (HttpData, ThreadId) @@ -380,16 +381,16 @@ th <- myThreadId let wfname = takeWhile (/='/') $ pwfname x criticalSection (tblock token) $ do - sendToMF token x -- !> show th - th <- startMessageFlow wfname token - r <- recFromMF token - return (r,th) -- !> let HttpData _ _ r1=r in B.unpack r1 + sendToMF token x -- !> show th + th <- startMessageFlow wfname token + r <- recFromMF token + return (r,th) -- !> let HttpData _ _ r1=r in B.unpack r1 where criticalSection mv f= bracket (takeMVar mv) (putMVar mv) $ const $ f - + --start the flow if not started yet startMessageFlow wfname token = forkIO $ do @@ -408,13 +409,12 @@ Left Timeout -> do hFlush stdout -- !> ("TIMEOUT in msgScheduler" ++ (show $ unsafePerformIO myThreadId)) deleteTokenInList token - + Left (WFException e)-> do showError wfname token e moveState wfname token token{tind= "error/"++tuser token} deleteTokenInList token -- !> "DELETETOKEN" - - + Right _ -> delMsgHistory token >> return () -- !> ("finished " ++ wfname) @@ -451,7 +451,7 @@ --- | The handler of the error log +-- | The handler of the error log. hlog= unsafePerformIO $ openFile logFileName ReadWriteMode ------ USER MANAGEMENT ------- @@ -462,8 +462,8 @@ _authMethod= unsafePerformIO $ newIORef $ Auth tCacheRegister tCacheValidate --- | set an authentication method. That includes the registration and validation calls. --- both return Nothing if sucessful. Otherwise they return a text mesage explaining the failure +-- | Sets an authentication method, that includes the registration and validation calls. +-- Both return Nothing if successful. Otherwise they return a text message explaining the failure. setAuthMethod auth= writeIORef _authMethod auth getAuthMethod = readIORef _authMethod @@ -490,8 +490,8 @@ serialize= B.pack . show deserialize= read . B.unpack setPersist = \_ -> Just filePersist - --- | Register an user/password + +-- | Register an user/password. tCacheRegister :: String -> String -> IO (Maybe String) tCacheRegister user password= tCacheRegister' 14 user password @@ -527,7 +527,7 @@ where err= Just "Username or password invalid" --- | register an user with the auth Method +-- | Register a user with the auth method. userRegister :: MonadIO m => UserStr -> PasswdStr -> m (Maybe String) userRegister !u !p= liftIO $ do Auth reg _ <- getAuthMethod :: IO Auth @@ -576,13 +576,13 @@ `CE.catch` \(e :: SomeException) -> return (readOld s) setPersist = \_ -> Just filePersist --- | read a config variable from the config file \"mflow.config\". if it is not set, uses the second parameter and --- add it to the configuration list, so next time the administrator can change it in the configuration file +-- | Read a config variable from the config file \"mflow.config\". If it is not set, use the second parameter and +-- add it to the configuration list so next time the administrator can change it in the configuration file. getConfig k v= case M.lookup k config of Nothing -> unsafePerformIO $ setConfig k v >> return v Just s -> s --- | set an user-defined config variable +-- | Set an user-defined config variable. setConfig k v= atomically $ do Config1 conf <- readConfig writeDBRef rconf $ Config1 $ M.insert k v conf @@ -594,9 +594,9 @@ type PasswdStr= String --- | set the Administrator user and password. --- It must be defined in Main , before any configuration parameter is read, before the execution --- of any flow +-- | Set the Administrator user and password. +-- It must be defined in Main, before any configuration parameter is read and before the execution +-- of any flow. setAdminUser :: MonadIO m => UserStr -> PasswdStr -> m () setAdminUser user password= liftIO $ do userRegister user password @@ -614,27 +614,27 @@ _ -> "The administrator has been notified" where fresp msg= - "<html><h4>Error 404: Page not found or error ocurred</h4> <p style=\"font-family:courier\">" <> msg <>"</p>" <> + "<html><h4>Error 404: Page not found or error occurred</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>, ") $ filter (\s -> B.head s /= '_') paths) notFoundResponse= unsafePerformIO $ newIORef defNotFoundResponse --- | set the 404 "not found" response. +-- | 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 :: - (Bool - -> String - -> ByteString) +setNotFoundResponse :: + (Bool + -> String + -> ByteString) -> IO () setNotFoundResponse f= liftIO $ writeIORef notFoundResponse f @@ -668,17 +668,16 @@ addAttrs (Chunk "<" (Chunk tag rest)) rs= Chunk "<"(Chunk tag (B.pack $ concatMap(\(n,v) -> (' ' : n) ++ "=" ++ v ) rs)) <> rest -addAttrs other _ = error $ "addAttrs: byteString is not a tag: " ++ show other +addAttrs other _ = error $ "addAttrs: ByteString is not a tag: " ++ show other ------------------- 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 --- the efficient GHC threads by frequent IO calls.So it enhances the performance --- in the context of heavy concurrence. --- It uses 'Data.TCache.Memoization'. --- The caching-uncaching follows the `setPersist` criteria +-- the efficient GHC threads by frequent IO calls. This enhances the performance in the context of heavy concurrency. +-- It uses 'Data.TCache.Memoization'. +-- The caching and uncaching follows the `setPersist` criteria setFilesPath :: MonadIO m => String -> m () setFilesPath !path= liftIO $ writeIORef rfilesPath path @@ -702,8 +701,8 @@ noperm= "no permissions" ioerr x= \(e :: CE.IOException) -> x setMime x= ("Content-Type",x) - + --------------------- FLOW ID GENERATOR ------------ data NFlow= NFlow !Integer deriving (Read, Show, Typeable) @@ -722,7 +721,7 @@ newFlow= do TOD t _ <- getClockTime - atomically $ do + atomically $ do NFlow n <- readDBRef rflow `onNothing` return (NFlow 0) writeDBRef rflow . NFlow $ n+1 return . SB.pack . show $ t + n @@ -733,7 +732,7 @@ ("htm", "text/html"), ("txt", "text/plain"), ("hs", "text/plain"), - ("lhs", "text/plain"), + ("lhs", "text/plain"), ("jpeg", "image/jpeg"), ("pdf", "application/pdf"), ("js", "application/x-javascript"), @@ -926,4 +925,3 @@ ("z", "application/x-compress") ] -
src/MFlow/Cookies.hs view
@@ -63,7 +63,7 @@ showMaxAge Nothing = "" showMaxAge (Just e) = ";Max-age=" <> e -splitCookies cookies = f cookies [] +splitCookies cookies = f cookies [] where f s r | B.null s = r f xs0 r = @@ -80,7 +80,7 @@ ---------------------------- ---readEnv :: Parser [(String,String)] +--readEnv :: Parser [(String,String)] readEnv = (do n <- urlEncoded string "=" @@ -91,15 +91,15 @@ urlEncoded = many ( alphaNum `mplus` extra `mplus` safe `mplus` do{ char '+' ; return ' '} - `mplus` do{ char '%' ; hexadecimal } + `mplus` do{ char '%' ; hexadecimal } ) --extra :: Parser Char -extra = satisfy (`Prelude.elem` "!*'(),/\"") +extra = satisfy (`Prelude.elem` ("!*'(),/\"" ::String)) -- --safe :: Parser Char -safe = satisfy (`Prelude.elem` "$-_.") +safe = satisfy (`Prelude.elem` ("$-_." :: String)) ---- --hexadecimal :: Parser HexString hexadecimal = do d1 <- hexDigit
src/MFlow/Forms.hs view
@@ -21,7 +21,7 @@ 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 +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. @@ -29,28 +29,28 @@ If the procedure is waiting for another different page, the FlowM monad backtrack until the path partially match . From this position the execution goes forward until the rest of the path match. This way the statelessness is optional. However, it is possible to store a session state, which may backtrack or -not when the navigation goes back and forth. It is upto the programmer. +not when the navigation goes back and forth. It is up to the programmer. 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 +Although 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 +handling the back button. Back button state synchronization 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). +application server on demand, including the execution state (if the Workflow 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. +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 +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. +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 @@ -60,35 +60,35 @@ This means that they automatically store and recover his execution state. They are executed by the MFlow app server. defined in the "MFlow" module. -These processses interact with the user trough user interfaces made of widgets (see below) that return back statically typed responses to +These processes interact with the user trough user interfaces made of widgets (see below) that return back statically typed responses to the calling process. Because flows are stateful, not request-response, the code is more understandable, because -all the flow of request and responses is coded by the programmer in a single procedure in the FlowM monad. Allthoug +all the flow of request and responses is coded by the programmer in a single procedure in the FlowM monad. Although single request-response flows and callbacks are possible. This module is abstract with respect to the formatting (here referred with the type variable @view@) . For an instantiation for "Text.XHtml" import "MFlow.Forms.XHtml", "MFlow.Hack.XHtml.All" or "MFlow.Wai.XHtml.All" . -To use Haskell Server Pages import "MFlow.Forms.HSP". However the functionalities are documented here. +To use Haskell Server Pages import "MFlow.Forms.HSP". However the functions are documented here. `ask` is the only method for user interaction. It run in the @MFlow view m@ monad, with @m@ the monad chosen by the user, usually IO. It send user interfaces (in the @View view m@ monad) and return statically typed responses. The user interface definitions are based on a extension of -formLets (<http://www.haskell.org/haskellwiki/Formlets>) with the addition of caching, links, formatting, attributes, - extra combinators, callbaks and modifiers. +formlets (<http://www.haskell.org/haskellwiki/Formlets>) with the addition of caching, links, formatting, attributes, + extra combinators, callbacks and modifiers. The interaction with the user is stateful. In the same computation there may be many request-response interactions, in the same way than in the case of a console applications. * APPLICATION SERVER -Therefore, session and state management is simple and transparent: it is in the haskell +Therefore, session and state management is simple and transparent: it is in the Haskell structures in the scope of the computation. `transient` (normal) procedures have no persistent session state and `stateless` procedures accept a single request and return a single response. `MFlow.Forms.step` is a lifting monad transformer that permit persistent server procedures that remember the execution state even after system shutdowns by using the package workflow (<http://hackage.haskell.org/package/Workflow>) internally. -This state management is transparent. There is no programer interface for session management. +This state management is transparent. There is no programmer interface for session management. The programmer set the process timeout and the session timeout with `setTimeouts`. -If the procedure has been stopped due to the process timeout or due to a system shutdowm, +If the procedure has been stopped due to the process timeout or due to a system shutdown, the procedure restart in the last state when a request for this procedure arrives (if the procedure uses the `step` monad transformer) @@ -107,7 +107,7 @@ Links defined with `wlink` are treated the same way than forms. They are type safe and return values to the same flow of execution. -It is posssible to combine links and forms in the same widget by using applicative combinators but also +It is possible to combine links and forms in the same widget by using applicative combinators but also additional applicative combinators like \<+> !*> , |*|. Widgets are also monoids, so they can be combined as such. @@ -115,7 +115,7 @@ [@Runtime templates@] 'template', 'edTemplate', 'witerate' and 'dField' permit the edition of the widget content at runtime, and the management of placeholders with input fields and data fields -within the template with no navigation in the client, little bandwidth usage and little server load. Enven less +within the template with no navigation in the client, little bandwidth usage and little server load. Even less than using 'autoRefresh'. * IN PREVIOUS RELEASES @@ -127,12 +127,12 @@ [@Error traces@] using the monadloc package, now each runtime error (in a monadic statement) has a complete execution trace. -[@RESTful URLs@] Now each page is directly reachable by means of a intuitive, RESTful url, whose path is composed by the sucession +[@RESTful URLs@] Now each page is directly reachable by means of a intuitive, RESTful URL, whose path is composed by the succession 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 +[@Page flows@] each widget-formlet can have its own independent behavior 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. +subpage flow by adding a well know identifier prefix for links and form parameters. [@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 @@ -144,21 +144,21 @@ [@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 -[@AJAX@] Now an ajax procedures (defined with 'ajax' can perform many interactions with the browser widgets, instead +[@AJAX@] Now an Ajax procedures (defined with 'ajax' can perform many interactions with the browser widgets, instead of a single request-response (see 'ajaxSend'). [@Active widgets@] "MFlow.Forms.Widgets" contains active widgets that interact with the server via Ajax and dynamically control other widgets: 'wEditList', 'autocomplete' 'autocompleteEdit' and others. -[@Requirements@] a widget can specify javaScript files, JavasScript online scipts, CSS files, online CSS and server processes - and any other instance of the 'Requrement' class. See 'requires' and 'WebRequirements' +[@Requirements@] a widget can specify JavaScript files, JavaScript online scripts, CSS files, online CSS and server processes + and any other instance of the 'Requirement' class. See 'requires' and 'WebRequirements' [@content-management@] for templating and online edition of the content template. See 'tFieldEd' 'tFieldGen' and 'tField' [@multilanguage@] see 'mField' and 'mFieldEd' [@URLs to internal states@] if the web navigation is trough GET forms or links, - an URL can express a direct path to the n-th step of a flow, So this URL can be shared with other users. + an URL can express a direct path to the nth step of a flow, So this URL can be shared with other users. Just like in the case of an ordinary stateless application. @@ -173,9 +173,9 @@ [@Callbacks@] `waction` add a callback to a widget. It is executed when its input is validated. -The callback may initate a flow of interactions with the user or simply executes an internal computation. +The callback may initiate a flow of interactions with the user or simply executes an internal computation. Callbacks are necessary for the creation of abstract container -widgets that may not know the behaviour of its content. with callbacks, the widget manages its content as black boxes. +widgets that may not know the behavior of its content. with callbacks, the widget manages its content as black boxes. [@Modifiers@] `wmodify` change the visualization and result returned by the widget. For example it may hide a @@ -186,15 +186,15 @@ @ ask $ wform userloginform \``validate`\` valdateProc \``waction`\` loginProc \``wmodify`\` hideIfLogged@ -[@attributes for formLet elements@] to add atributes to widgets. See the '<!' opèrator +[@attributes for formLet elements@] to add attributes to widgets. See the '<!' operator -[@ByteString normalization and hetereogeneous formatting@] For caching the rendering of widgets at the - ByteString level, and to permit many formatring styles +[@ByteString normalization and heterogeneous formatting@] For caching the rendering of widgets at the + ByteString level, and to permit many formatting styles in the same page, there are operators that combine different formats which are converted to ByteStrings. For example the header and footer may be coded in XML, while the formlets may be formatted using Text.XHtml. -[@File Server@] With file caching. See "MFlow.FileServer" +[@File Server@] With file caching. See "MFlow.File Server" -} @@ -211,13 +211,13 @@ ,encryptedLogout, userWidget, paranoidUserWidget, encryptedUserWidget, login, paranoidLogin, encryptedLogin, userName, -- * User interaction -ask, page, askt, clearEnv, wstateless, pageFlow, +ask, page, askt, clearEnv, wstateless, pageFlow, -- * formLets -- | They usually produce the HTML form elements (depending on the FormInput instance used) -- It is possible to modify their attributes with the `<!` operator. --- They are combined with applicative ombinators and some additional ones +-- They are combined with applicative combinators and some additional ones -- formatting can be added with the formatting combinators. --- modifiers change their presentation and behaviour +-- modifiers change their presentation and behavior getString,getInt,getInteger, getTextBox ,getMultilineText,getBool,getSelect, setOption,setSelectedOption, getPassword, getRadio, setRadio, setRadioActive, wlabel, getCheckBoxes, genCheckBoxes, setCheckBox, @@ -233,9 +233,9 @@ (<+>),(|*>),(|+|), (**>),(<**),(<|>),(<*),(<$>),(<*>),(>:>) ---- * Normalized (convert to ByteString) widget combinators ----- | These dot operators are indentical to the non dot operators, with the addition of the conversion of the arguments to lazy byteStrings +---- | These dot operators are identical to the non dot operators, with the addition of the conversion of the arguments to lazy ByteStrings ---- ----- The purpose is to combine heterogeneous formats into byteString-formatted widgets that +---- The purpose is to combine heterogeneous formats into ByteString-formatted widgets that ---- can be cached with `cachedWidget` --,(.<+>.), (.|*>.), (.|+|.), (.**>.),(.<**.), (.<|>.), @@ -243,15 +243,15 @@ ,(<<<),(++>),(<++),(<!) ---- * Normalized (convert to ByteString) formatting combinators ----- | Some combinators that convert the formatting of their arguments to lazy byteString +---- | Some combinators that convert the formatting of their arguments to lazy ByteString ----(.<<.),(.<++.),(.++>.) -- * ByteString tags ,btag,bhtml,bbody ---- * send raw bytestring data-,rawSend +-- * send raw bytestring data +,rawSend + -- * Normalization ,flatten, normalize @@ -354,7 +354,7 @@ -- calling page. -- It is useful when the widget is inside widget containers that may treat it as a black box. -- --- It returns a result that can be significative or, else, be ignored with '<**' and '**>'. +-- It returns a result that can be significant or, else, be ignored with '<**' and '**>'. -- An action may or may not initiate his own dialog with the user via `ask` waction :: (FormInput view, Monad m) @@ -383,7 +383,7 @@ modify $ \s ->s{notSyncInAction= True} return (FormElm mempty Nothing) --- | change the rendering and the return value of a page. This is superseeded by page flows. +-- | change the rendering and the return value of a page. This is superseded by page flows. wmodify :: (Monad m, FormInput v) => View v m a -> (v -> Maybe a -> WState v m (v, Maybe b)) @@ -491,7 +491,7 @@ ( checked || (isJust mn && v== fromJust mn)) Nothing) ret --- | Read the checkboxes dinamically created by JavaScript within the view parameter +-- | Read the checkboxes dynamically created by JavaScript within the view parameter -- see for example `selectAutocomplete` in "MFlow.Forms.Widgets" genCheckBoxes :: (Monad m, FormInput view) => view -> View view m CheckBoxes genCheckBoxes v= View $ do @@ -693,7 +693,7 @@ --- | Enclose Widgets within some formating. +-- | Enclose Widgets within some formatting. -- @view@ is intended to be instantiated to a particular format -- -- NOTE: It has a infix priority : @infixr 5@ less than the one of @++>@ and @<++@ of the operators, so use parentheses when appropriate, @@ -734,7 +734,7 @@ -- -- @ getString "hi" '<++' H1 '<<' "hi there"@ -- --- It has a infix prority: @infixr 6@ higher than '<<<' and most other operators. +-- It has a infix priority: @infixr 6@ higher than '<<<' and most other operators. (<++) :: (Monad m, Monoid v) => View v m a -> v @@ -749,7 +749,7 @@ -- -- @bold '<<' "enter name" '++>' 'getString' 'Nothing' @ -- --- It has a infix prority: @infixr 6@ higher than '<<<' and most other operators +-- It has a infix priority: @infixr 6@ higher than '<<<' and most other operators (++>) :: (Monad m, Monoid view) => view -> View view m a -> View view m a html ++> w = -- (html <>) <<< digest @@ -773,7 +773,7 @@ -- | Is an example of login\/register validation form needed by 'userWidget'. In this case -- the form field appears in a single line. it shows, in sequence, entries for the username, --- password, a button for loging, a entry to repeat password necesary for registering +-- password, a button for logging, a entry to repeat password necessary for registering -- and a button for registering. -- The user can build its own user login\/validation forms by modifying this example -- @@ -810,7 +810,7 @@ View view m a noWidget= Control.Applicative.empty --- | a sinonym of noWidget that can be used in a monadic expression in the View monad does not continue +-- | a synonym of noWidget that can be used in a monadic expression in the View monad does not continue stop :: (FormInput view, Monad m, Functor m) => View view m a @@ -830,7 +830,7 @@ notValid :: Monad m => view -> View view m a notValid x= View . return $ FormElm x Nothing --- | Wether the user is logged or is anonymous +-- | If the user is logged or is anonymous isLogged :: MonadState (MFlowState v) m => m Bool isLogged= do rus <- return . tuser =<< gets mfToken @@ -838,7 +838,7 @@ -- | return the result if going forward -- --- If the process is backtraking, it does not validate, +-- If the process is backtracking, it does not validate, -- in order to continue the backtracking returnIfForward :: (Monad m, FormInput view,Functor m) => b -> View view m b returnIfForward x = do @@ -881,7 +881,7 @@ then returnIfForward user else formuser `validate` val muser `wcallback` login1Func where - val _ (Nothing,_) = return . Just $ fromStr "Plese fill in the user/passwd to login, or user/passwd/passwd to register" + val _ (Nothing,_) = return . Just $ fromStr "Please fill in the user/passwd to login, or user/passwd/passwd to register" val mu (Just us, Nothing)= if isNothing mu || isJust mu && fromJust mu == fst us @@ -1016,11 +1016,11 @@ -- -- 'ask' also synchronizes the execution of the flow with the user page navigation by --- * Backtracking (invoking previous 'ask' staement in the flow) when detecting mismatches between +-- * Backtracking (invoking previous 'ask' statement in the flow) when detecting mismatches between -- get and post parameters and what is expected by the widgets -- until a total or partial match is found. -- --- * Advancing in the flow by matching a single requests with one or more sucessive ask statements +-- * Advancing in the flow by matching a single requests with one or more successive ask statements -- -- Backtracking and advancing can occur in a single request, so the flow in any state can reach any -- other state in the flow if the request has the required parameters. @@ -1100,20 +1100,20 @@ ask w where resetState st st'= - put st{mfCookies=[]+ put st{mfCookies=[] -- if autorefresh, keep the list of installed scripts ,mfInstalledScripts= if mfAutorefresh st' then mfInstalledScripts st' else [] ,newAsk= False ,mfToken= mfToken st' ,mfPageFlow= mfPageFlow st' ,mfAjax= mfAjax st' - ,mfData= mfData st'+ ,mfData= mfData st' ,mfSomeNotValidates= False} -- | A synonym of ask. -- --- Maybe more appropiate for pages with long interactions with the user +-- Maybe more appropriate for pages with long interactions with the user -- while the result has little importance. page :: (FormInput view) => @@ -1146,11 +1146,11 @@ updateParams :: Bool -> Params -> Params -> Params updateParams False _ req= req - updateParams True env req=- let old= takeWhile isparam env- (new,rest)= Data.List.span isparam req- parms= new++ old++ rest- + updateParams True env req= + let old= takeWhile isparam env + (new,rest)= Data.List.span isparam req + parms= new++ old++ rest + -- let params= takeWhile isparam env -- fs= fst $ head req -- parms= (case findIndex (\p -> fst p == fs) params of @@ -1168,8 +1168,8 @@ isparam ('c': r:_,_)= isNumber r isparam _= False --- | Creates a stateless flow (see `stateless`) whose behaviour is defined as a widget. It is a --- higuer level form of the latter +-- | Creates a stateless flow (see `stateless`) whose behavior is defined as a widget. It is a +-- higher level form of the latter wstateless :: (Typeable view, FormInput view) => View view IO () -> Flow @@ -1181,7 +1181,7 @@ -- | Wrap a widget with form element within a form-action element. --- Usually this is not necessary since this wrapping is done automatically by the @Wiew@ monad, unless +-- Usually this is not necessary since this wrapping is done automatically by the @View@ monad, unless -- there are more than one form in the page. wform :: (Monad m, FormInput view) => View view m b -> View view m b @@ -1216,8 +1216,8 @@ -- > b << text "click the box" -- > ++> getInt (Just 0) <! [("id","text1"),("onclick", ajaxc elemval)] ajax :: (MonadIO m, FormInput v) - => (String -> View v m ByteString) -- ^ user defined procedure, executed in the server.Receives the value of the javascript expression and must return another javascript expression that will be executed in the web browser - -> View v m (String -> String) -- ^ returns a function that accept a javascript expression and return a javascript event handler expression that invokes the ajax server procedure + => (String -> View v m ByteString) -- ^ user defined procedure, executed in the server.Receives the value of the JavaScript expression and must return another JavaScript expression that will be executed in the web browser + -> View v m (String -> String) -- ^ returns a function that accept a JavaScript expression and return a JavaScript event handler expression that invokes the ajax server procedure ajax f = do requires[JScript ajaxScript] t <- gets mfToken @@ -1237,7 +1237,7 @@ put st{mfAjax=Just ajxl'} return $ \param -> "doServer("++"'" ++ twfname t ++"','"++id++"',"++ param++")" --- | Send the javascript expression, generated by the procedure parameter as a ByteString, execute it in the browser and the result is returned back +-- | Send the JavaScript expression, generated by the procedure parameter as a ByteString, execute it in the browser and the result is returned back -- -- The @ajaxSend@ invocation must be inside a ajax procedure or else a /No ajax session set/ error will be produced ajaxSend @@ -1316,7 +1316,7 @@ -- > page $ p << "fourth page" ++> wlink () << p << "will not reach here" -- -- After navigating to the third page, when --- ckicking in the link, will backtrack to the first, and will validate the first link as if the click +-- clicking in the link, will backtrack to the first, and will validate the first link as if the click -- where done in the first page. Then the second page would be displayed. -- -- In monadic widgets, it also backtrack to the statement where the absLink is located without the @@ -1407,8 +1407,8 @@ manyOf xs= whidden () *> (View $ do forms <- mapM runView xs let vs = mconcat $ map (\(FormElm v _) -> v) forms - res1= catMaybes $ map (\(FormElm _ r) -> r) forms- nval <- gets mfSomeNotValidates+ res1= catMaybes $ map (\(FormElm _ r) -> r) forms + nval <- gets mfSomeNotValidates return . FormElm vs $ if nval then Nothing else Just res1) -- | like manyOf, but does not validate if one or more of the widgets does not validate @@ -1587,7 +1587,7 @@ ------ page Flows ---- -- | Prepares the state for a page flow. It add a prefix to every form element or link identifier for the formlets and also --- keep the state of the links clicked and form imput entered within the widget. +-- keep the state of the links clicked and form input entered within the widget. -- If the computation within the widget has branches @if@ @case@ etc, each branch must have its pageFlow with a distinct identifier. -- See <http://haskell-web.blogspot.com.es/2013/06/the-promising-land-of-monadic-formlets.html> pageFlow @@ -1619,20 +1619,20 @@ -- !> ("END CHILD pageflow. prefix="++ str)) --- | send raw bytestring data to the client. usable for------ example------ > do--- setHttpHeader "Content-Type" "text//plain"--- maxAge 36000--- rawSend longdata--rawSend :: (FormInput v,MonadIO m, Functor m) => ByteString -> View v m ()-rawSend dat= do- setCachePolicy- st <- get- tok <- getToken- liftIO $ sendFlush tok $ HttpData ( mfHttpHeaders st) (mfCookies st) dat+-- | send raw bytestring data to the client. usable for +-- +-- example +-- +-- > do +-- setHttpHeader "Content-Type" "text//plain" +-- maxAge 36000 +-- rawSend longdata + +rawSend :: (FormInput v,MonadIO m, Functor m) => ByteString -> View v m () +rawSend dat= do + setCachePolicy + st <- get + tok <- getToken + liftIO $ sendFlush tok $ HttpData ( mfHttpHeaders st) (mfCookies st) dat modify $ \st -> st{mfAutorefresh= True} - stop+ stop
src/MFlow/Forms/Admin.hs view
@@ -114,7 +114,7 @@ case op of "users" -> users - "sync" -> liftIO $ syncCache >> print "syncronized cache" + "sync" -> liftIO $ syncCache >> print "synchronized cache" "flush" -> liftIO $ atomically flushAll >> print "flushed cache" "errors" -> errors @@ -139,10 +139,6 @@ - - - - users= do users <- liftIO $ atomically $ return . map fst =<< indexOf userName @@ -172,4 +168,3 @@ else do wf <- ask $ firstOf [ wlink wf (p << wf) | (wf,_) <- wfss] ask $ p << unpack (showHistory . fromJust . fromJust $ lookup wf wfss) ++> wlink () (p << "press to menu") -
src/MFlow/Forms/Blaze/Html.hs view
@@ -5,7 +5,7 @@ This package is included in "MFlow.Wai.Blaze.Hml.All". -Use it to create applicaitons with this kind of formatting. +Use it to create applications with this kind of formatting. -} module MFlow.Forms.Blaze.Html where import MFlow @@ -25,7 +25,7 @@ --import Data.Text as T import Text.Blaze.Internal --- | used to insert html elements within a tag with the appropriate infix priority for the +-- | Used to insert html elements within a tag with the appropriate infix priority for the -- other operators used in MFlow. Also it can be used for adding markup to -- widgets with this signature such are 'wlink' ad 'setOption' (<<) :: ToMarkup a => (Markup -> t) -> a -> t @@ -68,10 +68,3 @@ attrs tag ((n,v):attribs) = let tag'= tag ! (customAttribute $ stringTag n) (toValue v) in attrs tag' attribs - - - - - - -
src/MFlow/Forms/Cache.hs view
@@ -30,62 +30,62 @@ | ETag ByteString | Vary ByteString deriving(Typeable, Show,Eq,Ord) --- | to delete all previous directives +-- | To delete all previous directives resetCachePolicy :: (MonadState (MFlowState v) m, Monad m) => m () resetCachePolicy= do modify $ \s -> s{mfHttpHeaders=[]} setSessionData ([] :: [CacheElem]) --- | add @no-cache@ to the @Cache-Control@ header directive. It deletes all expires and put max-age=0 +-- | Add @no-cache@ to the @Cache-Control@ header directive. It deletes all expires and put max-age=0 -- -- It means that the widget need not to be cached noCache :: (MonadState (MFlowState v) m, MonadIO m) => m () noCache = set NoCache --- | add @no-cache: <string>@ to the Cache-Control header directive +-- | Add @no-cache: <string>@ to the Cache-Control header directive -- --- it deletes the header string (sensible cookies for example) from the data stored in the cache +-- It deletes the header string (sensible cookies for example) from the data stored in the cache noCache' :: (MonadState (MFlowState v) m, MonadIO m) => ByteString -> m () noCache' s = set ( NoCache' s) --- | add @no-store@ to the @Cache-Control@ header directive. It deletes @expires@ and put @max-age: 0@ +-- | Add @no-store@ to the @Cache-Control@ header directive. It deletes @expires@ and put @max-age: 0@ -- --- stronger kind of noCache. Not even store temporally +-- Stronger kind of noCache. Not even store temporally noStore :: (MonadState (MFlowState v) m, MonadIO m) => m () noStore = set NoStore --- | add @expires: <date string>@ to the @Cache-Control@ header directive. it deletes @max-age@ +-- | Add @expires: <date string>@ to the @Cache-Control@ header directive. it deletes @max-age@ -- Currently it takes the last one if many -- -- The page will be cached until this date expires :: (MonadState (MFlowState v) m, MonadIO m) => ByteString -> m () expires s = set (Expires s) --- | add @max-age: <seconds>@ to the @Cache-Control@ header directive. if there are more than one, it chooses the lower one +-- | Add @max-age: <seconds>@ to the @Cache-Control@ header directive. if there are more than one, it chooses the lower one -- -- The page will be stored in the cache for that amount of seconds maxAge :: (MonadState (MFlowState v) m, MonadIO m) => Int -> m () maxAge t = set (MaxAge t) --- | add @private@ to the @Cache-Control@ header directive. it delete @public@ if any +-- | Add @private@ to the @Cache-Control@ header directive. it delete @public@ if any -- -- It means that the page that holds the widget must not be shared by other users. private :: (MonadState (MFlowState v) m, MonadIO m) => m () private = set Private --- | add @public@ to the @Cache-Control@ header directive. +-- | Add @public@ to the @Cache-Control@ header directive. -- --- means that the cache can share the page content with other users. +-- Means that the cache can share the page content with other users. public :: (MonadState (MFlowState v) m, MonadIO m) => m () public = set Public --- | add @sMaxAge <seconds>@ to the @Cache-Control@ header directive. if many, chooses the minimum +-- | Add @sMaxAge <seconds>@ to the @Cache-Control@ header directive. if many, chooses the minimum -- --- specify the time to hold the page for intermediate caches: for example proxies and CDNs. +-- Specify the time to hold the page for intermediate caches: for example proxies and CDNs. sMaxAge :: (MonadState (MFlowState v) m, MonadIO m) => Int -> m () sMaxAge secs = set (SMaxAge secs) --- | add @noTransform@ to the @Cache-Control@ header directive. +-- | Add @noTransform@ to the @Cache-Control@ header directive. -- -- Tell CDNs that the content should not be transformed to save space and so on noTransform :: (MonadState (MFlowState v) m, MonadIO m) => m () @@ -93,23 +93,23 @@ -- | add @mustRevalidate@ to the @Cache-Control@ header directive. -- --- the cache must verify that the page has not changed. +-- The cache must verify that the page has not changed. mustRevalidate :: (MonadState (MFlowState v) m, MonadIO m) => m () mustRevalidate = set MustRevalidate --- | add @proxyRevalidate@ to the @Cache-Control@ header directive. +-- | Add @proxyRevalidate@ to the @Cache-Control@ header directive. -- -- The same than mustRevalidate, for shared caches (proxies etc) proxyRevalidate :: (MonadState (MFlowState v) m, MonadIO m) => m () proxyRevalidate = set ProxyRevalidate --- | add @etag <string>@ to the header directives. +-- | Add @etag <string>@ to the header directives. -- --- it is a resource identifier for the page that substitutes the URL identifier +-- It is a resource identifier for the page that substitutes the URL identifier etag :: (MonadState (MFlowState v) m, MonadIO m) => ByteString -> m () etag s = set (ETag s) --- | add @vary <string>@ to the header directives. +-- | Add @vary <string>@ to the header directives. -- -- Usually the page add this identifier to the URL string, that is the default identifier -- So the same page with different etags will be cached and server separately @@ -173,7 +173,7 @@ Nothing -> mmy --- | return the composition of the current directives. Used by the page internally +-- | Return the composition of the current directives. Used by the page internally setCachePolicy :: (MonadState (MFlowState v) m, Monad m) => m () setCachePolicy= do rs <- getSessionData `onNothing` return []
src/MFlow/Forms/Internals.hs view
@@ -58,13 +58,13 @@ -- import Control.Exception as CE -import Control.Concurrent +import Control.Concurrent import Control.Monad.Loc -- debug import Debug.Trace -(!>) = flip trace -+(!>) = flip trace + infixl 9 !> data FailBack a = BackPoint a | NoBack a | GoBack deriving (Show,Typeable) @@ -92,9 +92,9 @@ readp = choice [icanFailBackp,repeatPleasep,noFailBackp] where - noFailBackp = symbol noFailBack >> readp >>= return . NoBack - icanFailBackp = symbol iCanFailBack >> readp >>= return . BackPoint - repeatPleasep = symbol repeatPlease >> return GoBack + noFailBackp = symbol noFailBack >> readp >>= return . NoBack + icanFailBackp = symbol iCanFailBack >> readp >>= return . BackPoint + repeatPleasep = symbol repeatPlease >> return GoBack iCanFailBack= "B" repeatPlease= "G" @@ -103,9 +103,9 @@ newtype Sup m a = Sup { runSup :: m (FailBack a ) } class MonadState s m => Supervise s m where - supBack :: s -> m () -- called before backtracing. state passed is the previous + supBack :: s -> m () -- called before backtracking. state passed is the previous supBack = const $ return () -- By default the state passed is the last one - + supervise :: m (FailBack a) -> m (FailBack a) supervise= id @@ -148,7 +148,7 @@ GoBack -> runSup g !> "GOBACK" _ -> return x --- | the FlowM monad executes the page navigation. It perform Backtracking when necessary to syncronize +-- | the FlowM monad executes the page navigation. It perform Backtracking when necessary to synchronize -- 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. -- @@ -219,7 +219,7 @@ -- -- The monadic code is executed from the beginning each time the page is presented or refreshed -- --- use 'pageFlow' if your page has more than one monadic computation with dynamic behaviour +-- use 'pageFlow' if your page has more than one monadic computation with dynamic behavior -- -- use 'pageFlow' to identify each subflow branch of a conditional -- @@ -245,10 +245,10 @@ supBack st= do -- the previous state is recovered, with the exception of these fields: MFlowState{..} <- get put st{ mfEnv= mfEnv,mfToken=mfToken - , mfPath=mfPath + , mfPath=mfPath , mfData=mfData , mfTrace= mfTrace - , inSync=False+ , inSync=False , mfSomeNotValidates= False , newAsk=False} @@ -289,7 +289,7 @@ -- -- where -- handler1 loc s (e :: SomeException)= --- return (GoBack, s{mfTrace= Just ["exception: " ++show e]}) +-- return (GoBack, s{mfTrace= Just ["exception: " ++show e]}) instance FormInput v => MonadLoc (View v IO) where withLoc loc f = View $ do @@ -317,22 +317,19 @@ - - - instance Functor (FormElm view ) where fmap f (FormElm form x)= FormElm form (fmap f x) instance (Monad m,Functor m) => Functor (View view m) where fmap f x= View $ fmap (fmap f) $ runView x - + instance (Monoid view,Functor m, Monad m) => Applicative (View view m) where pure a = View . return . FormElm mempty $ Just a View f <*> View g= View $ f >>= \(FormElm form1 k) -> g >>= \(FormElm form2 x) -> - return $ FormElm (form1 `mappend` form2) (k <*> x) + return $ FormElm (form1 `mappend` form2) (k <*> x) instance (FormInput view,Functor m, Monad m) => Alternative (View view m) where empty= View $ return $ FormElm mempty Nothing @@ -351,49 +348,48 @@ (_,Just _) -> path2 _ -> path if hasform then put s2{needForm= HasForm,mfPagePath= path3} - else put s2{mfPagePath=path3} - return $ FormElm mix (k <|> x) + else put s2{mfPagePath=path3} + return $ FormElm mix (k <|> x) instance (FormInput view, Monad m) => Monad (View view m) where View x >>= f = View $ do - FormElm form1 mk <- x + FormElm form1 mk <- x case mk of Just k -> do st'' <- get let st = st''{ linkMatched = False } - put st + put st FormElm form2 mk <- runView $ f k st' <- get (mix, hasform) <- controlForms st st' form1 form2 when hasform $ put st'{needForm= HasForm} return $ FormElm mix mk - Nothing -> + Nothing -> return $ FormElm form1 Nothing - return = View . return . FormElm mempty . Just -- fail msg= View . return $ FormElm [inRed msg] Nothing - + instance (FormInput v,Monad m, Functor m, Monoid a) => Monoid (View v m a) where mappend x y = mappend <$> x <*> y -- beware that both operands must validate to generate a sum mempty= return mempty -- | 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 in the +-- when the latter is validated, without affecting the rendering of other widgets. This allow +-- the simultaneous execution of different behaviors 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 page. +-- executed within the same page. wcallback :: Monad m => View view m a -> (a -> View view m b) -> View view m b @@ -403,11 +399,8 @@ Just k -> do modify $ \st -> st{linkMatched= False, needForm=NoElems} runView (f k) - - Nothing -> return $ FormElm form1 Nothing - - + Nothing -> return $ FormElm form1 Nothing @@ -470,7 +463,7 @@ --- | The first elem result (even if it is not validated) is discarded, and the secod is returned +-- | The first elem result (even if it is not validated) is discarded, and the second is returned -- . This contrast with the applicative operator '*>' which fails the whole validation if -- the validation of the first elem fails. -- @@ -493,7 +486,7 @@ FormElm form2 x <- runView g s2 <- get (mix,hasform) <- controlForms s1 s2 form1 form2 - when hasform $ put s2{needForm= HasForm} + when hasform $ put s2{needForm= HasForm} return $ FormElm mix (k *> x) @@ -502,7 +495,7 @@ FormElm form mx <- runView form return $ FormElm form $ Just undefined -infixr 1 **> , <** +infixr 1 **> , <** -- | The second elem result (even if it is not validated) is discarded, and the first is returned -- . This contrast with the applicative operator '*>' which fails the whole validation if @@ -520,7 +513,7 @@ FormElm form2 x <- runView $ valid g s2 <- get (mix,hasform) <- controlForms s1 s2 form1 form2 - when hasform $ put s2{needForm= HasForm} + when hasform $ put s2{needForm= HasForm} return $ FormElm mix (k <* x) @@ -531,7 +524,7 @@ -- Usually this check is nos necessary unless conditional code make it necessary -- -- @menu= do --- mop <- getGoStraighTo +-- mop <- getGoStraighTo -- case mop of -- Just goop -> goop -- Nothing -> do @@ -599,7 +592,7 @@ False -> (lift doit) >>= breturn True -> onback --- | less powerflul version of `onBacktrack`: The second computation simply undo the effect of +-- | less powerful version of `onBacktrack`: The second computation simply undo the effect of -- the first one, and the flow continues backward ever. It can be used as a rollback mechanism in -- the context of long running transactions. compensate :: Monad m => m a -> m a -> FlowM v m a @@ -636,16 +629,16 @@ -- HasForm -> False -- HasElems _ -> True -- NoElems -> False - + data NeedForm= HasForm | HasElems | NoElems deriving Show -data MFlowState view= MFlowState{ +data MFlowState view= MFlowState{ mfSequence :: Int, mfCached :: Bool, newAsk :: Bool, - inSync :: Bool,+ inSync :: Bool, mfSomeNotValidates :: Bool, mfLang :: Lang, mfEnv :: Params, @@ -702,13 +695,13 @@ -- > html' <- getHistory -- > setHistory $ html' `mappend` html -setSessionData :: (Typeable a,MonadState (MFlowState view) m) => a -> m () +setSessionData :: (Typeable a,MonadState (MFlowState view) m) => a -> m () setSessionData x= modify $ \st -> st{mfData= M.insert (typeOf x ) (unsafeCoerce x) (mfData st)} delSessionData x= modify $ \st -> st{mfData= M.delete (typeOf x ) (mfData st)} - + -- | Get the session data of the desired type if there is any. getSessionData :: (Typeable a, MonadState (MFlowState view) m) => m (Maybe a) getSessionData = resp where @@ -738,7 +731,7 @@ getToken= gets mfToken --- get a parameter form the las received response +-- get a parameter form the last received response getEnv :: MonadState (MFlowState view) m => m Params getEnv = gets mfEnv @@ -746,7 +739,7 @@ -- | Set the header-footer that will enclose the widgets. It must be provided in the --- same formatting than them, altrough with normalization to byteStrings any formatting can be used +-- same formatting than them, although with normalization to ByteStrings any formatting can be used -- -- This header uses XML trough Haskell Server Pages (<http://hackage.haskell.org/package/hsp>) -- @@ -850,7 +843,7 @@ -- | Set -- 1) the timeout of the flow execution since the last user interaction. --- Once passed, the flow executes from the begining. +-- Once passed, the flow executes from the beginning. -- -- 2) In persistent flows -- it set the session state timeout for the flow, that is persistent. If the @@ -859,7 +852,7 @@ -- 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 +-- persistent flows (that use `step`) restart at the last saved execution point, unless -- the session time has expired for the user. setTimeouts :: ( MonadState (MFlowState v) m) => Int -> Integer -> m () setTimeouts kt st= do @@ -902,10 +895,10 @@ fromStrNoEncode :: String -> view ftag :: String -> view -> view inred :: view -> view - flink :: String -> view -> view + flink :: String -> view -> view flink1:: String -> view - flink1 verb = flink verb (fromStr verb) - finput :: Name -> Type -> Value -> Checked -> OnClick -> view + flink1 verb = flink verb (fromStr verb) + finput :: Name -> Type -> Value -> Checked -> OnClick -> view ftextarea :: String -> T.Text -> view fselect :: String -> view -> view foption :: String -> view -> Bool -> view @@ -917,7 +910,7 @@ --instance (MonadIO m) => MonadIO (FlowM view m) where --- liftIO io= let x= liftIO io in x `seq` lift x -- to force liftIO==unsafePerformIO onf the Identity monad +-- liftIO io= let x= liftIO io in x `seq` lift x -- to force liftIO==unsafePerformIO of the Identity monad --instance Executable (View v m) where -- execute f = execute $ evalStateT f mFlowState0 @@ -958,7 +951,7 @@ 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+ let s''= s{inSync = inSync s2 ,mfSomeNotValidates= mfSomeNotValidates s2 ,mfRequirements=mfRequirements s2 ,mfPath= mfPath s2 @@ -1016,20 +1009,20 @@ @ -} runFlow :: (FormInput view, MonadIO m) - => FlowM view (Workflow m) () -> Token -> Workflow m () + => FlowM view (Workflow m) () -> Token -> Workflow m () runFlow f t= - loop (startState t) f t + loop (startState t) f t where loop s f t = do - (mt,s) <- runFlowOnce2 s f + (mt,s) <- runFlowOnce2 s f let t'= fromFailBack mt let t''= t'{tpath=[twfname t']} liftIO $ do - flushRec t'' + flushRec t'' sendToMF t'' t'' let s'= case mfSequence s of -1 -> s -- !> "end of recovery loop" - _ -> s{mfPath=[twfname t],mfPagePath=[],mfEnv=[]} + _ -> s{mfPath=[twfname t],mfPagePath=[],mfEnv=[]} loop s' f t''{tpath=[]} -- !> "LOOPAGAIN" inRecovery= -1 @@ -1044,15 +1037,15 @@ ,mfSequence= inRecovery ,mfPath= tpath t ,mfEnv= tenv t - ,mfPagePath=[]} + ,mfPagePath=[]} runFlowOnce2 s f = runStateT (runSup . runFlowM $ do backInit - f + f getToken) s - + where backInit= do s <- get -- !> "BackInit" @@ -1063,7 +1056,7 @@ recover <- lift $ isInRecover when (back && not recover) . modify $ \s -> s{ newAsk= True,mfPagePath=[twfname t]} breturn () - + tr -> error $ disp tr where disp tr= "TRACE (error in the last line):\n\n" ++(concat $ intersperse "\n" tr) @@ -1073,13 +1066,12 @@ :: FormInput v => MFlowState v -> FlowM v m a -> Token -> m (FailBack a, MFlowState v) runFlowOnceReturn s f t = runStateT (runSup $ runFlowM f) (startState t) - -- | Run a persistent flow inside the current flow. It is identified by the procedure and -- the string identifier. --- unlike the normal flows, that run within infinite loops, runFlowIn executes once. --- In subsequent executions, the flow will get the intermediate responses from te log +-- Unlike the normal flows, that run within infinite loops, runFlowIn executes once. +-- In subsequent executions, the flow will get the intermediate responses from the log -- and will return the result without asking again. -- This is useful for asking once, storing in the log and subsequently retrieving user -- defined configurations by means of persistent flows with web formularies. @@ -1090,7 +1082,7 @@ -> FlowM view (Workflow IO) b -> FlowM view m b runFlowIn wf f= FlowM . Sup $ do - st <- get + st <- get let t = mfToken st (r,st') <- liftIO $ exec1nc wf $ runFlow1 st f t put st{mfPath= mfPath st'} @@ -1102,7 +1094,7 @@ runFlow1 st f t= runStateT (runSup . runFlowM $ f) st --- | to unlift a FlowM computation. useful for executing the configuration generated by runFLowIn +-- | To unlift a FlowM computation. useful for executing the configuration generated by runFLowIn -- outside of the web flow (FlowM) monad runFlowConf :: (FormInput view, MonadIO m) => FlowM view m a -> m a runFlowConf f = do @@ -1113,7 +1105,7 @@ evalStateT (runSup . runFlowM $ f ) mFlowState0{mfToken=t} >>= return . fromFailBack -- >> return () --- | run a transient Flow from the IO monad. +-- | Run a transient Flow from the IO monad. --runNav :: String -> FlowM Html IO () -> IO () --runNav ident f= exec1 ident $ runFlowOnce (transientNav f) undefined @@ -1140,7 +1132,7 @@ --- | stores the result of the flow in a persistent log. When restarted, it get the result +-- | Stores the result of the flow in a persistent log. When restarted, it get the result -- from the log and it does not execute it again. When no results are in the log, the computation -- is executed. It is equivalent to 'Control.Workflow.step' but in the FlowM monad. step @@ -1159,8 +1151,8 @@ -- when recovery of a workflow, the MFlow state is not considered when( mfSequence s' /= inRecovery) $ put s' -- !> (show $ mfSequence s') -- else put s{newAsk=True} return r - --- | to execute transient flows as if they were persistent + +-- | To execute transient flows as if they were persistent, -- it can be used instead of step, but it does log nothing. -- Thus, it is faster and convenient when no session state must be stored beyond the lifespan of -- the server process. @@ -1253,7 +1245,7 @@ getParam1 :: (Monad m, MonadState (MFlowState v) m, Typeable a, Read a, FormInput v) => String -> Params -> m (ParamResult v a) getParam1 par req = case lookup par req of - Just x -> readParam x + Just x -> readParam x Nothing -> return NoParam -- Read a segment in the REST path. if it does not match with the type requested @@ -1261,32 +1253,32 @@ getRestParam :: (Read a, Typeable a, Monad m, Functor m, MonadState (MFlowState v) m, FormInput v) => m (Maybe a) getRestParam= do - st <- get + st <- get let lpath = mfPath st if linkMatched st - then return Nothing + then return Nothing else case stripPrefix (mfPagePath st) lpath of Nothing -> return Nothing - Just [] -> return Nothing + Just [] -> return Nothing Just xs -> do -- case stripPrefix (mfPrefix st) (head xs) of -- Nothing -> return Nothing -- Just name -> let name= head xs - r <- fmap valToMaybe $ readParam name + r <- fmap valToMaybe $ readParam name when (isJust r) $ modify $ \s -> s{inSync= True ,linkMatched= True ,mfPagePath= mfPagePath s++[name]} - return r - + return r + -- | return the value of a post or get param in the form ?param=value¶m2=value2... getKeyValueParam par= do st <- get r <- getParam1 par $ mfEnv st return $ valToMaybe r - + readParam :: (Monad m, MonadState (MFlowState v) m, Typeable a, Read a, FormInput v) => String -> m (ParamResult v a) readParam x1 = r @@ -1294,7 +1286,7 @@ r= do modify $ \s -> s{inSync= True} maybeRead x1 - + getType :: m (ParamResult v a) -> a getType= undefined x= getType r @@ -1308,14 +1300,14 @@ [(x,"")] -> return $ Validated x _ -> do let err= inred . fromStr $ "can't read \"" ++ str ++ "\" as type " ++ show (typeOf x) - modify $ \st -> st{mfSomeNotValidates= True}+ modify $ \st -> st{mfSomeNotValidates= True} return $ NotValidated str err ---- Requirements --- | Requirements are javascripts, Stylesheets or server processes (or any instance of the 'Requirement' class) that are included in the +-- | Requirements are JavaScripts, Stylesheets or server processes (or any instance of the 'Requirement' class) that are included in the -- Web page or in the server when a widget specifies this. @requires@ is the -- procedure to be called with the list of requirements. -- Various widgets in the page can require the same element, MFlow will install it once. @@ -1390,7 +1382,7 @@ \}\ \}\ \}" - + loadCallback depend script= let varname= addrStr depend in "\naddLoadEvent("++varname++",function(){"++ script++"});" @@ -1425,7 +1417,7 @@ instance Eq (String, Flow) where (x,_) == (y,_)= x == y - + instance Ord (String, Flow) where compare(x,_) (y,_)= compare x y instance Show (String, Flow) where @@ -1452,7 +1444,7 @@ r1 <- strRequirement' r modify $ \st -> st{mfInstalledScripts= mfInstalledScripts st ++ [r]} return r1 - + strRequirement' (CSSFile scr) = return $ loadcssfile scr strRequirement' (CSS scr) = return $ loadcss scr strRequirement' (JScriptFile file scripts) = do @@ -1477,7 +1469,7 @@ -- other script file has been loaded or demanded load, so loadScript is already installed _ -> return $ loadjsfile file <> concatMap(loadCallback file) scripts - + strRequirement' (JScript scr) = return scr strRequirement' (ServerProc f)= do liftIO $ addMessageFlows [f] @@ -1537,9 +1529,9 @@ - --- | insert a form tag if the widget has form input fields. If not, it does nothing + +-- | Insert a form tag if the widget has form input fields. If not, it does nothing insertForm w=View $ do FormElm forms mx <- runView w st <- get @@ -1549,10 +1541,10 @@ put st{needForm= HasForm} return frm _ -> return forms - + return $ FormElm cont mx --- isert a form tag if necessary when two pieces of HTML have to mix as a result of >>= >> <|> or <+> operators +-- Insert a form tag if necessary when two pieces of HTML have to mix as a result of >>= >> <|> or <+> operators controlForms :: (FormInput v, MonadState (MFlowState v) m) => MFlowState v -> MFlowState v -> v -> v -> m (v,Bool) controlForms s1 s2 v1 v2= case (needForm s1, needForm s2) of @@ -1569,7 +1561,7 @@ -- | Generate a new string. Useful for creating tag identifiers and other attributes. -- --- if the page is refreshed, the identifiers generated are the same. +-- If the page is refreshed, the identifiers generated are the same. genNewId :: MonadState (MFlowState view) m => m String genNewId= do st <- get @@ -1579,13 +1571,13 @@ prefseq= mfPrefix st put $ st{mfSequence= n+1} - return $ 'p':show n++prefseq + return $ 'p':show n++prefseq True -> do let n = mfSeqCache st put $ st{mfSeqCache=n+1} return $ 'c' : (show n) --- | get the next ideitifier that will be created by genNewId +-- | Get the next identifier that will be created by genNewId getNextId :: MonadState (MFlowState view) m => m String getNextId= do st <- get @@ -1597,6 +1589,3 @@ True -> do let n = mfSeqCache st return $ 'c' : (show n) - - -
src/MFlow/Forms/Test.hs view
@@ -15,15 +15,16 @@ -XOverlappingInstances -XFlexibleInstances -XUndecidableInstances - -XPatternGuards + -XPatternGuards -XRecordWildCards + -XFlexibleContexts #-} module MFlow.Forms.Test (Generate(..),runTest,runTest1,inject, ask, askt, userWidget, getUser, getUserSimple, verify) where import MFlow.Forms hiding(ask,askt,getUser,userWidget,getUserSimple) import qualified MFlow.Forms (ask) import MFlow.Forms.Internals -import MFlow.Forms(FormInput(..)) +import MFlow.Forms(FormInput(..)) import MFlow.Forms.Admin import Control.Workflow as WF import Control.Concurrent @@ -92,22 +93,22 @@ typeOfIO :: IO a -> a typeOfIO = undefined --- | run a list of flows with a number of simultaneous threads -runTest :: [(Int, Flow)] -> IO () +-- | Run a list of flows with a number of simultaneous threads +runTest :: [(Int, Flow)] -> IO () runTest ps= do mapM_ (forkIO . run1) ps putStrLn $ "started " ++ (show . sum . fst $ unzip ps) ++ " threads" - + where run1 (nusers, proc) = replicateM_ nusers $ runTest1 proc - + runTest1 f = do atomicModifyIORef testNumber (\n -> (n+1,n+1)) name <- generate x <- generate y <- generate z <- generate - + let t = Token x y z [] [] undefined undefined undefined WF.start name f t @@ -116,10 +117,10 @@ getTestNumber :: MonadIO m => m Int getTestNumber= liftIO $ readIORef testNumber --- | inject substitutes an expression by other. It may be used to override +-- | Inject substitutes an expression by other. It may be used to override -- ask interaction with the user. It should bee used infix for greater readability: -- --- > ask something `inject` const someother +-- > ask something `inject` const some other -- -- The parameter passed is the test number -- if the flow has not been executed by runTest, inject return the original @@ -128,7 +129,7 @@ n <- getTestNumber if n== 0 then exp else exp `seq` return $ v n --- | a simulated ask that generate simulated user input of the type expected. +-- | A simulated ask that generate simulated user input of the type expected. -- -- It forces the web page rendering, since it is monadic and can contain -- side effects and load effects to be tested. @@ -144,7 +145,7 @@ breturn $ n `seq` mx `seq` r -- let u= undefined -- liftIO $ runStateT (runView mf) s --- bool <- liftIO generate +-- bool <- liftIO generate -- case bool of -- False -> fail "" -- True -> do @@ -155,7 +156,7 @@ -- _ -> ask w --- | instead of generating a result like `ask`, the result is given as the first parameter +-- | Instead of generating a result like `ask`, the result is given as the first parameter -- so it does not need a Generate instance. -- -- It forces the web page rendering, since it is monadic so it can contain @@ -195,11 +196,11 @@ -- It is intended to be used in a infix notation, on the right of the code, -- in order to separate the code assertions from the application code and make clearly -- visible them as a form of documentation. --- separated from it: +-- Separated from it: -- -- > liftIO $ print (x :: Int) `verify` (return $ x > 10, "x < = 10") -- --- the expression is monadic to allow for complex verifications that may involve IO actions +-- The expression is monadic to allow for complex verifications that may involve IO actions verifyM :: Monad m => m b -> (m Bool, String) -> m b verifyM f (mprop, msg)= do prop <- mprop @@ -246,7 +247,7 @@ MFlow.Forms.waction (return x) f userWidget :: ( MonadIO m, Functor m - , FormInput view) + , FormInput view) => Maybe String -> View view m (Maybe (String,String), Maybe String) -> View view m String @@ -265,7 +266,7 @@ t'= t{tuser= uname} put st{mfToken= t'} return () - + getUserSimple :: ( MonadIO m, FormInput view, Typeable view , Functor m) => FlowM view m String @@ -305,8 +306,8 @@ instance FormInput TestM where ftag = const id - inred = const id - fromStr = const id + inred = const id + fromStr = const id flink var _= let(n,v)=break (=='=') var in \t ->t{tflink= (n,tail v):tflink t} finput n _ v _ _ = \t -> t{tfinput = (n,v):tfinput t} ftextarea n v= \t -> t{tftextarea = (n,v):tftextarea t} @@ -378,7 +379,7 @@ instance Processable Params where pwfname = fromMaybe noScript . lookup pwf puser= fromMaybe anonymous . lookup cookieuser - pind = fromMaybe "0" . lookup ind + pind = fromMaybe "0" . lookup ind getParams = id
src/MFlow/Forms/WebApi.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------------- -- --- A haskell formlet is the combination of a parameter parser to read input plus a writer to generate HTTP +-- A Haskell formlet is the combination of a parameter parser to read input plus a writer to generate HTTP -- output -- -- I use this similarity to create parsec-like combinators that use the formlet monad in MFlow --(the View monad) to parse the web service parameters and to generate the output. -- --- This service below implements a service that sum or multiply two Int-egers. +-- This service below implements a service that sum or multiply two Integers. -- -- > parserService :: View Html IO () -- > parserService= @@ -40,7 +40,7 @@ import Data.Typeable import Data.Monoid -- | Get the next segment of the REST path. if there is no one or if the data does not match --- with the type expected, then ir return invalid. +-- with the type expected, then it return invalid. -- Therefore a monadic sequence in the View monad will not continue restp :: (Monad m,Functor m, FormInput v,Typeable a,Read a) => View v m a restp = View $ do @@ -49,7 +49,7 @@ --- | check that the next rest segment has a certain value. It return invalid otherwise. +-- | Check that the next rest segment has a certain value. It return invalid otherwise. -- therefore a monadic sequence in the View monad will not continue rest v= do r <- restp @@ -57,7 +57,7 @@ else modify (\s -> s{mfPagePath= reverse . tail . reverse $ mfPagePath s}) >> stop --- | get a parameter from a GET or POST key-value input. +-- | Get a parameter from a GET or POST key-value input. wparam par= View $ do mr <- getKeyValueParam par return $ FormElm mempty mr @@ -86,6 +86,3 @@ case mx of Nothing -> runView $ v ++> stop Just _ -> return r - - -
src/MFlow/Forms/Widgets.hs view
@@ -1,4 +1,3 @@- {- | Some dynamic widgets, widgets that dynamically edit content in other widgets, widgets for templating, content management and multilanguage. And some primitives @@ -67,7 +66,7 @@ import Control.Workflow(killWF) import Unsafe.Coerce import Control.Exception -import MFlow.Forms.Cache+import MFlow.Forms.Cache @@ -88,7 +87,7 @@ ------- User Management ------ -- | Present a user form if not logged in. Otherwise, the user name and a logout link is presented. --- The paremeters and the behaviour are the same as 'userWidget'. +-- The parameters and the behavior are the same as 'userWidget'. -- Only the display is different userFormOrName mode wid= userWidget mode wid `wmodify` f <** maybeLogout where @@ -132,7 +131,7 @@ #endif --- | If not logged, it present a page flow which askm for the user name, then the password if not logged +-- | If not logged, it present a page flow which asks for the user name, then the password if not logged -- -- If logged, it present the user name and a link to logout -- @@ -140,10 +139,10 @@ wlogin :: (MonadIO m,Functor m,FormInput v) => View v m () wlogin= wform $ do username <- getCurrentUser - if username /= anonymous + if username /= anonymous then do private; noCache;noStore - return username + return username else do name <- getString Nothing <! hint "login name" <! size (9 :: Int) @@ -151,16 +150,16 @@ pass <- getPassword <! hint "password" <! size 9 <++ ftag "br" mempty - <** submitButton "login" - val <- userValidate (name,pass) + <** submitButton "login" + val <- userValidate (name,pass) case val of Just msg -> notValid msg Nothing -> login name >> (return name) - + `wcallback` (\name -> ftag "b" (fromStr $ "logged as " ++ name++ " ") - ++> pageFlow "logout" (submitButton "logout")) -- wlink ("logout" :: String) (ftag "b" $ fromStr " logout")) + ++> pageFlow "logout" (submitButton "logout")) -- wlink ("logout" :: String) (ftag "b" $ fromStr " logout")) `wcallback` const (logout >> wlogin) - + focus = [("onload","this.focus()")] hint s= [("placeholder",s)] size n= [("size",show n)] @@ -198,7 +197,7 @@ #endif MonadState (MFlowState view) m) => B.ByteString -- ^ identifier - -> [View v m1 a] -> m () -- ^ withess + -> [View v m1 a] -> m () -- ^ witness delEdited id witness=do Medit stored <- getSessionData `onNothing` return (Medit (M.empty)) let (ks, ws)= unzip $ fromMaybe [] $ M.lookup id stored @@ -239,19 +238,19 @@ return . FormElm mempty . Just $ selector <> "." <> modifier <> "('" <> elem <> "');" where typ :: View v m a -> a - typ = undefined-+ typ = undefined --- | Return the javascript to be executed on the browser to prepend a widget to the location --- identified by the selector (the bytestring parameter), The selector must have the form of a jquery expression + +-- | Return the JavaScript to be executed on the browser to prepend a widget to the location +-- identified by the selector (the bytestring parameter), The selector must have the form of a jQuery expression -- . It stores the added widgets in the edited list, that is accessed with 'getEdited' -- -- The resulting string can be executed in the browser. 'ajax' will return the code to --- execute the complete ajax roundtrip. This code returned by ajax must be in an eventhabdler. +-- execute the complete ajax roundtrip. This code returned by ajax must be in an event handler. -- -- This example will insert a widget in the div when the element with identifier --- /clickelem/ is clicked. when the form is sbmitted, the widget values are returned +-- /clickelem/ is clicked. when the form is submitted, the widget values are returned -- and the list of edited widgets are deleted. -- -- > id1<- genNewId @@ -272,9 +271,9 @@ #else :: (Typeable a, MonadIO m, Executable m, FormInput v) #endif - => B.ByteString -- ^ jquery selector + => B.ByteString -- ^ jQuery selector -> View v Identity a -- ^ widget to prepend - -> View v m B.ByteString -- ^ string returned with the jquery string to be executed in the browser + -> View v m B.ByteString -- ^ string returned with the jQuery string to be executed in the browser prependWidget sel w= modifyWidget sel "prepend" w -- | Like 'prependWidget' but append the widget instead of prepend. @@ -287,7 +286,7 @@ B.ByteString -> View v Identity a -> View v m B.ByteString appendWidget sel w= modifyWidget sel "append" w --- | L ike 'prependWidget' but set the entire content of the selector instead of prepending an element +-- | Like 'prependWidget' but set the entire content of the selector instead of prepending an element setWidget #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) :: (Typeable a, MonadIO m, Executable m, FormInput v, Typeable Identity, Typeable m) => @@ -352,11 +351,11 @@ return r --- | Present the JQuery autocompletion list, from a procedure defined by the programmer, to a text box. +-- | Present the JQuery auto-completion list, from a procedure defined by the programmer, to a text box. wautocomplete :: (Show a, MonadIO m, FormInput v) => Maybe String -- ^ Initial value - -> (String -> IO a) -- ^ Autocompletion procedure: will receive a prefix and return a list of strings + -> (String -> IO a) -- ^ Auto-completion procedure: will receive a prefix and return a list of strings -> View v m String wautocomplete mv autocomplete = do text1 <- genNewId @@ -380,13 +379,13 @@ jaddtoautocomp text1 us= "$('#"<>fromString text1<>"').autocomplete({ source: " <> fromString( show us) <> " });" --- | Produces a text box. It gives a autocompletion list to the textbox. When return +-- | Produces a text box. It gives a auto-completion list to the textbox. When return -- is pressed in the textbox, the box content is used to create a widget of a kind defined -- by the user, which will be situated above of the textbox. When submitted, the result is the content -- of the created widgets (the validated ones). -- -- 'wautocompleteList' is an specialization of this widget, where --- the widget parameter is fixed, with a checkbox that delete the eleement when unselected +-- the widget parameter is fixed, with a checkbox that delete the element when unselected -- . This fixed widget is as such (using generic 'FormElem' class tags): -- -- > ftag "div" <<< ftag "input" mempty @@ -403,7 +402,7 @@ , FormInput v) #endif => String -- ^ the initial text of the box - -> (String -> IO [String]) -- ^ the autocompletion procedure: receives a prefix, return a list of options. + -> (String -> IO [String]) -- ^ the auto-completion procedure: receives a prefix, return a list of options. -> (Maybe String -> View v Identity a) -- ^ the widget to add, initialized with the string entered in the box -> [String] -- ^ initial set of values -> View v m [a] -- ^ resulting widget @@ -457,7 +456,7 @@ #endif -- | A specialization of 'wutocompleteEdit' which make appear each chosen option with --- a checkbox that deletes the element when uncheched. The result, when submitted, is the list of selected elements. +-- a checkbox that deletes the element when unchecked. The result, when submitted, is the list of selected elements. wautocompleteList #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) :: (Functor m, MonadIO m, Executable m, FormInput v, Typeable m, Typeable Identity) => @@ -503,7 +502,7 @@ Just (TField k v) -> if v /= mempty then return $ fromStrNoEncode $ toString v else return text Nothing -> return text --- | Creates a rich text editor aroun a text field or a text area widget. +-- | Creates a rich text editor around a text field or a text area widget. -- This code: -- -- > page $ p "Insert the text" @@ -511,7 +510,7 @@ -- > (getMultilineText "" <! [("rows","3"),("cols","80")]) <++ br -- > <** submitButton "enter" -- --- Creates a rich text area with bold and italic buttons. The buttons are the ones alled +-- Creates a rich text area with bold and italic buttons. The buttons are the ones added -- in the nicEdit editor. htmlEdit :: (Monad m, FormInput v) => [String] -> UserStr -> View v m a -> View v m a htmlEdit buttons jsuser w = do @@ -563,7 +562,7 @@ flushCached k sendFlush token $ HttpData [] [] "" return() - + requires [JScriptFile nicEditUrl [install] ,JScript ajaxSendText ,JScript installEditField @@ -571,7 +570,7 @@ us <- getCurrentUser when(us== muser) noCache - + (ftag "div" mempty `attrs` [("id",ipanel)]) ++> notValid (ftag "span" content `attrs` [("id", name)]) @@ -666,7 +665,7 @@ modify $ \s -> s{mfPagePath=mfPagePath st ,mfSequence= mfSequence st ,mfHttpHeaders=[]} - w) + w) ret <- case r of Nothing -> do @@ -686,18 +685,18 @@ -- View $ do -- let t= mfToken st -- modify $ \s -> s{mfRequirements=[],mfHttpHeaders=[]} -- !> "just" --- resetCachePolicy +-- resetCachePolicy -- FormElm _ mr <- runView w' --- setCachePolicy +-- setCachePolicy -- -- reqs <- installAllRequirements -- --- st' <- get +-- st' <- get -- liftIO . sendFlush t $ HttpData --- (mfHttpHeaders st') +-- (mfHttpHeaders st') -- (mfCookies st') (toByteString reqs) --- put st'{mfAutorefresh=True, inSync=True} --- return $ FormElm mempty Nothing +-- put st'{mfAutorefresh=True, inSync=True} +-- return $ FormElm mempty Nothing delSessionData $ IteratedId name mempty return ret @@ -795,11 +794,11 @@ let env = mfEnv st IteratedId name scripts <- getSessionData `onNothing` return (IteratedId noid mempty) - let r = lookup ("auto"++name) env + let r = lookup ("auto"++name) env if r == Nothing || (name == noid && newAsk st== True) - then return $ FormElm((ftag "span" render) `attrs` [("id",id)]) mx + then return $ FormElm((ftag "span" render) `attrs` [("id",id)]) mx else do - setSessionData $ IteratedId name $ scripts <> "setId('"++id++"','" ++ toString (toByteString $ render)++"');" + setSessionData $ IteratedId name $ scripts <> "setId('"++id++"','" ++ toString (toByteString $ render)++"');" return $ FormElm mempty mx noid= "noid" @@ -862,7 +861,7 @@ ------------------- JQuery widgets ------------------- --- | present the JQuery datepicker calendar to choose a date. +-- | present the JQuery datePicker calendar to choose a date. -- The second parameter is the configuration. Use \"()\" by default. -- See http://jqueryui.com/datepicker/ datePicker :: (Monad m, FormInput v) => String -> Maybe String -> View v m (Int,Int,Int) @@ -922,14 +921,14 @@ FormInput v) => View v m a -> View v m a -autoRefresh = update "html" +autoRefresh = update "html" --- | In some cases, it is neccessary that a link or form inside a 'autoRefresh' or 'update' block +-- | In some cases, it is necessary that a link or form inside a 'autoRefresh' or 'update' block -- should not be autorefreshed, since it produces side effects in the rest of the page that -- affect to the rendering of the whole. If you like to refresh the whole page, simply add -- noAutoRefresh attribute to the widget to force the refresh of the whole page when it is activated. -- --- That behaviour is common at the last sentence of the 'autoRefresh' block. +-- That behavior is common at the last sentence of the 'autoRefresh' block. -- -- This is a cascade menu example. -- @@ -987,14 +986,14 @@ st <- get let insync = inSync st let env= mfEnv st - let r= lookup ("auto"++id) env + let r= lookup ("auto"++id) env if r == Nothing then do requires [JScript $ timeoutscript t ,JScript ajaxGetLink ,JScript ajaxPostForm - ,JScriptFile jqueryScript [installscript]] - (ftag "div" <<< insertForm w) <! [("id",id)] + ,JScriptFile jqueryScript [installscript]] + (ftag "div" <<< insertForm w) <! [("id",id)] else refresh $ fromStr (method <> " ") ++> insertForm w -- View $ do @@ -1005,12 +1004,12 @@ -- setCachePolicy -- st' <- get -- let HttpData ctype c s= toHttpData $ method <> " " <> toByteString form --- +-- -- (liftIO . sendFlush t $ HttpData (ctype ++ -- mfHttpHeaders st') (mfCookies st' ++ c) s) -- put st'{mfAutorefresh=True,newAsk=True} --- --- return $ FormElm mempty Nothing +-- +-- return $ FormElm mempty Nothing where -- | adapted from http://www.codeproject.com/Articles/341151/Simple-AJAX-POST-Form-and-AJAX-Fetch-Link-to-Modal @@ -1111,17 +1110,17 @@ data UpdateMethod= Append | Prepend | Html deriving Show --- | continously execute a widget and update the content. +-- | continuously 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. -- Updates in the session context are not seen by the push widget. It has his own context. --- To communicate with te widget, use DBRef's or TVar and the +-- To communicate with the 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 +-- Widgets in a push can have links and forms, but since they are asynchronous, they can not -- return inputs. but they can modify the server state. -- push ever return an invalid response to the calling widget, so it never -- triggers the advance of the navigation. @@ -1263,7 +1262,7 @@ --- | takes as argument a widget and delay the load until it is visible. The renderring to +-- | takes as argument a widget and delay the load until it is visible. The rendering to -- be shown during the load is the specified in the first parameter. The resulting lazy -- widget behaves programatically in the same way. -- @@ -1286,7 +1285,7 @@ st <- get let path = currentPath st env = mfEnv st - r= lookup ("auto"++id) env + r= lookup ("auto"++id) env t = mfkillTime st -1 installscript = "$(document).ready(function(){\ \function lazyexec(){lazy('"++id++"','"++ path ++"',lazyexec)};\ @@ -1301,7 +1300,7 @@ FormElm _ mx <- runView w modify $ \st-> st{mfRequirements= reqs} --ignore requirements return $ FormElm (ftag "div" v `attrs` [("id",id)]) mx - + else refresh w where
src/MFlow/Forms/XHtml.hs view
@@ -62,5 +62,3 @@ instance Typeable Html where typeOf = \_ -> mkTyConApp (mkTyCon3 "xhtml" "Text.XHtml.Strict" "Html") [] - -
src/MFlow/Hack.hs view
@@ -29,7 +29,7 @@ import Control.Concurrent import Control.Exception import qualified Data.Map as M -import Data.Maybe +import Data.Maybe import Data.TCache import Data.TCache.DefaultPersistence import Control.Workflow hiding (Indexable(..)) @@ -52,7 +52,7 @@ where sc= tail $ pathInfo env puser env = fromMaybe anonymous $ lookup cookieuser $ http env - + pind env= fromMaybe (error ": No FlowID") $ lookup flow $ http env getParams= http -- getServer env= serverName env @@ -60,7 +60,7 @@ -- getPort env= serverPort env - + --------------------------------------------- @@ -83,11 +83,11 @@ --webScheduler :: Env -- -> ProcList -- -> IO (TResp, ThreadId) ---webScheduler = msgScheduler +--webScheduler = msgScheduler ---theDir= unsafePerformIO getCurrentDirectory +--theDir= unsafePerformIO getCurrentDirectory -wFMiddleware :: (Env -> Bool) -> (Env-> IO Response) -> (Env -> IO Response) +wFMiddleware :: (Env -> Bool) -> (Env-> IO Response) -> (Env -> IO Response) wFMiddleware filter f = \ env -> if filter env then hackMessageFlow env else f env -- !> "new message" -- | An instance of the abstract "MFlow" scheduler to the Hack interface @@ -108,7 +108,7 @@ -- @ --hackMessageFlow :: [(String, (Token -> Workflow IO ()))] -- -> (Env -> IO Response) ---hackMessageFlow messageFlows = +--hackMessageFlow messageFlows = -- unsafePerformIO (addMessageFlows messageFlows) `seq` -- hackWorkflow -- wFMiddleware f other -- where @@ -133,7 +133,7 @@ hackMessageFlow :: Env -> IO Response hackMessageFlow req1= do - let httpreq1= http req1 + let httpreq1= http req1 let cookies= {-# SCC "getCookies" #-} getCookies httpreq1 (flowval , retcookies) <- case lookup ( flow) cookies of @@ -141,8 +141,8 @@ Nothing -> do fl <- newFlow return ( fl, [( flow, fl, "/",(Just $ show $ 365*24*60*60))]) - -{- for state persistence in cookies + +{- for state persistence in cookies putStateCookie req1 cookies let retcookies= case getStateCookie req1 of Nothing -> retcookies1 @@ -151,7 +151,7 @@ let input= case ( requestMethod req1, lookup "Content-Type" httpreq1 ) of - (POST,Just "application/x-www-form-urlencoded") -> urlDecode . unpack $ hackInput req1 + (POST,Just "application/x-www-form-urlencoded") -> urlDecode . unpack $ hackInput req1 (GET, _) -> urlDecode . queryString $ req1 _ -> [] @@ -197,12 +197,12 @@ {- persistInCookies= setPersist PersistStat{readStat=readResource, writeStat=writeResource, deleteStat=deleteResource} where - writeResource stat= modifyMVar_ tvresources $ \mmap -> + writeResource stat= modifyMVar_ tvresources $ \mmap -> case mmap of Just map-> return $ Just $ M.insert (keyResource stat) (serialize stat) map Nothing -> return $ Just $ M.fromList [((keyResource stat), (serialize stat)) ] readResource stat= do - mstr <- withMVar tvresources $ \mmap -> + mstr <- withMVar tvresources $ \mmap -> case mmap of Just map -> return $ M.lookup (keyResource stat) map Nothing -> return Nothing @@ -210,7 +210,7 @@ Nothing -> return Nothing Just str -> return $ deserialize str - deleteResource stat= modifyMVar_ tvresources $ \mmap-> + deleteResource stat= modifyMVar_ tvresources $ \mmap-> case mmap of Just map -> return $ Just $ M.delete (keyResource stat) map Nothing -> return $ Nothing
src/MFlow/Hack/Response.hs view
@@ -35,9 +35,9 @@ instance ToResponse TResp where - toResponse (TResp x)= toResponse x + toResponse (TResp x)= toResponse x toResponse (TRespR r)= toResponse r - + instance ToResponse Response where toResponse = id
src/MFlow/Wai.hs view
@@ -4,8 +4,9 @@ , MultiParamTypeClasses , DeriveDataTypeable , FlexibleInstances - , OverloadedStrings- , TemplateHaskell #-} + , OverloadedStrings + , TemplateHaskell + , FlexibleContexts #-} module MFlow.Wai( module MFlow.Cookies @@ -44,7 +45,7 @@ import Network.Wai.Parse import qualified Data.Conduit.Binary as CB import Control.Monad.Trans.Resource -import Network.HTTP.Types +import Network.HTTP.Types import Data.Conduit import Data.Conduit.Lazy import qualified Data.Conduit.List as CList @@ -57,14 +58,14 @@ --import Debug.Trace --(!>) = flip trace --+ + toApp :: (Request -> IO Response) -> Application #if MIN_VERSION_wai(3, 0, 0) toApp f req sendResponse = f req >>= sendResponse #else toApp = id -#endif+#endif flow= "flow" @@ -148,7 +149,7 @@ let req = case retcookies of - [] -> req1{requestHeaders= filesp ++ mkParams (params ++ cookies) ++ requestHeaders req1} + [] -> req1{requestHeaders= filesp ++ mkParams (params ++ cookies) ++ requestHeaders req1} _ -> req1{requestHeaders= filesp ++ mkParams ((flow, flowval): params ++ cookies) ++ requestHeaders req1}
src/MFlow/Wai/Blaze/Html/All.hs view
@@ -66,38 +66,38 @@ return $ fromMaybe "80" $ lookup "PORT" env let porti= if and $ map isNumber port then fromIntegral $ read port else 80 -+ putStr "using port " print porti return porti -+ --getPortW= do --- args <- getArgs--- let h= Prelude.head args--- ht= Prelude.head $ tail args--- port <- if isport h then return h--- else if isport ht then return ht--- else do+-- args <- getArgs +-- let h= Prelude.head args +-- ht= Prelude.head $ tail args +-- port <- if isport h then return h +-- else if isport ht then return ht +-- else do -- env <- getEnvironment --- return $ fromMaybe "80" $ lookup "PORT" env--- +-- return $ fromMaybe "80" $ lookup "PORT" env +-- -- let porti= if isport port then fromIntegral $ read port -- else 80 --- ---+-- +-- -- putStr "using port " -- print porti --- return porti--- where--- isport x= and $ map isNumber x- --- | run a persistent flow. It uses `getPortW` to get the port +-- return porti +-- where +-- isport x= and $ map isNumber x + +-- | Run a persistent flow. It uses `getPortW` to get the port -- The first parameter is the first element in the URL path. -- It also set the home page -- The port is read from the first parameter passed to the executable. -- If no parameter, it is read from the PORT environment variable. -- if this does not exist, the port 80 is used. -runNavigation :: String -> FlowM Html (Workflow IO) () -> IO () +runNavigation :: String -> FlowM Html (Workflow IO) () -> IO () runNavigation n f= do unless (null n) $ setNoScript n addMessageFlows[(n, runFlow f)]
src/MFlow/Wai/Response.hs view
@@ -5,7 +5,7 @@ import Network.Wai import MFlow.Cookies -import Data.ByteString.Lazy.UTF8 +import Data.ByteString.Lazy.UTF8 import MFlow import Data.Typeable import Data.Monoid @@ -42,7 +42,7 @@ instance ToResponse TResp where toResponse (TResp x)= toResponse x toResponse (TRespR r)= toResponse r - + instance ToResponse Response where toResponse = id @@ -57,6 +57,3 @@ toResponse (Error str)= responseLBS status404 [("Content-Type", "text/html")] str -- toResponse $ error "FATAL ERROR: HttpData errors should not reach here: MFlow.Forms.Response.hs " - - -