Workflow 0.5.8.1 → 0.5.8.2
raw patch · 5 files changed
+55/−30 lines, 5 files
Files
- Control/Workflow/Binary/BinDefs.hs +11/−1
- Control/Workflow/Text/TextDefs.hs +12/−2
- Control/Workflow/Workflow.inc.hs +29/−25
- Demos/sequence.hs +0/−1
- Workflow.cabal +3/−1
Control/Workflow/Binary/BinDefs.hs view
@@ -3,6 +3,7 @@ MultiParamTypeClasses , FlexibleInstances , ScopedTypeVariables+ , TypeSynonymInstances #-} module Control.Workflow.Binary.BinDefs where import Control.Workflow.GenSerializer@@ -87,8 +88,17 @@ return . WFRef n $ getDBRef k +instance Indexable String where+ key= id++instance Indexable Int where+ key= show++instance Indexable Integer where+ key= show+ instance Indexable Stat where key s@Stat{wfName=name}= "Stat#" ++ name key (Running _)= keyRunning- defPath= const "WorkflowState/bin/"+ defPath= const $ defPath "" ++ "WorkflowState/bin/"
Control/Workflow/Text/TextDefs.hs view
@@ -3,6 +3,7 @@ MultiParamTypeClasses , FlexibleInstances , UndecidableInstances+ , TypeSynonymInstances #-}@@ -122,11 +123,20 @@ showElem es +instance Indexable String where+ key= id++instance Indexable Int where+ key= show++instance Indexable Integer where+ key= show+ statPrefix= "Stat#" instance Indexable Stat where- key s@Stat{wfName=name}= statPrefix ++ name+ key s@Stat{wfName=name}= statPrefix ++ name key (Running _)= keyRunning- defPath= const "WorkflowState/Text/"+ defPath _= (defPath "") ++ "WorkflowState/Text/" wFRefStr = "WFRef"
Control/Workflow/Workflow.inc.hs view
@@ -54,6 +54,11 @@ +instance (Monad m,Functor m) => Functor (Workflow m ) where+ fmap f (WF g)= WF (\s -> do+ (s1, x) <- g s+ return (s1, f x))+ tvRunningWfs = getDBRef $ keyRunning :: DBRef Stat @@ -332,16 +337,8 @@ -instance Indexable String where- key= id -instance Indexable Int where- key= show -instance Indexable Integer where- key= show-- instance Indexable () where key= show @@ -604,6 +601,15 @@ getWFHistory :: (Indexable a, DynSerializer w r a) => String -> a -> IO (Maybe Stat) getWFHistory wfname x= getResource stat0{wfName= keyWF wfname x} ++delWFHistory name1 x= do+ let name= keyWF name1 x+ delWFHistory1 name++delWFHistory1 name =+ atomically . withSTMResources [] $ const resources{ toDelete= [stat0{wfName= name}] }++ waitWFActive wf= do r <- threadWF wf case r of -- wait for change in the wofkflow state@@ -625,11 +631,11 @@ => String -> a -> m() killThreadWF wfname x= do let name= keyWF wfname x- killThreadWFm name >> return ()+ killThreadWF1 name -- | a version of `KillThreadWF` for workflows started wit no parameter by `exec1` killThreadWF1 :: MonadIO m => String -> m()-killThreadWF1 name= killThreadWF name ()+killThreadWF1 name= killThreadWFm name >> return () killThreadWFm name= do (map,f) <- clearRunningFlag name@@ -646,13 +652,14 @@ killWF :: (Indexable a,MonadIO m) => String -> a -> m () killWF name1 x= do let name= keyWF name1 x- map <- killThreadWFm name- liftIO . atomically . writeDBRef tvRunningWfs . Running $ M.delete name map- return ()+ killWF1 name -- | a version of `KillWF` for workflows started wit no parameter by `exec1` killWF1 :: MonadIO m => String -> m ()-killWF1 name = killWF name ()+killWF1 name = do+ map <- killThreadWFm name+ liftIO . atomically . writeDBRef tvRunningWfs . Running $ M.delete name map+ return () -- | delete the WF from the running list and delete the workflow state from persistent storage. -- Use it to perform cleanup if the process has been killed.@@ -660,25 +667,22 @@ , MonadIO m , Typeable a) => String -> a -> m()-delWF name1 x= liftIO $ do+delWF name1 x= do let name= keyWF name1 x+ delWF1 name+++-- | a version of `delWF` for workflows started wit no parameter by `exec1`+delWF1 :: MonadIO m=> String -> m()+delWF1 name= liftIO $ do mrun <- atomically $ readDBRef tvRunningWfs case mrun of Nothing -> return() Just (Running map) -> do atomically . writeDBRef tvRunningWfs . Running $! M.delete name map delWFHistory1 name--delWFHistory name1 x= do- let name= keyWF name1 x- delWFHistory1 name--delWFHistory1 name =- atomically . withSTMResources [] $ const resources{ toDelete= [stat0{wfName= name}] }+ syncIt --- | a version of `delWF` for workflows started wit no parameter by `exec1`-delWF1 :: MonadIO m=> String -> m()-delWF1 name= delWF name () clearRunningFlag name= liftIO $ atomically $ do
Demos/sequence.hs view
@@ -13,4 +13,3 @@ return () -- to specify the return type main= exec1 "count" $ mcount (0 :: Int)-
Workflow.cabal view
@@ -1,5 +1,5 @@ name: Workflow-version: 0.5.8.1+version: 0.5.8.2 build-type: Simple license: BSD3@@ -34,6 +34,8 @@ Besides that, the package also provides other services associated to workflows . New in this release,+ .+ * 0.5.8.2 minor changes for the MFlow package . * 0.5.8.1 solved a bug that caused a "casting failure" .