Workflow 0.5.8.0 → 0.5.8.1

raw patch · 7 files changed

+60/−27 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Workflow/Binary/BinDefs.hs +1/−1
• Control/Workflow/IDynamic.hs +0/−2
• Control/Workflow/Text.hs +7/−4
• Control/Workflow/Text/TextDefs.hs +1/−1
• Control/Workflow/Workflow.inc.hs +43/−15
• Demos/sequence.hs +1/−1
• Workflow.cabal +7/−3

@@ -76,7 +76,7 @@   get = get >>= \(_ :: String) -> return $ unsafePerformIO .  forkIO $ return ()  -instance Binary a => Binary (WFRef a) where+instance Binary (WFRef a) where   put (WFRef n ref)= do      put n      put $ keyObjDBRef ref

@@ -35,9 +35,7 @@ import Data.Map as M(empty) import Control.Workflow.GenSerializer import Data.HashTable as HT---import Debug.Trace ---a !> b = trace b a   

@@ -1,5 +1,4 @@-{-# LANGUAGE-              OverlappingInstances+{-# LANGUAGE  OverlappingInstances             , UndecidableInstances             , ExistentialQuantification             , ScopedTypeVariables@@ -59,16 +58,15 @@ , WorkflowList , PMonadTrans (..) , MonadCatchIO (..)- , throw , Indexable(..)-, MonadIO(..) -- * Start/restart workflows , start , exec , exec1d , exec1 , wfExec+, startWF , restartWorkflows , WFErrors(..) -- * Lifting to the Workflow monad@@ -83,6 +81,7 @@ , readWFRef , writeWFRef -- * Workflow inspect+, waitWFActive , getAll , safeFromIDyn , getWFKeys@@ -95,12 +94,15 @@ -- * Trace logging , logWF -- * Termination of workflows+, clearRunningFlag , killThreadWF , killWF , delWF , killThreadWF1 , killWF1 , delWF1+, delWFHistory+, delWFHistory1 -- * Log writing policy , syncWrite , SyncMode(..)@@ -112,4 +114,5 @@ import Control.Workflow.Text.TextDefs  #include "Workflow.inc.hs"+ 

@@ -20,6 +20,7 @@ import Control.Concurrent import Data.TCache + instance Serialize a => Serializer ST ST a where   serial     = showp   deserial   = readp@@ -34,7 +35,6 @@   instance Serialize IDynamic where-     showp (IDyn t)=     case unsafePerformIO $ readIORef t of

@@ -34,12 +34,12 @@ import Control.Workflow.IDynamic import Unsafe.Coerce import Control.Workflow.Stat-+-- --import Debug.Trace --a !> b= trace b a  -type Workflow m l= WF  Stat  m l  -- not so scary+type Workflow m = WF  Stat  m   -- not so scary  type WorkflowList m a b= [(String,  a -> Workflow m  b) ] @@ -380,7 +380,7 @@             let sref = getDBRef $ key s''             s'<- liftIO . atomically $ do               s <- if isControl-                     then readDBRef  sref  >>= justify ("step: readDBRef: not found:" ++ keyObjDBRef sref)+                     then readDBRef  sref  >>= unjustify ("step: readDBRef: not found:" ++ keyObjDBRef sref)                      else return s''               let versionss= versions s               let dynx=  toIDyn x'@@ -392,8 +392,8 @@             liftIO syncIt             return (s', x') ) -justify str Nothing = error str-justify _ (Just x) = return x+unjustify str Nothing = error str+unjustify _ (Just x) = return x   @@ -402,14 +402,13 @@ -- | the programmer has to handle inconsistencies in the workflow state -- | using `killWF` or `delWF` in case of exception. start-    :: (Monad m+    :: ( Monad m        , MonadIO m        , Indexable a        , TwoSerializer w r a b        , Typeable a-       , Indexable b        , Typeable b)-    => String                       -- ^ name thar identifies the workflow.+    => 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)     -> m  (Either WFErrors b)        -- ^ result of the computation@@ -417,8 +416,7 @@       ei <- getState  namewf f1 v       case ei of           Right (name, f, stat) ->-            --to reify the first Dynamic obhect-            runWF name (f  . fromIDyn . Prelude.head $ versions stat) stat  >>= return  .  Right+            runWF name (f  v) stat  >>= return  .  Right            Left error -> return $  Left  error @@ -456,7 +454,7 @@                getStateSTM        Just(Running map) ->  do          let key= keyWF namewf  v-         let stat1= stat0{wfName= key , versions= [toIDyn v]}+         let stat1= stat0{wfName= key,versions=[toIDyn v]}          case M.lookup key map of            Nothing -> do                        -- no workflow started for this object              mythread <- unsafeIOToSTM $ myThreadId@@ -484,7 +482,7 @@ runWF :: (Monad m,MonadIO m          , DynSerializer w r b, Typeable b)          =>  String ->  Workflow m b -> Stat  -> m  b-runWF n f  s= do+runWF n f s= do    sync <- liftIO $!  do           (sync,_) <-  atomically $ readTVar  tvSyncWrite           when (sync ==Synchronous)  syncCache@@ -501,6 +499,21 @@       Just(Running map) <-  readDBRef tvRunningWfs       writeDBRef tvRunningWfs . Running $ M.delete   n   map -- `debug` "clearFromRunningList" +-- | start or continue a workflow  from a list of workflows in the IO monad with exception handling. The excepton is returned as a Left value+startWF+    ::  ( MonadIO m+        , TwoSerializer w r a b+        , Typeable a+        , Indexable a+        , Typeable b)+    =>  String                        -- ^ name of workflow in the workflow list+    -> a                             -- ^ initial value (ever use the initial value even to restart the workflow)+    -> WorkflowList m  a b              -- ^ function to execute+    -> m (Either WFErrors b)        -- ^  result of the computation+startWF namewf v wfs=+   case Prelude.lookup namewf wfs of+     Nothing -> return $ Left NotFound+     Just f -> start namewf f v  -- | re-start the non finished workflows in the list, for all the initial values that they may have been called restartWorkflows@@ -591,6 +604,15 @@ getWFHistory :: (Indexable a, DynSerializer w r a) => String -> a -> IO (Maybe Stat) getWFHistory wfname x=  getResource stat0{wfName=  keyWF wfname  x} +waitWFActive wf= do+      r <- threadWF wf+      case r of        -- wait for change in the wofkflow state+            Just (_, Nothing) -> retry+            _ -> return ()+      where+      threadWF wf= do+               Just(Running map) <-  readDBRef tvRunningWfs
+               return $ M.lookup wf map
   -- | kill the executing thread if not killed, but not its state.@@ -645,6 +667,13 @@     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}] }  -- | a version of `delWF` for workflows started wit no parameter by `exec1`@@ -665,8 +694,8 @@     Nothing  ->       return (map, Nothing) --- | Return the the workflow reference to the last logged result , usually, the last result stored by `step`.--- wiorkflow references can be can be accessed (to its content) outside of the workflow+-- | Return the reference to the last logged result , usually, the last result stored by `step`.+-- wiorkflow references can be accessed outside of the workflow -- . They also can be (de)serialized. -- -- WARNING getWFRef can produce  casting errors  when the type demanded@@ -894,5 +923,4 @@                   | otherwise  = fromIntegral $  delta         threadDelay $ delay  * 1000000         if delta <= 0 then   return () else wait $  delta - (fromIntegral delay )- 

@@ -1,6 +1,6 @@  module Main where-import Control.Workflow.Binary+import Control.Workflow.Text import Control.Concurrent(threadDelay) import System.IO (hFlush,stdout) 

@@ -1,5 +1,5 @@ name: Workflow-version: 0.5.8.0+version: 0.5.8.1  build-type: Simple license: BSD3@@ -35,8 +35,12 @@              .              New in this release,                   .-                  * registerType is no longer needed+                  * 0.5.8.1 solved a bug that caused a "casting failure"                   .+                  * 0.5.8:+                  .+                  *registerType is no longer needed+                  .                   * Configurable state persistence (for example, in databases) . Default in files                   .                   * Added Data.Binary  serialization (Use `Control.Workflow.Binary`) besides Text serialization  (`Control.Wokflow.Text`)@@ -53,7 +57,7 @@                  .                  * Persisten communications facilities trough persistent data objects, inspection of workflow states ,  persistent  queues, persistent timeouts and, new in this release, References to internal workflow objects WFRef's                  .-                 * workflow management and monitoriing, view workflow history and intermediate results.+                 * workflow management and monitoring, view workflow history and intermediate results.