MFlow-0.0.3: (Web) application server. Stateful server processes. Simple, statically correct widget combinators.

Safe HaskellSafe-Infered

MFlow.Hack

Synopsis

Documentation

getCookies :: [([Char], [Char])] -> [([Char], [Char])]Source

data Req Source

Constructors

forall a . (Processable a, Typeable a) => Req a 

data Resp Source

Constructors

forall a c . (Typeable a, Typeable c, Monoid c, ConvertTo a c) => Fragm a 
forall a c . (Typeable a, Typeable c, Monoid c, ConvertTo a c) => EndFragm a 
forall a c . (Typeable a, Typeable c, ConvertTo a c) => Resp a 

type Workflow m = WF Stat m

data HttpData a Source

Constructors

HttpData [Cookie] a 

Instances

Typeable1 HttpData 
ToResponse a => ToResponse (HttpData a) 
ToResponse v => ConvertTo (HttpData v) TResp 

class ConvertTo a b | a -> b whereSource

Methods

convert :: a -> bSource

Instances

ConvertTo String TResp 
ConvertTo ByteString TResp 
ConvertTo Error TResp 
ToResponse v => ConvertTo (HttpData v) TResp 

type ProcList = WorkflowList IO Token ()Source

List of (wfname, workflow) pairs, to be scheduled depending on the message's pwfname

send :: (Typeable a, Typeable b, ConvertTo a b) => Token -> a -> IO ()Source

send a complete response

sendFlush :: (Typeable b, Typeable a, ConvertTo a b) => Token -> a -> IO ()Source

sendFragment :: (Typeable a, Typeable b, Monoid b, ConvertTo a b) => Token -> a -> IO ()Source

send a response fragment. Useful for streaming. the last packet must sent trough send

transient :: (Token -> IO ()) -> Token -> Workflow IO ()Source

to add a monadic computation that send and receive messages, but does not store its state in permanent storage.

hackMessageFlow :: ProcList -> Env -> IO ResponseSource

An instance of the abstract MFlow scheduler to the Hack interface it accept the list of processes being scheduled and return a hack handler

Example:

main= do

putStrLn $ options messageFlows
   run 80 $ hackMessageFlow messageFlows
   where
   messageFlows=  [("main",  runFlow flowname )
                  ,("hello", stateless statelesproc)
                  ,("trans", transient $ runflow transientflow]
   options msgs= "in the browser choose\n\n" ++
     concat [ http://server/++ i ++ n | (i,_) <- msgs]