diff --git a/Demos/demos.hs b/Demos/demos.hs
--- a/Demos/demos.hs
+++ b/Demos/demos.hs
@@ -12,12 +12,13 @@
(!>)= flip trace
-data Ops= Ints | Strings | Actions | Ajax deriving(Typeable,Read, Show)
+data Ops= Ints | Strings | Actions | Ajax | Shop deriving(Typeable,Read, Show)
main= do
syncWrite SyncManual
setFilesPath ""
addFileServerWF
- forkIO $ run 80 $ waiMessageFlow [("noscript",transient $ runFlow mainf)]
+ forkIO $ run 80 $ waiMessageFlow [("noscript",transient $ runFlow mainf)
+ ("shop" ,runFlow shopCart)]
adminLoop
@@ -34,6 +35,7 @@
Strings -> clicks "1"
Actions -> actions 1
Ajax -> ajaxsample
+ Shop -> shopCart
mainf
clickn (n :: Int)= do
@@ -67,3 +69,20 @@
<**((getInt (Just (n+1)) <** submitButton "submit" ) `waction` actions )
breturn ()
+
+shopCart = do
+ setTimeouts 10 0
+ shopCart1 (V.fromList [0,0,0:: Int])
+ where
+ shopCart1 cart= do
+ i <- step . ask
+ $ table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"]
+ <<< caption << "choose an item"
+ ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"]
+ ++> (tbody
+ <<< (tr <<< td <<< wlink 0 (bold <<"iphone") <++ td << ( bold << show ( cart V.! 0))
+ <|> tr <<< td <<< wlink 1 (bold <<"ipad") <++ td << ( bold << show ( cart V.! 1))
+ <|> tr <<< td <<< wlink 2 (bold <<"ipod") <++ td << ( bold << show ( cart V.! 2)))
+ )
+ let newCart= cart V.// [(i, cart V.! i + 1 )]
+ shopCart1 newCart
diff --git a/MFlow.cabal b/MFlow.cabal
--- a/MFlow.cabal
+++ b/MFlow.cabal
@@ -1,5 +1,5 @@
name: MFlow
-version: 0.0.5.2
+version: 0.0.5.3
cabal-version: >= 1.6
build-type: Simple
license: BSD3
@@ -8,15 +8,16 @@
stability: experimental
synopsis: Web app server for stateful processes with safe, composable user interfaces.
-description: It is a Web framework with some unique features thanks to the power of the Haskell language.
- MFlow run stateful server processes. Because flows are stateful, not event driven, the code is more
+description: A Web framework with some unique features thanks to the power of the Haskell language.
+ MFlow run stateful server processes. Because flows are stateful, not isolated request-responses, the code is more
understandable, because all the flow of request and responses is coded by the programmer in a single function.
Allthoug single request-response flows and callbacks are possible.
.
Technically it is a Web application server for stateful processes (flows) that are optionally persistent.
These processes interact with the user trough interfaces made of widgets that return back statically typed responses to
- the calling process. All is coded in pure haskell (with optional XML from Haskell Server Pages).
- It adopt and extend the formlet/applicative approach. It has bindings for HSP and Text.XHtml
+ the process that sent the interface (including links). The process is coded in pure haskell (with optional XML from Haskell Server Pages).
+ It adopt and extend the formlet/applicative approach. The interfaces and communication are abstract, but it has bindings for HSP, Text.XHtml and byteString
+ , Hack and WAI but it can be extended to non Web based architectures.
.
It includes Application Server features such is process and session timeouts
and automatic recovery of flow execution state.
@@ -24,8 +25,8 @@
This release add transparent back button management, cached widgets, callbacks, modifiers, heterogeneous formatting AJAX,
and WAI integration.
.
- It is designed for coding an entire application in a single file to be run with runghc in order
- to speed up the prototyping process.
+ It is designed for coding an entire application can be run with no deployment with runghc in order
+ to speed up the development process.
.
See "MFlow.Forms" for details
.
@@ -44,7 +45,7 @@
library
build-depends: Workflow -any, transformers -any, mtl -any,
- extensible-exceptions -any, xhtml -any, base >4.0 && <4.6,
+ extensible-exceptions -any, xhtml -any, base >4.0 && < 5,
hack -any, hack-handler-simpleserver -any, bytestring -any,
containers -any, RefSerialize -any, TCache -any, stm >2,
old-time -any, vector -any, hsp -any, directory -any,
diff --git a/src/MFlow.hs b/src/MFlow.hs
--- a/src/MFlow.hs
+++ b/src/MFlow.hs
@@ -12,13 +12,13 @@
"MFlow.Wai" is a instantiation for the WAI interface.
-In order to manage resources, the serving process may die after a timeout.
-as well as the logged state, usually, after a longer timeout .
+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 higuer level interface. Altroug fragments streaming 'sendFragment' 'sendEndFragment'
-are only provided at this level.
+an higuer level interface.
+Fragment based streaming 'sendFragment' 'sendEndFragment' are provided only at this level.
+
'stateless' and 'transient' serving processes are possible. `stateless` are request-response
with no intermediate messaging dialog. `transient` processes have no persistent
state, so they restart anew after a timeout or a crash.
@@ -36,10 +36,15 @@
,OverloadedStrings
#-}
module MFlow (
-Params, Req(..), Resp(..), Workflow, HttpData(..),Processable(..), ToHttpData(..), Token(..), getToken, ProcList
-,flushRec, receive, receiveReq, receiveReqTimeout, send, sendFlush, sendFragment, sendEndFragment
+Params, Workflow, HttpData(..),Processable(..), ToHttpData(..)
+, Token(..), ProcList
+,flushRec, receive, receiveReq, receiveReqTimeout, send, sendFlush, sendFragment
+, sendEndFragment
,msgScheduler, addMessageFlows,getMessageFlows, transient, stateless,anonymous
-,noScript,hlog,addTokenToList,deleteTokenInList, btag, bhtml, bbody,Attribs)
+,noScript,hlog,addTokenToList,deleteTokenInList,
+-- * ByteString tags
+-- | basic but efficient tag formatting
+btag, bhtml, bbody,Attribs)
where
import Control.Concurrent.MVar
@@ -115,10 +120,14 @@
| EndFragm HttpData
| Resp HttpData
-
+-- | The anonymous user
anonymous= "anon#"
+
+-- | It is the path of the root flow
noScript = "noscript"
-
+
+-- | 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.
data Token = Token{twfname,tuser, tind :: String , q :: MVar Req, qr :: MVar Resp} deriving Typeable
instance Indexable Token where
@@ -229,16 +238,19 @@
--- ! to add a simple monadic computation of type (a -> IO b) to the list
--- of the scheduler
+-- | executes a simple monadic computation that receive the params and return a response
+--
+-- It is used with `addMessageFlows` `hackMessageFlow` or `waiMessageFlow`
stateless :: (ToHttpData b) => (Params -> IO b) -> (Token -> Workflow IO ())
stateless f = transient $ \tk ->do
req <- receiveReq tk
resp <- f (getParams req)
sendFlush tk resp
--- | to add a monadic computation that send and receive messages, but does
+-- | 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
+--
+---- It is used with `addMessageFlows` `hackMessageFlow` or `waiMessageFlow`
transient :: (Token -> IO ()) -> (Token -> Workflow IO ())
transient f= unsafeIOtoWF . f -- WF(\s -> f t>>= \x-> return (s, x) )
@@ -246,9 +258,10 @@
_messageFlows :: MVar (M.Map String (Token-> Workflow IO ()))
_messageFlows= unsafePerformIO $ newMVar M.empty -- [(String,Token -> Workflow IO ())])
-
+-- | add a list of flows to be scheduled. Each entry in the list is a pair @(path, flow)@
addMessageFlows wfs= modifyMVar_ _messageFlows(\ms -> return $ M.union ms (M.fromList wfs))
-
+
+-- | return the list of the scheduler
getMessageFlows = readMVar _messageFlows
class ToHttpData a where
@@ -291,6 +304,9 @@
instance ToHttpData String where
toHttpData= HttpData [] [] . pack
+-- | The scheduler creates a Token with every `Processable`
+-- message that arrives and send the mesage to the appropriate flow, get the response
+-- and return it.
msgScheduler
:: (Typeable a,Processable a)
=> a -> IO (HttpData, ThreadId)
@@ -334,13 +350,15 @@
hPutStrLn hlog (","++show [u,show t,wf,e]) >> hFlush hlog
logFileName= "errlog"
+
+-- | The handler of the error log
hlog= unsafePerformIO $ openFile logFileName ReadWriteMode
-- basic bytestring XML tags
type Attribs= [(String,String)]
--- | writes a XML tag in a ByteString. It is the most basic form of formatting. For
--- more sophisticated formatting , use "Text.XHtml" or "HSP".
+-- | Writes a XML tag in a ByteString. It is the most basic form of formatting. For
+-- more sophisticated formatting , use "MFlow.Forms.XHtml" or "MFlow.Forms.HSP".
btag :: String -> Attribs -> ByteString -> ByteString
btag t rs v= "<" `append` pt `append` attrs rs `append` ">" `append` v `append`""
where
diff --git a/src/MFlow/FileServer.hs b/src/MFlow/FileServer.hs
--- a/src/MFlow/FileServer.hs
+++ b/src/MFlow/FileServer.hs
@@ -1,5 +1,7 @@
{- | A file server for frequently accessed files, such are static web pages and image decorations, icons etc
-that are cached (memoized) in the program space, for enhanced performance.
+that 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.
-}
@@ -108,11 +110,11 @@
-- | Creates the url of file path. To be used in ordinary links to files.
-- in Text.XHtml, a image would be embeded as
--
--- @image ![src linkFile imagepath]@
+-- > image ![src $ linkFile imagepath]
--
-- in HSP:
--
--- @\
@
+-- >
-- | Given the relative path of a file, it return the content of the @href@ element in a html link
linkFile :: String -> String
diff --git a/src/MFlow/Forms.hs b/src/MFlow/Forms.hs
--- a/src/MFlow/Forms.hs
+++ b/src/MFlow/Forms.hs
@@ -19,7 +19,7 @@
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
-the calling process. Because flows are stateful, not event driven, the code is more understandable, because
+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 function. Allthoug
single request-response flows and callbacks are possible.
@@ -102,8 +102,8 @@
\<* submitButton "register"
@
-[@ByteString normalization and hetereogeneous formatting@] For caching widget rendering at the ByteString level, and to permit many formatring styles
-in the same page, there are new operators that combine different renderings which are converted to ByteStrings.
+[@ByteString normalization and hetereogeneous formatting@] For caching the rendering of widgets at the ByteString level, and to permit many formatring 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.
[@AJAX@] See "MFlow.Forms.Ajax"
@@ -119,24 +119,18 @@
> import Control.Monad.Trans
> import Data.Typeable
> import Control.Concurrent
-> import Control.Exception as E
-> import qualified Data.ByteString.Char8 as SB
>
-> import Debug.Trace
-> (!>)= flip trace
>
->
> data Ops= Ints | Strings | Actions | Ajax deriving(Typeable,Read, Show)
+>
> main= do
> syncWrite SyncManual
-> setFilesPath ""
-> addFileServerWF
> forkIO $ run 80 $ waiMessageFlow [("noscript",transient $ runFlow mainf)]
> adminLoop
>
>
->
> stdheader c= p << "you can press the back button to go to the menu"+++ c
+>
> mainf= do
> setHeader stdheader
> r <- ask $ wlink Ints (bold << "Ints") <|>
@@ -171,8 +165,8 @@
>
> ajaxsample= do
> setHeader ajaxheader
-> ajaxc <- ajaxCommand "document.getElementById('text1').value"
-> (\n -> return $ "document.getElementById('text1').value='"++show(read n +1)++"'")
+> ajaxc <- ajaxCommand "document.getTextBoxentById('text1').value"
+> (\n -> return $ "document.getTextBoxentById('text1').value='"++show(read n +1)++"'")
> ask $ (getInt (Just 0) breturn()
>
@@ -196,26 +190,37 @@
,getCurrentUser,getUserSimple, getUser, userFormLine, userLogin, userWidget,
-- * User interaction
ask, clearEnv,
--- * Getters to be used in instances of `FormLet` and `Widget` in the Applicative style.
-
-getString,getInt,getInteger
+-- * formLets
+-- | they mimic the HTML form elements.
+-- It is possible to modify their attributes with the `),wintersperse,(|*>),(|+|), (**>),(<**),wconcat,(<|>),(<*),(<$>),(<*>),
+(<+>),(|*>),(|+|), (**>),(<**),wconcat,(<|>),(<*),(<$>),(<*>),
--- * Normalized( convert to ByteString) widget combinators
+-- * 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
+--
+-- The purpose is to combine heterogeneous formats into byteString-formatted widgets that
+-- can be cached with `cachedWidget`
(.<+>.), (.|*>.), (.|+|.), (.**>.),(.<**.), (.<|>.),
-- * Formatting combinators
(<<<),(<++),(++>),(.)
-- * ByteString tags
@@ -287,7 +292,8 @@
userPrefix= "User#"
instance Indexable User where
key User{userName= user}= keyUserName user
-
+
+-- | return the key name of an user
keyUserName n= userPrefix++n
-- | Register an user/password
@@ -415,10 +421,10 @@
{-# NOINLINE breturn #-}
--- | Use this instead of return to leave a computation with an ask statement
+-- | Use this instead of return to return from a computation with an ask statement
--
--- This way when the user press the back button, the computation will return back to
--- according with the user navigation.
+-- This way when the user press the back button, the computation will execute back, to
+-- the returned code, according with the user navigation.
breturn x= BackT . return $ BackPoint x -- !> "breturn"
@@ -565,7 +571,7 @@
-- (FormElm frm x) <- runView (widget x)
-- return (frm, x)
--- | Minimal definition: either (wrender and wget) or widget
+-- Minimal definition: either (wrender and wget) or widget
--class (Functor m, MonadIO m) => Widget a b m view | a -> b view where
-- wrender :: a -> WState view m [view]
-- wrender x =do
@@ -584,7 +590,14 @@
--instance FormLet a m view => Widget (Maybe a) a m view where
-- widget = digest
-
+{- | Execute the @FlowM view m@ monad. It is used as parameter of `hackMessageFlow`
+`waiMessageFlow` or `addMessageFlows`
+
+@main= do
+ forkIO $ run 80 $ waiMessageFlow [(\"noscript\",transient $ runFlow mainf)]
+ adminLoop
+@
+-}
runFlow :: (FormInput view, Monoid view, Monad m)
=> FlowM view m () -> Token -> m ()
runFlow f = \ t -> evalStateT (runBackT $ backp >> f) mFlowState0{mfToken=t} >> return ()
@@ -681,8 +694,8 @@
_ -> return $ FormElm form mx
-- | Actions are callbacks that are executed when a widget is validated.
--- It is useful when the widget is inside widget containers that know nothing about his content
--- it returns a result that can be significative or, else, be ignored with '<**' and '**>'.
+-- It is useful when the widget is inside widget containers that know nothing about his content.
+-- It returns a result that can be significative 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) =>
@@ -705,9 +718,10 @@
_ -> return $ FormElm form Nothing
--- | A modifier get the result and the rendering of a widget and change them
--- This modifier changes a login-password-register widget by changing it by the username when logged.
+-- | A modifier get the result and the rendering of a widget and change them.
--
+-- This modifier, when logged, changes a login-password-register widget with a display username.
+--
-- @userFormOrName= `userWidget` Nothing `userFormLine` \`wmodify\` f
-- where
-- f _ justu\@(Just u) = return ([`fromString` u], justu) -- user validated, display and return user
@@ -738,24 +752,30 @@
digest mxy = do
let (x,y,z)= case mxy of Nothing -> (Nothing, Nothing, Nothing); Just (x,y,z)-> (Just x, Just y,Just z)
(,,) <$> digest x <*> digest y <*> digest z
-
+
+-- | display a text box and return a String
getString :: (FormInput view,Monad m) =>
Maybe String -> View view m String
-getString = getElem
-
+getString = getTextBox
+
+-- | display a text box and return an Integer (if the value entered is not an Integer, fails the validation)
getInteger :: (FormInput view, Functor m, MonadIO m) =>
Maybe Integer -> View view m Integer
-getInteger = getElem
-
+getInteger = getTextBox
+
+-- | display a text box and return a Int (if the value entered is not an Int, fails the validation)
getInt :: (FormInput view, Functor m, MonadIO m) =>
Maybe Int -> View view m Int
-getInt = getElem
-
+getInt = getTextBox
+
+-- | display a password box
getPassword :: (FormInput view,
Monad m) =>
View view m String
getPassword = getParam Nothing "password" Nothing
+-- | implement a radio button that perform a submit when pressed.
+-- the parameter is the name of the radio group
getRadioActive :: (FormInput view, Functor m, MonadIO m) =>
String -> String -> View view m String
getRadioActive n v= View $ do
@@ -768,9 +788,9 @@
mn
-
-
+-- | implement a radio button
+-- the parameter is the name of the radio group
getRadio :: (FormInput view, Functor m, MonadIO m) =>
String -> String -> View view m String
getRadio n v= View $ do
@@ -783,18 +803,33 @@
( isJust mn && v== fromJust mn) Nothing])
mn
+-- | display a text box and return the value entered if it is readable( Otherwise, fail the validation)
+getCheckBox :: (FormInput view, Functor m, MonadIO m) =>
+ String -> Bool -> View view m String
+getCheckBox v checked= View $ do
+ n <- getNewName
+ st <- get
+ put st{needForm= True}
+ let env = mfEnv st
+ FormElm f mn <- getParam1 n env []
+ return $ FormElm
+ (f++[finput n "checkbox" v
+ ( checked || (isJust mn && v== fromJust mn)) Nothing])
+ mn
+
+
-- get a parameter form the las received response
getEnv :: MonadState (MFlowState view) m => String -> m(Maybe String)
getEnv n= gets mfEnv >>= return . lookup n
-getElem
+getTextBox
:: (FormInput view,
Monad m,
Typeable a,
Show a,
Read a) =>
Maybe a -> View view m a
-getElem ms = getParam Nothing "text" ms
+getTextBox ms = getParam Nothing "text" ms
getParam
@@ -838,16 +873,12 @@
return $ if mfCached st then "c" else "p"++show parm
-
+-- | display a multiline text box and return its content
getMultilineText :: (FormInput view,
Monad m) =>
- Maybe String -> View view m String
-getMultilineText mt = View $ do
- tolook <- getNewName
-
- let nvalue= case mt of
- Nothing -> ""
- Just v -> v
+ String -> View view m String
+getMultilineText nvalue = View $ do
+ tolook <- getNewName
env <- gets mfEnv
let form= [ftextarea tolook nvalue]
getParam1 tolook env form
@@ -860,7 +891,9 @@
Just bool -> Just $ case bool of
True -> "True"
False -> "False"
-
+
+-- | display an dropdown box with the two values (second (true) and third parameter(false))
+-- . With the value of the first parameter selected.
getBool :: (FormInput view,
Monad m) =>
Maybe String -> String -> String -> View view m Bool
@@ -876,10 +909,12 @@
-- Just x -> return . FormElm f $ fromstr x
where
fromstr x= if x== truestr then True else False
-
+
+-- | display a dropdown box with the options. the value of the first parameter is optionally selected
+-- . It returns the selected option.
getOption :: (FormInput view,
Monad m) =>
- Maybe String ->[(String, String)] -> View view m String
+ Maybe String ->[(String, view)] -> View view m String
getOption mv strings = View $ do
tolook <- getNewName
st <- get
@@ -890,8 +925,22 @@
--- | Encloses instances of `Widget` or `FormLet` in formating
--- view is intended to be instantiated to a particular format
+-- | Enclose Widgets in some formating.
+-- @view@ is intended to be instantiated to a particular format
+--
+-- This is a widget, which is table with some links. it returns an Int
+--
+-- > import MFlow.Forms.XHtml
+-- >
+-- > tableLinks :: View Html Int
+-- > tableLinks= table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"]
+-- > <<< caption << "choose an item"
+-- > ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"]
+-- > ++> (tbody
+-- > <<< (tr <<< td <<< wlink 0 (bold <<"iphone") <++ td << ( bold << "One")
+-- > <|> tr <<< td <<< wlink 1 (bold <<"ipad") <++ td << ( bold << "Two")
+-- > <|> tr <<< td <<< wlink 2 (bold <<"ipod") <++ td << ( bold << "Three"))
+-- > )
(<<<) :: (Monad m, Monoid view)
=> (view ->view)
-> View view m a
@@ -973,14 +1022,14 @@
class FormInput view where
inred :: view -> view
fromString :: String -> view
- flink :: String -> view -> view
+ flink :: String -> view -> view
flink1:: String -> view
flink1 verb = flink verb (fromString verb)
- finput :: Name -> Type -> Value -> Checked -> OnClick -> view
+ finput :: Name -> Type -> Value -> Checked -> OnClick -> view
ftextarea :: String -> String -> view
- foption :: String -> [(String, String)] -> Maybe String -> view
+ foption :: String -> [(String, view)] -> Maybe String -> view
foption1 :: String -> [String] -> Maybe String -> view
- foption1 name list msel= foption name (zip list list) msel
+ foption1 name list msel= foption name (zip list (map fromString list)) msel
formAction :: String -> view -> view
addAttributes :: view -> Attribs -> view
@@ -1008,11 +1057,10 @@
data MFlowState view= MFlowState{
mfSequence :: Int,
- mfCached :: Bool,
+ mfCached :: Bool,
prevSeq :: [Int],
onInit :: Bool,
--- mfGoingBack :: Bool,
- validated :: Bool,
+ validated :: Bool,
-- mfUser :: String,
mfLang :: Lang,
mfEnv :: Params,
@@ -1161,7 +1209,10 @@
View view m a
noWidget= View . return $ FormElm [] Nothing
-
+-- | render the Show instance of the parameter and return it. It is useful
+-- for displaying information
+wrender :: (Monad m, Show a, FormInput view) => a -> View view m a
+wrender x= View . return $ FormElm [fromString $ show x] (Just x)
-- | Wether the user is logged or is anonymous
isLogged :: MonadState (MFlowState v) m => m Bool
@@ -1245,8 +1296,8 @@
-- | Join two widgets in the same page
-- the resulting widget, when `ask`ed with it, returns a either one or the other
--
--- @r <- ask widget widget1 <+> widget widget2@
---
+-- > r <- ask widget widget1 <+> widget widget2
+-- > case r of (Just x, Nothing) -> ..
(<+>) , mix :: Monad m
=> View view m a
-> View view m b
@@ -1276,7 +1327,7 @@
-- | 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
--- the validation of the first elem fails.
+-- the validation of the second elem fails.
-- . The first element is displayed however, as in the case of '<*'
(<**)
:: (Functor m, Monad m) =>
@@ -1394,9 +1445,10 @@
put st{mfEnv= req}
---data Selection a view= Selection{stitle:: view, sheader :: [view] , sbody :: [([view],a)]}
+-- | wrap a widget of form element within a form-action element.
+---- Usually it is done automatically by the @Wiew@ monad.
wform :: (Monad m, FormInput view, Monoid view)
=> View view m b -> View view m b
@@ -1425,8 +1477,8 @@
--widget <+ view = widget <* insertView view
---data Link a view = Link a view
+-- | creates a link wiget. A link can be composed with other widget elements,
wlink :: (Typeable a, Read a, Show a, MonadIO m, Functor m, FormInput view)
=> a -> view -> View view m a
wlink x v= View $ do
@@ -1458,12 +1510,12 @@
res1= if null res then Nothing else head res
return $ FormElm vs res1
-
-(|*>),wintersperse :: (MonadIO m, Functor m,Monoid view)
+-- | intersperse a widget in a list of widgets. the results is a 2-tuple of both types
+(|*>) :: (MonadIO m, Functor m,Monoid view)
=> View view m r
-> [View view m r']
-> View view m (Maybe r,Maybe r')
-wintersperse x xs= View $ do
+(|*>) x xs= View $ do
FormElm fxs rxs <- runView $ wconcat xs
FormElm fx rx <- runView $ x
@@ -1472,22 +1524,27 @@
(Nothing, Nothing) -> Nothing
other -> Just other
-(|*>)= wintersperse
+
infixr 5 |*>, .|*>.
-(|+|) w w'= wintersperse w [w']
+-- | Put a widget above and below other. Useful for navigation links in a page.
+(|+|) :: (Functor m, Monoid view, MonadIO m)
+ => View view m r
+ -> View view m r'
+ -> View view m (Maybe r, Maybe r')
+(|+|) w w'= w |*> [w']
infixr 1 |+|, .|+|.
--- | Flatten a binary tree of tuples of Maybe results produced by the <+> operator
+-- | Flatten a binary tree of tuples of Maybe results produced by the \<+> operator
-- into a single tuple with the same elements in the same order.
--- This is useful to make matching easier . For example:
+-- This is useful for easing matching. For example:
--
-- @ res \<- ask $ wlink1 \<+> wlink2 wform \<+> wlink3 \<+> wlink4@
--
--- @res@ has type:
+-- @res@ has type:
--
-- @Maybe (Maybe (Maybe (Maybe (Maybe a,Maybe b),Maybe c),Maybe d),Maybe e)@
--
@@ -1529,48 +1586,53 @@
doflat Nothing= (Nothing,Nothing,Nothing,Nothing,Nothing,Nothing)
-
+-- | > (.<<.) w x = w $ toByteString x
(.<<.) :: (ToByteString view) => (ByteString -> ByteString) -> view -> ByteString
(.<<.) w x = w $ toByteString x
-
-
-
-
+-- | > (.<+>.) x y = normalize x <+> normalize y
(.<+>.)
:: (Monad m, ToByteString v, ToByteString v1) =>
View v m a -> View v1 m b -> View ByteString m (Maybe a, Maybe b)
(.<+>.) x y = normalize x <+> normalize y
+-- | > (.|*>.) x y = normalize x |*> map normalize y
(.|*>.)
:: (Functor m, MonadIO m, ToByteString v, ToByteString v1) =>
View v m r
-> [View v1 m r'] -> View ByteString m (Maybe r, Maybe r')
(.|*>.) x y = normalize x |*> map normalize y
+-- | > (.|+|.) x y = normalize x |+| normalize y
(.|+|.)
:: (Functor m, MonadIO m, ToByteString v, ToByteString v1) =>
View v m r -> View v1 m r' -> View ByteString m (Maybe r, Maybe r')
(.|+|.) x y = normalize x |+| normalize y
+-- | > (.**>.) x y = normalize x **> normalize y
(.**>.)
:: (Monad m, Functor m, ToByteString v, ToByteString v1) =>
View v m a -> View v1 m b -> View ByteString m b
(.**>.) x y = normalize x **> normalize y
+-- | > (.<**.) x y = normalize x <** normalize y
(.<**.)
:: (Monad m, Functor m, ToByteString v, ToByteString v1) =>
View v m a -> View v1 m b -> View ByteString m a
(.<**.) x y = normalize x <** normalize y
+-- | > (.<|>.) x y= normalize x <|> normalize y
(.<|>.)
:: (Monad m, Functor m, ToByteString v, ToByteString v1) =>
View v m a -> View v1 m a -> View ByteString m a
(.<|>.) x y= normalize x <|> normalize y
-
+-- | > (.<++.) x v= normalize x <++ toByteString v
+(.<++.) :: (Monad m, ToByteString v, ToByteString v') => View v m a -> v' -> View ByteString m a
(.<++.) x v= normalize x <++ toByteString v
+-- | > (.++>.) v x= toByteString v ++> normalize x
+(.++>.) :: (Monad m, ToByteString v, ToByteString v') => v -> View v' m a -> View ByteString m a
(.++>.) v x= toByteString v ++> normalize x
@@ -1582,7 +1644,7 @@
ftextarea name text= btag "textarea" [("name", name)] $ pack text
foption name list msel= btag "select" [("name", name)] (mconcat
- $ map (\(n,v) -> btag "option" ([("value", n)] ++ selected msel n) (pack v)) list)
+ $ map (\(n,v) -> btag "option" ([("value", n)] ++ selected msel n) v) list)
where
selected msel n= if Just n == msel then [("selected","true")] else []
diff --git a/src/MFlow/Forms/Admin.hs b/src/MFlow/Forms/Admin.hs
--- a/src/MFlow/Forms/Admin.hs
+++ b/src/MFlow/Forms/Admin.hs
@@ -27,6 +27,7 @@
import System.Exit
import Control.Exception as E
+
ssyncCache= putStr "sync..." >> syncCache >> putStrLn "done"
-- | A small console interpreter with some commands:
@@ -39,8 +40,8 @@
--
-- [@abort@] Exit. Do not synchronize
--
--- on exception, for example Control-c, it sync and exit.
--- it used as the last statement of the main procedure.
+-- on exception, for example Control-c, it sync and exits.
+-- It must be used as the last statement of the main procedure.
adminLoop :: IO ()
adminLoop= do
op <- getLine
@@ -59,6 +60,8 @@
-- | Install the admin flow in the list of flows handled by `HackMessageFlow`
-- this gives access to an administrator page. It is necessary to
-- create an admin user with `setAdminUser`.
+--
+-- The administration page is reached with the path @"adminserv"@
addAdminWF= addMessageFlows[("adminserv",transient $ runFlow adminMFlow)]
diff --git a/src/MFlow/Wai.hs b/src/MFlow/Wai.hs
--- a/src/MFlow/Wai.hs
+++ b/src/MFlow/Wai.hs
@@ -121,7 +121,8 @@
--wFMiddleware :: (Request -> Bool) -> (Request-> IO Response) -> (Request -> IO Response)
--wFMiddleware filter f = \ env -> if filter env then waiWorkflow env else f env -- !> "new message"
--- | An instance of the abstract "MFlow" scheduler to the Wai interface
+-- | An instance of the abstract "MFlow" scheduler to the interface.
+--
-- it accept the list of processes being scheduled and return a wai handler
--
-- Example: