diff --git a/Control/Workflow.hs b/Control/Workflow.hs --- a/Control/Workflow.hs +++ b/Control/Workflow.hs @@ -113,7 +113,6 @@ , newWFRef , stepWFRef , readWFRef -, getWFRef -- * State manipulation , writeWFRef , moveState @@ -333,8 +332,11 @@ else fork $ exec1 str f >> labelFinish r str Nothing + `CMC.catch` \(E.ErrorCall str) -> do + liftIO . atomicallySync $ writeWFRef r (WFInfo str True (Just $ WFException str)) -- !> ("ERROR *****"++show e) + killWF1 $ keyWF str () `CMC.catch` \(e :: E.SomeException) -> do - liftIO . atomicallySync $ writeWFRef r (WFInfo str True . Just . WFException $ show e) -- !> ("ERROR *****"++show e) + liftIO . atomicallySync $ writeWFRef r (WFInfo str True (Just . WFException $ show e)) -- !> ("ERROR *****"++show e) killWF1 $ keyWF str () @@ -454,8 +456,7 @@ -- | Lifts a monadic computation to the WF monad, and provides transparent state loging and resuming the computation -- Note: Side effect can be repeated at recovery time if the log was not complete before shut down -- see the integer sequence example, above. -step :: ( Monad m - , MonadIO m +step :: ( MonadIO m , Serialize a , Typeable a) => m a @@ -607,13 +608,19 @@ clearRunningFlag name return $ Left e) `CMC.catch` - (\(e :: CE.SomeException) -> liftIO $ do + (\(E.ErrorCall msg) ->do let name= keyWF namewf v clearRunningFlag name + return . Left $ WFException msg) + `CMC.catch` + (\(e :: CE.SomeException) -> liftIO $ do + let name= keyWF namewf v + clearRunningFlag name 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) @@ -943,31 +950,27 @@ liftIO $ atomically $ writeDBRef self s' r `seq` return (s',(ref,r)) ) --- | return a reference to the nth elem of a workflow. The workflow is identified by --- the workflow string and the parameter. If there is no parameter, use () --- In case the type of the reference is not the expected, it return an error string.This is only known at runtime +-- | return a reference to the last logged entry in the workflow +-- In case the type of the reference is not of the type expected, it return an error string. +--getWFRef ::(Typeable b, Serialize b,MonadIO m) => Workflow m (Either String (WFRef b)) +--getWFRef= WF $ \s -> liftIO $ doit s +-- where +-- doit s@Stat{..}= do +-- let (n,flag)= if recover +-- then (state - (L.length versions ) -1 ,False) +-- else (state - 1 ,True) -- --- In case the workflow is not found it produces an error message -getWFRef ::(Typeable b, Serialize b, Indexable a) => Int -> String -> a -> STM(Either String (WFRef b)) -getWFRef n wfname v= wfref - where - wfref= do - let ref = getDBRef $ keyResource stat0{wfName= keyWF wfname v} - s@Stat{..} <- readDBRef ref `onNothing` error ("getWFRef: not found "++ wfname) - let (n,flag)= if recover - then (state - (L.length versions ) -1 ,False) - else (state - 1 ,True) - - mr= (safeFromIDyn $ versions !! n) `asTypeOf` typeOfRef wfref - case mr `seq` mr of - Left s -> return $ Left s - Right r -> do - let s'= s{references= (n,(toIDyn r,flag)):references } - writeDBRef self s' - return . Right $ WFRef n ref - - typeOfRef :: STM(Either String (WFRef a)) -> Either String a - typeOfRef= undefined +-- mr= (safeFromIDyn $ versions !! n !> show n !> show state) `asTypeOf` typeOfRef (doit s) +-- case mr `seq` mr of +-- Left r -> return (s,Left r) +-- Right r -> do +-- let s'= s{references= (n,(toIDyn r,flag)):references } +-- atomically $ writeDBRef self s' +-- let ref = WFRef n self +-- return (s,Right ref) +-- where +-- typeOfRef :: IO (Stat,Either String (WFRef a)) -> Either String a +-- typeOfRef= undefined --getNRefs wfname= do -- st <- getResource stat0{wfName= wfname} `onNothing` error ("Workflow not found: "++ wfname) @@ -1274,7 +1277,28 @@ -- Usually @time2> time@ -- -- @time2=0@ means @time2@ is infinite -withKillTimeout :: CMC.MonadCatchIO m => String -> Int -> Integer -> m a -> m a +--withKillTimeout :: CMC.MonadCatchIO m => String -> Int -> Integer -> m a -> m a +--withKillTimeout id time time2 f = do +-- tid <- liftIO myThreadId +-- tstart <- liftIO getTimeSeconds +-- let final= liftIO $ do +-- tnow <- getTimeSeconds +-- let ref = getDBRef $ keyResource $ stat0{wfName=id} -- !> (keyResource $ stat0{wfName=id} ) +-- when (time2 /=0) . atomically $ do +-- s <- readDBRef ref `onNothing` error ( "withKillTimeout: Workflow not found: "++ id) +-- writeDBRef ref s{lastActive= tnow,timeout= Just (time2 - fromIntegral (tnow - tstart))} +-- clearRunningFlag id +-- let proc= do +-- twatchdog <- liftIO $ case time of +-- 0 -> return tid +-- _ -> forkIO $ threadDelay (time * 1000000) >> throwTo tid Timeout +-- r <- f +-- liftIO $ killThread twatchdog +-- return r +-- +-- proc `CMC.finally` final + +withKillTimeout :: CMC.MonadCatchIO m => String -> Int -> Integer -> m a -> m a withKillTimeout id time time2 f = do tid <- liftIO myThreadId twatchdog <- liftIO $ forkIO $ threadDelay (time * 1000000) >> throwTo tid Timeout @@ -1295,6 +1319,8 @@ throw Timeout -- !> "Timeout 2" _ -> throw e + + transientTimeout 0= atomically $ newTVar False transientTimeout t= do diff --git a/Workflow.cabal b/Workflow.cabal --- a/Workflow.cabal +++ b/Workflow.cabal @@ -1,5 +1,5 @@ name: Workflow -version: 0.8.0.5 +version: 0.8.0.6 cabal-version: >= 1.6 build-type: Simple license: BSD3 @@ -7,7 +7,7 @@ maintainer: agocorona@gmail.com stability: experimental bug-reports: agocorona@gmail.com -synopsis: Workflow patterns and a monad for thread state logging & recovery +synopsis: Workflow patterns over a monad for thread state logging & recovery description: Transparent support for interruptible computations. A workflow can be seen as a persistent thread that executes a monadic computation. Therefore, it can be used in very time consuming computations such are CPU intensive calculations or procedures that are most of the time waiting for the action of a process or an user, that are prone to comunication @@ -16,13 +16,15 @@ . . The computation can be restarted at the interrupted point thanks to its logged state in permanent storage. The thread state is located in files by default. It can be moved and continued in another computer. - Besides that, the package also provides other higher level services associated to workflows: Workflow patters and - and a general configuarion utility. + Besides that, the package also provides other higher level services associated to workflows: Workflow patterns, + and a general configuarion utility, workflow observation events and references to the internal state. + The state can be stored maintaining memory references (using the "RefSerialize" package), so that it is possible to track the modifications + of a big structure (for example a document) along the workflow execution. . See "Control.Workflow" for details . In this release: - * added getWFRef bug fixed + * start and startWF exception control fixed category: Control, Workflow