Workflow 0.8.0.3 → 0.8.0.4

raw patch · 3 files changed

+62/−34 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Workflow.hs +59/−31
• Control/Workflow/Stat.hs +1/−1
• Workflow.cabal +2/−2

@@ -189,8 +189,8 @@ import System.Mem.StableName import Control.Workflow.Stat ---import Debug.Trace---a !> b= trace b a+import Debug.Trace+a !> b= trace b a   type Workflow m = WF  Stat  m   -- not so scary@@ -402,23 +402,30 @@  -- | executes a workflow, but does not mark it as finished even if -- the process ended.--- The workflow will return the las result.+-- It this case, the workflow just will return the last result.+-- If the workflow was gathering data from user questions for a configuration, then this+-- primitive will store them in the log the first time, and can be retrieve it the next time. 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)+exec1nc str f  =do+    v <- getState str f ()+    case v of+      Left err -> CMC.throw err+      Right (name, f, stat) -> do+         r <- runWF1 name f  stat False+         return  r -             CMC.throw e )+        `CMC.catch`+           (\(e :: CE.SomeException) -> liftIO $ do+                 let name=  keyWF str ()+                 clearRunningFlag name  --`debug` ("exception"++ show e)+                 CMC.throw e )+        `CMC.finally`+          (liftIO . atomically .+               when(recover stat) $ do+                  let ref= self stat+                  s <- readDBRef ref `justifyM` error ("step: not found: "++ wfName stat)+                  writeDBRef ref s{recover= False,versions=L.reverse $ versions s})  mv :: MVar Int mv= unsafePerformIO $ newMVar 0@@ -741,10 +748,10 @@ -- | Re-start the non finished workflows in the list, for all the initial values that they may have been invoked restartWorkflows    :: (Serialize a, Typeable a)-   =>  WorkflowList IO a b     -- the list of workflows that implement the module+   =>  M.Map String (a -> Workflow IO b)     -- the list of workflows that implement the module    -> IO ()                    -- Only workflows in the IO monad can be restarted with restartWorkflows restartWorkflows map = do-  mw <- liftIO $ getResource ((Running undefined ) )  -- :: IO (Maybe(Stat a))+  mw <- liftIO $ getResource ((Running undefined ) )   -- :: IO (Maybe(Stat a))   case mw of     Nothing -> return ()     Just (Running all) ->  mapM_ start . mapMaybe  filter  . toList  $ all@@ -895,11 +902,8 @@   clearRunningFlag name= liftIO $ atomically $ do-  mrun <-  readDBRef tvRunningWfs-  case mrun of-   Nothing -> error $ "clearRunningFLag: non existing workflows" ++ name-   Just(Running map) -> do-   case M.lookup  name map of+  Running map <-readDBRef tvRunningWfs `onNothing` error ( "clearRunningFLag: non existing workflows" ++ name)+  case M.lookup  name map of     Just(_, Nothing) -> return (map,Nothing)     Just(v, Just th) -> do       writeDBRef tvRunningWfs . Running $ M.insert name (v, Nothing) map@@ -939,10 +943,33 @@        liftIO $ atomically $ writeDBRef self s'        r  `seq` return  (s',(ref,r)) ) -getWFRef :: Indexable a => Int -> String -> a -> WFRef b-getWFRef n s v= WFRef n $ getDBRef $ keyResource stat0{wfName= keyWF s  v}+-- | 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+--+-- 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  n1=  if recover  then n else state  - n+          mr= (safeFromIDyn $ versions  !! n1) `asTypeOf` typeOfRef wfref+     case mr `seq` mr of+       Left s -> return $ Left s+       Right r -> do+          let (n,flag)= if recover+                          then (state  - (L.length  versions ) -1  ,False)+                          else (state -1 ,True) +              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+ --getNRefs wfname= do --   st <-  getResource stat0{wfName= wfname} `onNothing` error ("Workflow not found: "++ wfname) --   return $ L.length $ references st@@ -965,15 +992,15 @@              => WFRef a              -> STM (Maybe a) readWFRef (WFRef n ref)= do-   mr <- readDBRef ref-   case mr of+   mst <- readDBRef ref+   case mst of     Nothing -> return Nothing-    Just st ->+    Just st -> do       case  L.lookup n $! references st of         Just (r,_) -> return . Just $ fromIDyn r         Nothing -> do           let  n1=  if recover st then n else state st - n-          return . Just . fromIDyn $ versions st !! n1+          return . Just . fromIDyn $ versions st !! n1 !> (show (L.length $ versions st) ++ " "++ show n1)  --      flushDBRef ref !> "readWFRef" --      st <- readDBRef ref `justifyM` (error $ "readWFRef: reference has been deleted from storaga: "++ show ref)@@ -1224,7 +1251,8 @@         threadDelay $ delay         if delta <= 0 then   return () else wait $  delta - (fromIntegral delay ) --- | Return either the result of the STM conputation or Nothing in case of timeout+-- | Return either the result of the STM conputation or Nothing in case of timeout.+-- The computation can retry -- This timeout is persistent. This means that the counter is initialized in the first call to getTimeoutFlag -- no matter if the workflow is restarted. The time during which the worlkflow has been stopped count also. -- Thus, the wait time can exceed the time between failures.@@ -1232,7 +1260,7 @@ withTimeout :: ( MonadIO m, Typeable a, Serialize a)=> Integer -> STM a -> Workflow m (Maybe a) withTimeout time  f = do
   flag <- getTimeoutFlag time
-  step . liftIO . atomically $ (f >>=  return  .  Just )
+  step . liftIO . atomically $ (f >>= return  .  Just )
                                `orElse`                                (waitUntilSTM flag  >> return  Nothing)
 

@@ -164,7 +164,7 @@  --   writeResource stat@Stat{..}-   | recover = return ()+   | recover = return ()                         -- !> "recover"     | refs <- filter (\(n,(_,written))-> not written) references,      not $ null refs= do

@@ -1,5 +1,5 @@ name: Workflow-version: 0.8.0.3+version: 0.8.0.4 cabal-version: >= 1.6 build-type: Simple license: BSD3@@ -22,7 +22,7 @@              See "Control.Workflow" for details              .              In this release:-             * timeout miscalculated in time-related primitives fixed+             * added getWFRef  category: Control, Workflow