Workflow 0.7.0.4 → 0.7.0.5
raw patch · 4 files changed
+48/−58 lines, 4 files
Files
- Control/Workflow.hs +40/−21
- Control/Workflow/Stat.hs +1/−1
- Demos/pr.hs +6/−35
- Workflow.cabal +1/−1
Control/Workflow.hs view
@@ -93,6 +93,7 @@ , exec , exec1d , exec1+, exec1nc , wfExec , startWF , restartWorkflows@@ -112,7 +113,7 @@ -- * State manipulation , writeWFRef , moveState--- * Workflow inspect+-- * Workflow inspection , waitWFActive , getAll --, getStep@@ -341,7 +342,7 @@ -- Its state is deleted when finished and the result is stored in -- the parent's WF state. wfExec- :: (Indexable a, Serialize a, Typeable a+ :: (Serialize a, Typeable a , CMC.MonadCatchIO m, MonadIO m) => Workflow m a -> Workflow m a wfExec f= do@@ -349,8 +350,7 @@ step $ exec1 str f -- | A version of exec1 that deletes its state after complete execution or thread killed-exec1d :: (Serialize b, Typeable b- ,MonadIO m, CMC.MonadCatchIO m)+exec1d :: (MonadIO m, CMC.MonadCatchIO m) => String -> (Workflow m b) -> m b exec1d str f= do r <- exec1 str f@@ -366,8 +366,7 @@ -- | A version of exec with no seed parameter.-exec1 :: ( Serialize a, Typeable a- , Monad m, MonadIO m, CMC.MonadCatchIO m)+exec1 :: ( Monad m, MonadIO m, CMC.MonadCatchIO m) => String -> Workflow m a -> m a exec1 str f= exec str (const f) ()@@ -378,8 +377,7 @@ -- | Start or continue a workflow with exception handling -- the workflow flags are updated even in case of exception -- `WFerrors` are raised as exceptions-exec :: ( Indexable a, Serialize a, Serialize b, Typeable a- , Typeable b+exec :: ( Indexable a, Serialize a, Typeable a , Monad m, MonadIO m, CMC.MonadCatchIO m) => String -> (a -> Workflow m b) -> a -> m b exec str f x =@@ -397,8 +395,25 @@ CMC.throw e ) -+-- | executes a workflow, but does not mark it as finished even if+-- the process ended.+-- The workflow will return the las result.+exec1nc :: ( Monad m, MonadIO m, CMC.MonadCatchIO m)+ => String -> Workflow m a -> m a+exec1nc str f =+ (do+ v <- getState str f ()+ case v of+ Right (name, f, stat) -> do+ r <- runWF1 name f stat False+ return r+ Left err -> CMC.throw err)+ `CMC.catch`+ (\(e :: CE.SomeException) -> liftIO $ do+ let name= keyWF str ()+ clearRunningFlag name --`debug` ("exception"++ show e) + CMC.throw e ) mv :: MVar Int mv= unsafePerformIO $ newMVar 0@@ -554,9 +569,8 @@ :: ( CMC.MonadCatchIO m , MonadIO m , Indexable a- , Serialize a, Serialize b- , Typeable a- , Typeable b)+ , Serialize a+ , Typeable a) => String -- ^ name thar identifies the workflow. -> (a -> Workflow m b) -- ^ workflow to execute -> a -- ^ initial value (ever use the initial value for restarting the workflow)@@ -579,6 +593,7 @@ return . Left $ WFException $ show e ) + -- | Return conditions from the invocation of start/restart primitives data WFErrors = NotFound | AlreadyRunning | Timeout | WFException String deriving (Typeable, Read, Show) @@ -668,12 +683,16 @@ -runWF :: (Monad m,MonadIO m- , Serialize b, Typeable b)- => String -> Workflow m b -> Stat -> m b-runWF n f s= do+runWF :: ( Monad m, MonadIO m)+ => String -> Workflow m b -> Stat -> m b+runWF n f s = runWF1 n f s True++++runWF1 n f s clear= do (s', v') <- st f s{versions= L.tail $ versions s} -- !> (show $ versions s)- liftIO $! clearFromRunningList n+ liftIO $ if clear then clearFromRunningList n+ else clearRunningFlag n >> return () return v' where @@ -782,7 +801,7 @@ -- moveFile (defPath proto ++ key proto) (defPath proto ++ fromJust mdir) atomically . withSTMResources [] $ const resources{ toDelete= [proto] } -+-- | wait until the workflow is restarted waitWFActive wf= do r <- threadWF wf case r of -- wait for change in the wofkflow state@@ -1038,7 +1057,7 @@ waitForData :: (IResource a, Typeable a) => (a -> Bool) -- ^ The condition that the retrieved object must meet -> a -- ^ a partially defined object for which keyResource can be extracted- -> IO a -- ^ return the retrieved object that meet the condition and has the given kwaitForData filter x= atomically $ waitForDataSTM filter x+ -> IO a -- ^ return the retrieved object that meet the condition and has the given key waitForData f x = atomically $ waitForDataSTM f x waitForDataSTM :: (IResource a, Typeable a)@@ -1127,8 +1146,8 @@ *example: wait for any respoinse from a Queue if no response is given in 5 minutes, it is returned True. @- flag <- 'getTimeoutFlag' $ 5 * 60- ap <- 'step' . atomically $ readSomewhere >>= return . Just `orElse` 'waitUntilSTM' flag >> return Nothing+ flag \<- 'getTimeoutFlag' $ 5 * 60+ ap \<- `step` . atomically $ readSomewhere >>= return . Just `orElse` 'waitUntilSTM' flag >> return Nothing case ap of Nothing -> do 'logWF' "timeout" ... Just x -> do 'logWF' $ "received" ++ show x ...
Control/Workflow/Stat.hs view
@@ -249,7 +249,7 @@ (openFile name ReadWriteMode) hClose f- `catch` (handler name (safe name f))+ `Control.Exception.catch` (handler name (safe name f)) where handler name doagain e | isDoesNotExistError e=do
Demos/pr.hs view
@@ -1,43 +1,14 @@ module Main where import Control.Workflow-import Control.Workflow.Stat -import Data.TCache-import Control.Concurrent(threadDelay)-import System.IO (hFlush,stdout)-import Control.Concurrent-import qualified Data.ByteString.Lazy.Char8 as B --main2= do- Just stat <- getWFHistory "docApprobal" "Doc#title"- B.putStrLn $ showHistory stat- withResource stat $ \(Just stat) -> stat{recover= False}- syncCache----main= do- refs <- exec1 "WFRef" $ do- step $ return (1 :: Int)- (ref,s) <- stepWFRef $ return "bye initial valoe"- step $ return (3 :: Int)-- return ref-- atomically $ writeWFRef refs "hi final value"- s <- atomically $ readWFRef refs- print s- Just stat <- getWFHistory "WFRef" ()- B.putStrLn $ showHistory stat- syncCache- atomically flushAll- Just stat <- getWFHistory "WFRef" ()- B.putStrLn $ showHistory stat- s <- atomically $ readWFRef refs- print s-+main = getName >>= putStrLn +getName= exec1nc "test" $ do+ name <- step $ do+ putStrLn "your name?"+ getLine + return $ "hello " ++ name
Workflow.cabal view
@@ -1,5 +1,5 @@ name: Workflow-version: 0.7.0.4+version: 0.7.0.5 cabal-version: >= 1.6 build-type: Simple license: BSD3