packages feed

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 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"                   .