Workflow-0.2: demos/demo.hs

{-# 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.Dynamic (IResource(..),registerType)
import Control.Workflow
import Debug.Trace
import Data.Typeable
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,Typeable) --  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   = show                     -- the WF monad is in charge of the persistence)
     deserialize = read                     -- (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   
   registerType None
   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 "33"  

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 "13")  -- 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 "22")
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