{-# OPTIONS -fglasgow-exts #-} -- example of the Workflow package . -- two workflows that interact by modifing the structure "Data". One ask the user for a numbers. When the total number of tries -- is exhausted, update Data with termination and ends. It can end when termination comes from the other workflow. The other wait for "5", print -- a message , update Data with termination to the other and finish. t -- you can break the code at any moment. The flow with re-start in the last interrupted point -- For bugs, questions, whatever, please email me: Alberto Gómez Corona agocorona@gmail.com module Main where import Data.TCache (IResource(..)) import Control.Workflow import Debug.Trace import Control.Concurrent(forkIO, threadDelay) debug a b = trace b a wfList= [("hello-ask",hello),("wait",wait)] data Data = Name String |Try Int String | Finish String | None deriving (Read,Show) -- for complex data, better to define a RefSerialize interface (see RefSerialize package) instance IResource Data where keyResource (Name str) = "Name" -- the filename of the object to be stored keyResource (Try n s) = "Try-Finish" -- need to be the same key for "wait" to check these two values. keyResource (Finish _) = "Try-Finish" -- need tp be the same key for "wait" to check these two values. keyResource None = "None" defPath _ = "data/" -- path where temporary problem-related data will be stored serialize x = undefined -- the WF monad is in charge of the persistence) deserialize x= undefined -- (the WF monad is in charge of the persistence) -- startWF insert a workflow in the workflow list and start it. if the WF was in a intermediate state, restart it -- A workflow state is identified by: -- the name of the workflow -- the key of the last versión of the object -- In general the last can change, therefore a the workflow identifier change. In this case, startWF will not detect that -- condition and will restart a new workflow with the starting object -- RestartWorkflows restar all workflows in the pending workflow list -- if startWF is called when startworflow has already restarted a the same workflow main= do forkIO $ do startWF "hello-ask" None wfList return() startWF "wait" None wfList hello d= do unsafeIOtoWF $ do putStrLn "" putStrLn "At any step you can break and re-start the program" putStrLn "The program will restart at the interrupted step." putStrLn "" --syncWrite True -- this is the default name@(Name str) <- step askName d step printname name askNumbers str $ Try 0 "" askName :: Data-> IO Data askName _ = do print "what is your name?" str <- getLine return $ Name str printname :: Data -> IO Data printname (Name name)= do print $ "hello Mr "++name return None wait _ = do let filter (Try _ "5") = True filter (Finish _)= True filter _= False r <- step (waitFor filter) (Try 0 "") -- wait the other thread to store an object with the same key than Try 0 "" -- with the string "5" or termination case r of Try n "5" -> step1 $ return $ Finish $ "done in the step "++ show n++" !" -- the WF monad store the Finish message Finish str -> step2 $ print str -- finish message sent by the other thread (max count reached) step2 $ threadDelay 1000000 -- wait the finalization of the other thead step1 f= step (\_->f) None step2 f= step(\_->f >> return None) None askNumbers :: String -> Data -> Workflow IO Data askNumbers name d = do step2 $ threadDelay 5000 -- wait for the other tread to process. r <- step (waitFor anything) d -- get the last value of the object with key "try-finish", to look for the other thread actions case r of Finish msg -> step2 $ print msg --the other thread sent a finalize response -- `debug` "hello-ask: finish detected" Try 9 num -> step1 $ return $ Finish "sorry, no more guesses" --send finalization to the wait thread -- `debug` "hello-ask: Finish returned" _ -> do nd <- step (askNumber name) d askNumbers name nd where anything= \_-> True askNumber:: String -> Data ->IO Data askNumber name None= askNumber name (Try 0 "") askNumber name d@(Try i num)= do print $ "Mr "++name++ " this is your try number "++show (i+1) ++". Guess my number" str <- getLine return $ Try (i+1) str