Workflow-0.5.5: demos/demoT.hs

{-# OPTIONS -fglasgow-exts #-}
-- example of the Workflow package .
-- This demo shows inter-workflow communications.
-- 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.Dynamic (IResource(..),registerType)
import Control.Workflow
import Debug.Trace
import Data.Typeable
import Control.Concurrent(forkIO, threadDelay)
import System.Exit

debug a b = trace b a


wfList= [("hello-ask", hello),("wait", wait)]

-- 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
-- RestartWorkflows restar all workflows in the pending workflow list
-- if startWF is called when startworflow has already restarted a the same workflow

main= do
   registerType  :: IO ()
   registerType :: IO String
   registerType :: IO Int
   forkIO $ startWF "hello-ask" () wfList


   startWF "wait"  ()  wfList

hello _= 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 <- step $   do
                            print "what is your name?"
                            getLine
      step $ putStrLn $ "hello Mr "++  name
      try 0 name

      where
      try i name=do
          unsafeIOtoWF $ threadDelay 100000
          str <- step $  do

                putStrLn $ "Mr "++name++ " this is your try number "++show (i+1) ++". Guess my number, press \"end\" to finish"
                getLine
          try  (i+1) name




wait _ = do
      let
          filter "5"  = True
          filter  "end" = True
          filter _= False
      r <- step $ waitFor filter "hello-ask"  ()  -- wait the other thread to store an object with the same key than Try 0 ""
                                               -- with the string "5"  or termination
      case r of
        "5" -> step $ do
                  print "done ! "
                  delwfs
                  exitSuccess

        "end" ->  step $ print "end received. Bye" >>
                      delwfs >>
                      exitSuccess

      where
      delwfs=  do
                      delWFHistory "hello-ask" ()
                      delWFHistory "wait" ()