diff --git a/Control/Workflow.hs b/Control/Workflow.hs --- a/Control/Workflow.hs +++ b/Control/Workflow.hs @@ -1,383 +1,779 @@ -{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances -fallow-undecidable-instances -O2 #-} -{-transparent low level support (state logging, resume of the computation state, wait for data condition) for very long time - computations. Workflow give the two first services to any monadic computation of type (a-> m a) - - f x >>=\x'-> g x' >>= \x''->... z by - - prefixing the user with the method step: - - step f x >>= \x'-> step g x' >>= \x''->... - -in this way, a workflow can be described with the familiar "do" notation. In principle, there is no other limitation -on the syntax but the restriction (a -> m a): All computations consume and produce the same type of data. - -Alberto Gomez Corona agocorona@gmail.com 2008 --} -module Control.Workflow ( - Workflow -- a useful type name - ,WorkflowStep - ,WorkflowList - ,Stat +{-# OPTIONS -fglasgow-exts -XOverlappingInstances -XUndecidableInstances -O2 #-} +----------------------------------------------------------------------------- +-- +-- Module : Control.Workflow +-- Copyright : Alberto Gómez Corona +-- License : see LICENSE +-- +-- Maintainer : agocorona@gmail.com +-- Stability : experimental - ,step -- :: (Monad m) => (a -> m a) -> ( a -> Workflow m a) - -- encapsulates a monadic computation into state monad that brings persistence and - -- recovery services - ,startWF -- :: (Monad m) => - -- String -> mame of workflow in the workflowlist - -- a -> initial data value - -- WorkflowList m a -> assoc-list of (workflow name string,Workflow methods) - -- m a resulting value - -- start or continue a workflow - +{- | +Transparent support for interruptable computations. A workflow can be seen as a persistent thread. +The main features are: - , restartWorkflows -- :: (IResource a, Serialize a) => WorkflowList IO a -> IO () - -- re-start the non finished workflows. needs the assoclist. - + * Transparent state logging trough a monad transformer: step :: m a -> Workflow m a. - , getStep -- Monad m => Int -> Workflow m a return the n-tn intermediate result - -- if Int < 0 count from the current result back + * Resume the computation state after an accidental o planned program shutdown (restartWorkflows). - , getAll -- :: Monad m => Workfow m [a] return all the intermediate results + *Event handling (waithFor, waitForData). - , unsafeIOtoWF -- executes a IO operation. this is executed whenever re-started, no matter where is the resume point - -- This is useful for external IO re-initializations not controllable by the State monad. + * Monitoring of workflows with state change display and other auxiliary features. + * Communications with other processes including other workflows trough persistent data objects, + inspecttion of intermediate workflow results , Queues so that no data is lost due to shutdowns - , waitFor -- ::(IResource a, Serialize a) => (a ->Bool) -> a -> IO a - -- wait until a object (with a certaing key=keyResource x) meet a certain condition - -- (useful for checking external actions, possibly by other workflows or by direct use of TCache primitives ) - , waitUntil -- :: Integer -> IO() - -- wait until the absolute time in seconds is reached (as returned by getClockTime) - , syncWrite -- syncWrite:: Monad m => - -- Bool -> True means that changes are inmediately saved after each step - -- Int -> number of seconds between saves when async - -- Int -> max size of the cache when async - -- WF m (Stat a) () in the workflow monad - - -- Turn on and off syncronized writing to disk - -- select async mode only - -- -for very fast workflow steps or - -- -when the cache policies are dictated outside of the workflow - -- trough SyncCacheProc (see TCache module) - -) +In this way, a very long computation that may take more time than the average time between +hardware or software failures, shutdowns etc. The workflow can be defined transparently in a single monadic procedure. +Besides state logging and recovery, there are a number of communication primitives that are aware +of persistence across reinitiations such are persistent queues, persistent timeouts, or wait for events + in the STM monad. These primitives permits inter-woikflow communications and communications with + external threads. + This package uses TCache for persistence and event handling. + It also uses the package Refserialize. This package permits to reduce the workflow state load, + since the RefSerialize package permits to serialize and deserialize complex and autoreferenced data structures without + loosing such references, this is critical when big and structured data, such are documents, suffer little + modifications across a set of workflow steps. Therefore, it is also recommended to use Refserialize for + big user-defined objects that have small pieces that suffer little modifications during the workflow. As an + added bonus, the history will show such changes with more detail. + +The 'step' primitive is the lift operation that converts a result of type @m a@ to a type @'Workflow' m a@ +with automatic state loggin and recovery. To allow such features, Every @a@ must be instance of +'Typeable' and 'IResource' (defined in the @TCache@ package). + +In fact, Workflow can be considered as an instance of a partial monad transformed. defined as such: + + @class 'PMonadTrans' t m a where + + 'plift' :: Monad m => m a -> t m a + + + + instance (Monad m,MonadIO m, IResource a, Typeable a) + + => PMonadTrans (WF Stat) m a where + + 'plift' = 'step' + @ + + +It is partial because the lift operation is not defined for every monad @m@ and data type @a@ , but for monads and data +types that meet certain conditions. In this case, to be instances of @MonadIO@, @IResource@ and @Typeable@ respectively. + +to avoid to define the last two interfaces however, 'Read' and 'Show'' can be used to derive instances of 'IResource' + for most of the useful cases. This is the set of automatic derivations: + + + @(Read a, Show a) => 'Serialize' a + + Typeable a => 'Indexable' a (a single key for all values. enough for workflows) + + ('Indexable' a, 'Serialize' a) => IResource a@ + + +Therefore deriving to be instance of @Read, Show@ is enough for every intermediate data result along the computation + +Because 'Data.TCache.Dynamic' from the package 'TCache' is used for persistence, every data type must be registered +by using 'registerType' + +Here is a compkete example: This is a counter that shows a sequence of numbers, one a second: + +@module Main where +import Control.Concurrent(threadDelay) +import System.IO (hFlush,stdout) + + count n= do + putStr (show n ++ " ") >> hFlush stdout >> threadDelay 1000000 + count (n+1) + + main= count 0@ + +This is the same program, with the added feature of remembering the last count after interrupted: + + +@module Main where +import Control.Workflow +import Control.Concurrent(threadDelay) +import System.IO (hFlush,stdout) + + +mcount n= do + 'step' $ putStr (show n ++ " ") >> hFlush stdout >> threadDelay 1000000 + mcount (n+1) + + + +main= do + registerType :: IO () + registerType :: IO Int + let start= 0 :: Int + startWF "count" start [("count", mcount)] :: IO ()@ + +This is the execution log: + +@Worflow-0.5.5\demos>runghc sequence.hs +0 1 2 3 4 5 6 7 sequence.hs: win32ConsoleHandler +sequence.hs: sequence.hs: interrupted +Worflow-0.5.5\demos> +Worflow-0.5.5\demos>runghc sequence.hs +7 8 9 10 11 ....@ + +-} +----------------------------------------------------------------------------- + + + +module Control.Workflow + ( Workflow -- a useful type name + , WorkflowList + , IResource(..) + , registerType + , PMonadTrans (..) + , Indexable (key) + , step + , startWF + , restartWorkflows + , getStep + , getAll + , logWF + , getWFKeys + , getWFHistory -- return the list of steps results + , delWFHistory -- delete the workflow history + , printHistory -- print the history + , unsafeIOtoWF + , waitFor + , waitUntil + , waitUntilSTM + , syncWrite + , writeQueue + , writeQueueSTM + , readQueue + , readQueueSTM + , unreadQueue + , unreadQueueSTM + , getTimeSeconds + , getTimeoutFlag + , isEmptyQueue + , isEmptyQueueSTM +) where import System.IO.Unsafe import Control.Monad(when,liftM) -import Unsafe.Coerce -import Control.Concurrent (forkIO,threadDelay) -import Control.Concurrent.STM(atomically, retry, readTVar) -import Debug.Trace - +import Control.Exception(Exception, throw) +import Control.Concurrent (forkIO,threadDelay, ThreadId) +import Control.Concurrent.STM +import GHC.Conc(unsafeIOToSTM) +import GHC.Base (maxInt) import Data.TCache.Dynamic import Data.RefSerialize -import Data.List((\\),find,elemIndices) +import Data.List((\\),find,elemIndices, isPrefixOf) import Data.Typeable import System.Time +import Control.Monad.Trans +import Control.Monad (replicateM) +import System.IO(hPutStrLn, stderr) +import Data.List(elemIndex) +import Data.Maybe(fromJust, isNothing) +import qualified Data.Map as M(Map,fromList,elems, insert, lookup) + +import System.Mem.StableName + +{- + +import Debug.Trace debug a b = trace b a -data WF m s l = WF { st :: s -> m (s,l) } +report :: Exception e => IO a -> String -> e -> IO a +report f text e= catch f (\e -> throw $ userError (text++": "++ show e)) -type Workflow m l= WF m (Stat l) l -- not so scary +freport text f = report f text +-} -type WorkflowStep m a= ( a -> Workflow m a) +data WF s m l = WF { st :: s -> m (s,l) } -type WorkflowList m a = [(String, WorkflowStep m a)] +type Workflow m l= WF Stat m l -- not so scary -data Stat a= Workflows [(String,String)] - |Stat{ wfName :: String, state:: Int, index :: Int, recover:: Bool, sync :: Bool , versions :: [a]} - +type WorkflowList m a b= [(String, a -> Workflow m b) ] + + + +data Stat = RunningWorkflows [String] + + | Stat{ wfName :: String, state:: Int, index :: Int, recover:: Bool, sync :: Bool + , versions ::[IDynamic], timeout :: Maybe (TVar Bool)} deriving (Typeable) -stat0 = Stat{ wfName="", state=0, index=0, recover=False, versions =[], sync= True} +stat0 = Stat{ wfName="", state=0, index=0, recover=False, versions = [] + , sync= True, timeout= Nothing} +hasht x= (hashStableName . unsafePerformIO . makeStableName) x -- serialization of data is done trough RefSerialize because it permits to store -- different versions of the same object with minumum memory. -instance Serialize a => Serialize (Stat a) where - showp (Workflows list)= do + +instance Serialize IDynamic where + showp= tshowp + readp = treadp + +instance Serialize Stat where + showp (RunningWorkflows list)= do str <- showp list return $ "StatWorkflows "++ str - - showp (Stat wfName state index recover sync versions )= do - parsea <- rshowp versions - return $ "Stat "++ show wfName ++" "++ show state++" "++show index++" "++show recover++" "++ show sync ++ parsea - + + showp (Stat wfName state index recover sync versions _)= do + parsea <- rshowp versions + return $ "Stat "++ show wfName ++" "++ show state++" "++show index++" "++show recover++" " + ++ show sync ++ parsea + readp = choice [rStat, rWorkflows] where rStat= do - symbol "Stat" - wfName <- stringLiteral - state <- integer - index <- integer - recover <- bool - sync <- bool - versions<- rreadp - return $ Stat wfName (fromIntegral state) (fromIntegral index) recover sync versions - + symbol "Stat" + wfName <- readp -- stringLiteral + state <- readp -- integer + index <- readp --integer + recover <- readp --bool + sync <- readp --bool + versions <- rreadp + return $ Stat wfName state index recover sync versions Nothing + + + rWorkflows= do symbol "StatWorkflows" list <- readp - return $ Workflows list - ---persistence trough TCache , default persistence in files - -instance (IResource a, Serialize a,Typeable a)=> IResource (Stat a) where - keyResource Stat{wfName=name, versions = []}= prefix ++name - keyResource Stat{wfName=name, versions = (a:_)}= prefix ++name++"#"++keyResource a + return $ RunningWorkflows list - keyResource w@(Workflows xs)= "StatWorkflows" - - defPath x= "Workflows/" ++ show (typeOf x)++"/" -- directory for Workflow data +--persistence trough TCache , default persistence in files +workflowsPath= "Workflows/" +instance IResource Stat where + keyResource s@Stat{wfName=name}= "Stat#" ++ name + keyResource (RunningWorkflows _)= "RunningWorkflows" + + defPath _= workflowsPath -- directory for Workflow data + serialize x= runW $ showp x deserialize str = runR readp str -prefix= "Stat#" -lengthPrefix= length prefix +{- | Indexablle can be used to derive instances of IResource + This is the set of automatic derivations: -insertDResources xs= withDResources [] (\_-> xs) + *(Read a, Show a) => Serialize a ---unsafeIOtoWF :: Monad m => IO a -> WF m (Stat b) a -unsafeIOtoWF x= let y= unsafePerformIO x in y `seq` return y + *Typeable a => Indexable a (a single key for all values. enough for workflows) -instance Monad m => Monad (WF m s) where - return x = WF (\s -> return (s, x)) - WF g >>= f = WF (\s ->do - (s1, x) <- g s - - let WF fun= f x - (s3, x') <- fun s1 - + *(Indexable a, Serialize a) => IResource a +-} +class Indexable a where + key:: a -> String + +instance Typeable a => Indexable a where + key x= show $ typeOf x + +instance (Serialize a, Indexable a) => IResource a where + keyResource x=key x + tshowp= showp + treadp= readp + + +-- | executes a IO computation inside of the workflow monad whatever the monad encapsulated in the workflow. +-- Warning: this computation is executed whenever +-- the workflow restarts, no matter if it has been already executed previously. This is useful for intializations or debugging. +-- To avoid re-execution when restarting use: @'step' $ unsafeIOtoWF...@ +-- +-- To perform IO actions in a workflow that encapsulates an IO monad, use step over the IO action directly: +-- +-- @ 'step' $ action @ +-- +-- instead of +-- +-- @ 'step' $ unsafeIOtoWF $ action @ +unsafeIOtoWF :: (Monad m) => IO a -> Workflow m a +unsafeIOtoWF x= let y= unsafePerformIO ( x >>= return) in y `seq` return y + + +{- | PMonadTrans permits |to define a partial monad transformer. They are not defined for all kinds of data +but the ones that have instances of certain classes.That is because in the lift instance code there are some +hidden use of these classes. This also may permit an accurate control of effects. +An instance of MonadTrans is an instance of PMonadTrans +-} +class PMonadTrans t m a where + plift :: Monad m => m a -> t m a + + + +-- | plift= step +instance (Monad m,MonadIO m,IResource a, Typeable a) => PMonadTrans (WF Stat) m a where + plift = step + +-- | An instance of MonadTrans is an instance of PMonadTrans +instance (MonadTrans t, Monad m) => PMonadTrans t m a where + plift= Control.Monad.Trans.lift + +instance Monad m => MonadIO (WF Stat m) where + liftIO=unsafeIOtoWF + +instance Monad m => Monad (WF s m) where + return x = WF (\s -> return (s, x)) + WF g >>= f = WF (\s -> do + (s1, x) <- g s + + let WF fun= f x + (s3, x') <- fun s1 + return (s3, x')) - -class (IResource a, Serialize a,Typeable a) => Workflow_ a where - -- | step lift a monadic computation (a -> m a) in in to the WF monad, provides state loging and automatic resume - step :: (Monad m) => (a -> m a) -> ( a -> Workflow m a) - step f = \x -> WF(\s -> do + +--class (IResource a, Serialize a,Typeable a) => Workflow_ a where +-- | step lifts a monadic computation to the WF monad, and provides transparent state loging and resume of computation +step :: (Monad m,MonadIO m,IResource a, Typeable a) => m a -> Workflow m a +step mx= WF(\s -> do let stat= state s let ind= index s if recover s && ind < stat - then return (s{index=ind +1 }, versions s !! (stat - ind-1) ) + then return (s{index=ind +1 }, fromIDyn $ versions s !! (stat - ind-1) ) else do - x'<- f x - let s'= s{recover= False, versions = x': versions s, state= state s+1} - unsafeIOtoWF $ do + x' <- mx - let - doit1 xs - | keyResource s /= keyResource s' -- `debug` ("keys:"++keyResource s ++", "++keyResource s') - = - let newlist= newpair :(xs \\[oldpair]) - newpair= (keyResource s',original) - oldpair= (key,original) - key= keyResource s - original= case lookup key xs of - Nothing -> error $ "workflow stat not found: " ++key - Just old -> old - - in [Insert $ toIDyn $ (Workflows newlist :: Stat a) - ,Delete $ toIDyn s, Insert $ toIDyn s' - ,Insert (toIDyn x')] - -- `debug`("insert "++keyResource s'++","++keyResource x'++" delete: "++ - -- keyResource s++","++keyResource x) - | otherwise= [Insert $ toIDyn s', Insert $ toIDyn x'] - -- `debug`("insert "++keyResource s'++","++keyResource x') - let - doit [Nothing] = doit1 [] - doit [Just d] = let Workflows xs= (fromIDyn d :: Stat a) - in doit1 xs + let versionss= versions s + let ver= toIDyn x': versionss + let s'= s{recover= False, versions = ver, state= state s+1} - withDResourcesID [toIDyn $ (Workflows undefined :: Stat a)] doit - - when (sync s) $ unsafeIOtoWF $ syncCache - + liftIO $ do + + withResources ([]::[Stat]) (\_-> [s' ]) --`debug` "update cache" + + when (sync s ) syncCache + return (s', x') ) - - -- | start or continue a workflow. WorkflowList is a assoclist of (name, workflow computation) - startWF :: (Monad m) => String -> a -> WorkflowList m a ->m a - startWF name v wfs= do - unsafeIOtoWF (registerType :: IO (Control.Workflow.Stat a)) - case lookup name wfs of - Nothing -> error $ "MonadWF.startWF: workflow not found: "++name; - Just f -> do - let stat1= stat0{index=0,wfName= name,versions=[v]} ::Stat a - let key= keyResource stat1 - (vn, stat, found) <- do - wxs <- unsafeIOtoWF $ getResource $ (Workflows undefined :: Stat a) - case wxs of - Nothing -> return (v,stat1, False) - Just (Workflows xs) -> - case find (\(_,s)-> s == key) xs of - - Just (key1, oldkey1) -> do - -- already in course - mst <- unsafeIOtoWF $ getResource stat0{wfName= drop lengthPrefix key1} - case mst of - Nothing -> error $ "no stat for key. " ++ key - Just s@Stat{versions=(a:_)} -> return (a,s{index=0,recover=True}, True) -- the last value - Nothing -> return (v, stat1, False) - -- insert it in the running workflow list - when (found == False) $ - let addWF [Nothing] = [Workflows [(key,key)],stat] - addWF [Just (Workflows xs)]= [Workflows ((key,key):xs),stat] - - in unsafeIOtoWF $ withResources [(Workflows undefined :: Stat a)] addWF - - runWF name f vn stat -- `debug` (serialize stat) - +-- | start or continue a workflow. +startWF + :: (Monad m,MonadIO m,IResource a, Typeable a, IResource b, Typeable b) + => String -- ^ name of workflow in the workflow list + -> a -- ^ initial value (even use the initial value even to restart the workflow) + -> WorkflowList m a b -- ^ workflow list. t is an assoc-list of (workflow name string,Workflow methods) + -> m b -- ^ result of the computation - restartWorkflows :: (IResource a, Serialize a) => WorkflowList IO a -> IO () - restartWorkflows map = do - unsafeIOtoWF (registerType :: IO (Control.Workflow.Stat a)) - mw <- getResource ((Workflows undefined ) :: Stat a) +startWF namewf v wfs= do + liftIO (registerType :: IO Stat) + liftIO (registerType :: IO Control.Workflow.Queue) + liftIO (registerType :: IO String) + liftIO (registerType :: IO Integer) + + + case lookup namewf wfs of + Nothing -> error $ "startWF: workflow name not found in workflow list: "++namewf; + Just f -> do + let name= namewf ++ "#" ++ keyResource v + let stat1= stat0{wfName= name , versions= [toIDyn v]} + mst <- liftIO $ getResource stat1 + + let (vn, stat,create)= case mst of + Nothing -> (v, stat1, True) + Just s-> (v,s{index=0,recover=True},False) -- the last value + + + + let + addwf [wf ] = resources{ toAdd=[ toIDyn $ RunningWorkflows (name:xs) ] + ++ [ toIDyn stat]} + where xs= case wf of Nothing -> []; Just dyn -> xs where RunningWorkflows xs = fromIDyn dyn + + when create $ liftIO . atomically $ withDSTMResources [toIDyn $ RunningWorkflows undefined ] addwf + + runWF name f vn stat -- `debug` (serialize stat) + + + +runWF :: (Monad m,MonadIO m,IResource a,Typeable a, IResource b, Typeable b) + => String -> ( a -> Workflow m b) -> a -> Stat -> m b +runWF name f v s=do + when (sync s) $ liftIO $ syncCache + (s', v') <- st (f v) $ s --`debug` "runWF********" + + let delWF Nothing = error $ "runWF: Workflow list not found: " + delWF (Just (RunningWorkflows xs ))= + let name= name++ "#" ++ keyResource v + in case elem name xs of + False -> error $"runWF: not found state for workflow: "++ name + True -> RunningWorkflows (xs \\ [name]) + + liftIO $ withResource (RunningWorkflows undefined) delWF + when (sync s) $ liftIO $ syncCache + return v' + + +-- | re-start the non finished workflows started for all initial values that are listed in the workflow list +restartWorkflows + ::(IResource a, Typeable a, IResource b, Typeable b) + => WorkflowList IO a b -- the list of workflows that implement the module + -> IO () -- Only workflows in the IO monad can be restarted with restartWorkflows +restartWorkflows map = do + liftIO (registerType :: IO Stat) + liftIO (registerType :: IO Control.Workflow.Queue) + liftIO (registerType :: IO String) + liftIO (registerType :: IO Integer) + + mw <- liftIO $ getResource ((RunningWorkflows undefined ) ) -- :: IO (Maybe(Stat a)) case mw of Nothing -> return () - Just (Workflows all) -> mapM_ start all + Just (RunningWorkflows all) -> mapM_ start all where - start :: (String, String) -> IO () - start (key,_)= do - let name= let [init,end]= elemIndices '#' key - - rest= drop (init + 1) key - in take (end-init -1) rest - case lookup name map of - Just f -> do - let st0= Key $ (defPath (stat0 :: Stat a))++key - mst <- getDResource $ IDynamic st0 - case mst of - Nothing -> error $ "getResource: not found "++ keyResource st0 - Just (idyn) -> do - let st = fromIDyn idyn :: Stat a - forkIO $ runWF key f (head $ versions st) st >> return () - return () - Nothing -> error $ "workflow not found: "++ name - - - runWF :: (Monad m,IResource a, Serialize a) => String ->( a -> Workflow m a) -> a -> (Stat a) -> m a - runWF name f v s=do - - (s', v') <- st (f v) $ s - - let key= keyResource s' - - let delWF [Nothing] = error $ " Workflow list not found: " - delWF [Just d]= let Workflows xs= (fromIDyn d :: Stat a) in - case lookup key xs of - Nothing -> error $"runWF not found state for key: "++ key - Just oldkey -> - (map (Delete . toIDyn) $ versions s') ++ -- delete all intermediate objects generated - [Insert . toIDyn $ (Workflows (xs \\ [(key,oldkey)]) ::Stat a) - ,Delete $ toIDyn s'] + start key1= do - - unsafeIOtoWF $ withDResourcesID [toIDyn $ (Workflows undefined :: Stat a)] delWF - when (sync s) $ unsafeIOtoWF $ syncCache - return v' + let key= case elemIndex '#' key1 of + Just n -> take n key1 + Nothing -> key1 - -- switch on and off syncronous write for each step (default is syncronous) - -- for very fast steps, asyncronous is better.h - -- when TCache is used for other purposes, is better to define the cache policy direct - syncWrite:: (Monad m , IResource a)=> Bool -> Int -> Int -> WF m (Stat a) () - syncWrite bool time maxsize= WF(\s ->do + let mf= lookup key map + if isNothing mf then return () + else do + let f= fromJust mf + let st0= stat0{wfName = key1} + mst <- liftIO $ getResource st0 + case mst of + Nothing -> error $ "restartWorkflows: not found "++ keyResource st0 + Just st-> do + liftIO . forkIO $ runWF key f (fromIDyn . last $ versions st ) st{index=0,recover=True} >> return () + return () + + +-- | change the logging policy (default is syncronous) +-- Workflow uses the package TCache for logging +-- for very fast workflow steps or when TCache is used also for other purposes , asyncronous is a better option +syncWrite:: (Monad m, MonadIO m) + => Bool -- ^True means syncronoys: changes are inmediately saved after each step + -> Int -- ^ number of seconds between saves when asyncronous + -> Int -- ^ size of the cache when async + -> WF Stat m () -- ^ in the workflow monad +syncWrite bool time maxsize= WF(\s -> do when (bool== False) $ do - unsafeIOtoWF $ clearSyncCacheProc time defaultCheck maxsize + liftIO $ clearSyncCacheProc time defaultCheck maxsize return () return (s{ sync= bool},())) -instance (IResource a,Serialize a,Typeable a) => Workflow_ a - --- return the result of the previous step -getStep :: Monad m => Int -> Workflow m a -getStep i= WF(\s ->do - let stat= state s - return (s, if i > 0 && i <= stat then versions s !! (stat - i) - else if i < 0 && i >= -stat then versions s !! (stat +i) +getStep + :: (IResource a, Typeable a, Monad m) + => Int -- ^ the step number. If negative, count from the current state backwards + -> Workflow m a -- ^ return the n-tn intermediate step result +getStep i= WF(\s -> do + let stat= state s + return (s, if i > 0 && i <= stat then fromIDyn $ versions s !! (stat - i) + else if i < 0 && i >= -stat then fromIDyn $ versions s !! (stat +i) else error "getStep: wrong index") ) - --- get all the step results -getAll :: Monad m => WF m (Stat a) [a] -getAll = WF(\s ->return (s, take (state s) $ versions s)) -{- +-- | return all the intermediate results. it is supposed that all the intermediate result have +-- the same type. +getAll :: (IResource a, Typeable a, Monad m) => WF Stat m [a] +getAll = WF(\s -> return (s, map fromIDyn . take (state s+1) $ versions s)) -exec :: (Monad m) => WF m s a -> s -> m a -exec (WF f) s = do (s', x) <- f s - return x +-- | log a message in the workflow history. I can be printed out with 'printWFhistory' +logWF :: (Monad m, MonadIO m) => String -> Workflow m () +logWF str= WF (\s -> do + time <- liftIO $ getClockTime >>= toCalendarTime >>= return . calendarTimeToString + let str2 = time ++ ": "++ str + let (state1, index1, versions1)= + let stat= state s ; ind= index s in + if recover s && ind < stat + then (stat,ind +1, versions s) + else (stat +1, ind, toIDyn str2 : versions s) + return (s{versions= versions1, state= state1, index= index1}, ()) ) -run :: (Monad m,Monad (WF m s)) => (a -> WF m s a) -> s -> a -> m a -run f s a= exec (f a) s + +-- | return the list of object keys that are running +getWFKeys :: String -> IO [String] +getWFKeys wfname= do + mwfs <- getResource $ RunningWorkflows undefined + case mwfs of + Nothing -> return [] + Just (RunningWorkflows wfs) -> return $ map (tail . dropWhile (/= '#')) $ filter (isPrefixOf wfname) wfs + +-- | return the current state of the computation, in the IO monad +getWFHistory :: (IResource a) => String -> a -> IO (Maybe Stat) +getWFHistory wfname x= getResource stat0{wfName= wfname ++ "#" ++ keyResource x} + +-- | delete the workflow. Make sure that the workdlow is not running +delWFHistory :: IResource a => String -> a -> IO () +delWFHistory wfname1 x=do + let wfname= wfname1 ++ "#" ++ keyResource x + let + doit [Just (RunningWorkflows wfs)] = + resources{ toAdd = [RunningWorkflows (wfs \\ [wfname])] + , toDelete= [stat0{wfName= wfname}] } + doit _ = error "delWFHistory: list of running workflows not found" + atomically $ withSTMResources[RunningWorkflows undefined] doit + syncCache + + +-- | print the state changes along the workflow, that is, all the intermediate results +printHistory :: Stat -> IO () +printHistory stat= do + putStrLn . runW $ showp $ Pretty stat + putStrLn "-----------------------------------" + + {- + mapM_ f . zip [1..] . reverse $ versions stat where + f :: (Int,IDynamic) -> IO() + f (n, ( IDynamic x))= do + putStr "Step " + putStr $ show n + putStr " " + putStrLn $ serialize x -} - ---------- event handling-------------- + +data Pretty = Pretty Stat +instance Serialize Pretty where + + showp (Pretty (Stat wfName state index recover sync versions _))= do + name <- showp wfName + vers <- showElem (zip ( reverse $ take (length versions)[1..] ) versions ) "" + return $ "Workflow name= " ++ name ++ "\n" ++ vers + + where + showElem [] str= return $ str ++ "\n" + showElem ((n, IDynamic e):es) str= do + etext <- tshowp e + showElem es $ "Step " ++ show n ++ ": " ++ etext ++ "\n" ++ str + + readp = undefined + + + + + + +--------- event handling-------------- +reference :: IDynamic -> STM (TVar IDynamic) reference x=do - mv <- getDTVars [x ] + mv <- getTVars [ x ] case mv of - [Nothing] -> do - insertDResources [x] + [Nothing] -> do + insertResources [x] reference x - + [Just cl] -> return cl + where + insertResources xs= withDSTMResources [] $ const resources{toAdd= [x]} -type Filter a= (a -> Bool) --- wait until a object (with a certaing key=keyResource x) meet a certain condition (useful to check external actions ) --- a --a -> WF m (Stat a) a ---waitFor :: (IResource a, RefSerialize a) => Filter a -> a -> WF IO (Stat a) a ---waitFor filter x= (step $ waitFor1 filter) x where ---NOTE if you Delete the object from te cache, waitFor will no longuer work -waitFor :: (IResource a, Serialize a, Typeable a) => Filter a -> a -> IO a -waitFor filter x= do - tv <- reference (toIDyn $ x) - atomically $ do +-- |wait until a TCache object (with a certaing key) meet a certain condition (useful to check external actions ) +-- NOTE if anoter process delete the object from te cache, then waitForData will no longuer work +-- inside the wokflow, it can be used by lifting it : +-- do +-- x <- step $ .. +-- y <- step $ waitForData ... +-- .. + +waitForData :: (IResource a, Typeable a,IResource b, Typeable b) + => (b -> Bool) -- ^ The condition that the retrieved object must meet + -> a -- ^ a partially defined object for which keyResource can be extracted + -> IO b -- ^ return the retrieved object that meet the condition and has the given key +waitForData filter x= atomically $ waitForDataSTM filter x + +waitForDataSTM :: (IResource a, Typeable a,IResource b, Typeable b) + => (b -> Bool) -- ^ The condition that the retrieved object must meet + -> a -- ^ a partially defined object for which keyResource can be extracted + -> STM b -- ^ return the retrieved object that meet the condition and has the given key +waitForDataSTM filter x= do + tv <- reference $ toIDyn x + do dyn <- readTVar tv - let x= fromIDyn dyn - case filter x - of + case safeFromIDyn dyn of + Nothing -> retry + Just x -> + case filter x of False -> retry - True -> return x - + True -> return x - +waitFor + :: (IResource a, Typeable a, IResource b, Typeable b) + => (b -> Bool) -- ^ The condition that the retrieved object must meet + -> String -- ^ The workflow name + -> a -- ^ the INITIAL value used in the workflow to start it + -> IO b -- ^ The first event that meet the condition +waitFor filter wfname x= atomically $ waitForSTM filter wfname x + +waitForSTM + :: (IResource a, Typeable a, IResource b, Typeable b) + => (b -> Bool) -- ^ The condition that the retrieved object must meet + -> String -- ^ The workflow name + -> a -- ^ the INITIAL value used in the workflow to start it + -> STM b -- ^ The first event that meet the condition +waitForSTM filter wfname x= do + mtv <- getTVars [toIDyn stat0{wfName=wfname ++ "#" ++ keyResource x}] -- `debug` "**waitFor***" + case mtv of + [Nothing] -> error $ "workflow "++ wfname ++" not initialized for data " ++ keyResource x + [Just tv] -> + do + dyn <- readTVar tv + let Stat{ versions= d: _}= fromIDyn dyn + case safeFromIDyn d of + Nothing -> retry -- `debug` "waithFor retry Nothing" + Just x -> + case filter x of + False -> retry -- `debug` "waitFor false filter retry" + True -> return x -- `debug` "waitfor return" + + + + +-- | start the timeout and return the flag to be monitored by 'waitUntilSTM' +getTimeoutFlag :: (MonadIO m) + => Integer -- ^ wait time in secods + -> Workflow m (TVar Bool) -- ^ the returned flag in the workflow monad +getTimeoutFlag t=do + tnow<- step $ liftIO getTimeSeconds + flag tnow t + where + flag tnow delta= WF(\s -> do + (s', tv) <- case timeout s of + Nothing -> do + tv <- liftIO $ newTVarIO False + return (s{timeout= Just tv}, tv) + Just tv -> return (s, tv) + liftIO $ do + let t = tnow + delta + forkIO $ do waitUntil t ; atomically $ writeTVar tv True + return (s', tv)) + +getTimeSeconds :: IO Integer +getTimeSeconds= do + TOD n _ <- getClockTime + return n + +{- | wait until a certain clock time, in the STM monad. + This permits to compose timeouts with locks waiting for data. + + *example: wait for any respoinse from a Queue if no response is given in 5 minutes, it is returned True. + + @ + flag <- getTimeoutFlag $ 5 * 60 + ap <- step . atomically $ readQueueSTM docQueue `orElse` waitUntilSTM flag >> return True + case ap of + False -> 'logWF' "False or timeout" >> correctWF doc + True -> do + @ +-} + +waitUntilSTM :: TVar Bool -> STM() +waitUntilSTM tv = do + + b <- readTVar tv + if b == False then retry else return () + waitUntil:: Integer -> IO() -waitUntil t= do - threadDelayInteger $ delay* 1000000 - - print ("execution at tnow="++show tnow++" ,t="++show t) - - where - tnow= n where TOD n _ = unsafePerformIO getClockTime +waitUntil t= do + tnow <- getTimeSeconds + let delay | t-tnow < 0= 0 + | t-tnow > (fromIntegral maxInt) = maxInt + | otherwise = fromIntegral $ t - tnow + threadDelay $ delay * 1000000 + if t - tnow <= 0 then return () else waitUntil t - delay | t-tnow >0 = t-tnow - | otherwise = 0 - - threadDelayInteger:: Integer -> IO() - threadDelayInteger time| time < imaxInt = threadDelay $ fromIntegral time - | otherwise=do threadDelay maxInt - threadDelayInteger ( time - imaxInt) - where maxInt = maxBound :: Int - imaxInt= fromIntegral maxInt +data Queue= Queue {name :: String, imp :: [IDynamic], out :: [IDynamic]} deriving (Typeable) - - +instance Serialize Queue where + showp (Queue name imp out)= do + sin<- showp imp + sout <- showp out + return $ "Queue " ++ show name ++ " " ++ sin ++ " " ++ sout + + readp = do + symbol "Queue" + name <- readp + sin <- readp + sout <- readp + return $ Queue name sin sout + +instance IResource Queue where + keyResource (Queue name _ _)= "Queue#" ++ name + serialize x= runW $ showp x + deserialize str = runR readp str + defPath _= workflowsPath + + +-- | delete elements from the Queue stack and return them in the IO monad +readQueue + :: (IResource a , Typeable a) + => String -- ^ Queue name + -> IO a -- ^ the returned elems +readQueue = atomically . readQueueSTM + +-- | delete elements from the Queue stack an return them. in the STM monad +readQueueSTM :: (IResource a , Typeable a) => String -> STM a +readQueueSTM queue = do + let qempty= Queue queue [] [] + let empty= toIDyn qempty + reference empty -- make sure that the queue has been created + d <- withSTMResources [qempty] doit -- otherwise, it will not retry + releaseTVars [empty] + return $ fromIDyn d + where + doit [ Nothing] = Retry + doit [Just(Queue _ [] [])] = Retry + doit [Just(Queue _ imp [])] = doit [Just (Queue queue [] $ reverse imp)] + + doit [Just (Queue _ imp list)] = + resources { toAdd= [ Queue queue imp (tail list)] + , toReturn= head list } + +unreadQueue :: (IResource a , Typeable a) => String -> a -> IO () +unreadQueue queue x= atomically $ unreadQueueSTM queue x + +unreadQueueSTM :: (IResource a , Typeable a) => String -> a -> STM () +unreadQueueSTM queue x= + withSTMResources [Queue queue undefined undefined] $ \[r]-> resources{ toAdd= doit r} + where + doit Nothing = [Queue queue [] [ toIDyn x] ] + doit (Just(Queue _ imp out)) = [Queue queue imp ( toIDyn x : out) ] + +-- | insert an element on top of the Queue Stack +writeQueue :: (IResource a, Typeable a) => String -> a -> IO () +writeQueue queue v = atomically $ writeQueueSTM queue v + +-- | Like writeQueue, but in the STM monad +writeQueueSTM :: (IResource a, Typeable a) => String -> a -> STM () +writeQueueSTM queue v= + withSTMResources [Queue queue undefined undefined] $ \[r]-> resources{ toAdd= doit r} + where + doit Nothing = [Queue queue [toIDyn v] []] + doit (Just(Queue _ imp out)) = [Queue queue ( toIDyn v : imp) out] + + +isEmptyQueue = atomically . isEmptyQueueSTM + +isEmptyQueueSTM :: String -> STM Bool +isEmptyQueueSTM queue= do + withDSTMResources [toIDyn $ Queue queue undefined undefined] doit + where + doit [ r]= resources{toReturn= ret} where + + ret=case r of + Nothing -> True + Just x -> case fromIDyn x of + Queue _ [] [] -> True + _ -> False + + + diff --git a/Control/Workflow.new.hs b/Control/Workflow.new.hs deleted file mode 100644 --- a/Control/Workflow.new.hs +++ /dev/null @@ -1,381 +0,0 @@ -{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances -fallow-undecidable-instances -O2 #-} -{-transparent low level support (state logging, resume of the computation state, wait for data condition) for very long time - computations. Workflow give the two first services to any monadic computation of type (a-> m a) - - f x >>=\x'-> g x' >>= \x''->... z by - - prefixing the user with the method step: - - step f x >>= \x'-> step g x' >>= \x''->... - -in this way, a workflow can be described with the familiar "do" notation. In principle, there is no other limitation -on the syntax but the restriction (a -> m a): All computations consume and produce the same type of data. - -Alberto Gomez Corona agocorona@gmail.com 2008 --} -module Control.Workflow ( - Workflow -- a useful type name - ,WorkflowStep - ,WorkflowList - ,Stat - - ,step -- :: (Monad m) => (a -> m a) -> ( a -> Workflow m a) - -- encapsulates a monadic computation into state monad that brings persistence and - -- recovery services - - ,startWF -- :: (Monad m) => - -- String -> mame of workflow in the workflowlist - -- a -> initial data value - -- WorkflowList m a -> assoc-list of (workflow name string,Workflow methods) - -- m a resulting value - -- start or continue a workflow - - - , restartWorkflows -- :: (IResource a, Serialize a) => WorkflowList IO a -> IO () - -- re-start the non finished workflows. needs the assoclist. - - - , getStep -- Monad m => Int -> Workflow m a return the n-tn intermediate result - -- if Int < 0 count from the current result back - - , getAll -- :: Monad m => Workfow m [a] return all the intermediate results - - , unsafeIOtoWF -- executes a IO operation. this is executed whenever re-started, no matter where is the resume point - -- This is useful for external IO re-initializations not controllable by the State monad. - - - , waitFor -- ::(IResource a, Serialize a) => (a ->Bool) -> a -> IO a - -- wait until a object (with a certaing key=keyResource x) meet a certain condition - -- (useful for checking external actions, possibly by other workflows or by direct use of TCache primitives ) - , waitUntil -- :: Integer -> IO() - -- wait until the absolute time in seconds is reached (as returned by getClockTime) - , syncWrite -- syncWrite:: Monad m => - -- Bool -> True means that changes are inmediately saved after each step - -- Int -> number of seconds between saves when async - -- Int -> max size of the cache when async - -- WF m (Stat a) () in the workflow monad - - -- Turn on and off syncronized writing to disk - -- select async mode only - -- -for very fast workflow steps or - -- -when the cache policies are dictated outside of the workflow - -- trough SyncCacheProc (see TCache module) - -) - - -where - - -import System.IO.Unsafe -import Control.Monad(when,liftM) -import Unsafe.Coerce -import Control.Concurrent (forkIO,threadDelay) -import Control.Concurrent.STM(atomically, retry, readTVar) -import Debug.Trace - -import Data.TCache.Dynamic -import Data.RefSerialize -import Data.List((\\),find,elemIndices) -import Data.Typeable -import System.Time - -debug a b = trace b a - -data WF m s l = WF { st :: s -> m (s,l) } - -type Workflow m l= WF m (Stat l) l -- not so scary - -type WorkflowStep m a= ( a -> Workflow m a) - -type WorkflowList m a = [(String, WorkflowStep m a)] - -data Stat a= Workflows [(String,String)] - |Stat{ wfName :: String, state:: Int, index :: Int, recover:: Bool, sync :: Bool , versions :: [a]} - - deriving (Typeable) - -stat0 = Stat{ wfName="", state=0, index=0, recover=False, versions =[], sync= True} - - --- serialization of data is done trough RefSerialize because it permits to store --- different versions of the same object with minumum memory. - -instance Serialize a => Serialize (Stat a) where - showp (Workflows list)= do - str <- showp list - return $ "StatWorkflows "++ str - - - showp (Stat wfName state index recover sync versions )= do - parsea <- rshowp versions - return $ "Stat "++ show wfName ++" "++ show state++" "++show index++" "++show recover++" "++ show sync ++ parsea - - readp = choice [rStat, rWorkflows] where - rStat= do - symbol "Stat" - wfName <- stringLiteral - state <- integer - index <- integer - recover <- bool - sync <- bool - versions<- rreadp - return $ Stat wfName (fromIntegral state) (fromIntegral index) recover sync versions - - - - rWorkflows= do - symbol "StatWorkflows" - list <- readp - return $ Workflows list - ---persistence trough TCache , default persistence in files - -instance (IResource a, Serialize a,Typeable a)=> IResource (Stat a) where - keyResource Stat{wfName=name, versions = []}= show (name,"") - keyResource Stat{wfName=name, versions = (a:_)}= show (name,keyResource a) - - keyResource w@(Workflows xs)= "StatWorkflows" - - - defPath x= "Workflows/" ++ show (typeOf x)++"/" -- directory for Workflow data - - serialize x= runW $ showp x - deserialize str = runR readp str - - - -insertDResources xs= withDResources [] (\_-> xs) - ---unsafeIOtoWF :: Monad m => IO a -> WF m (Stat b) a -unsafeIOtoWF x= let y= unsafePerformIO x in y `seq` return y - - - - -instance Monad m => Monad (WF m s) where - return x = WF (\s -> return (s, x)) - WF g >>= f = WF (\s ->do - (s1, x) <- g s - - let WF fun= f x - (s3, x') <- fun s1 - - return (s3, x')) - -class (IResource a, Serialize a,Typeable a) => Workflow_ a where - -- | step lift a monadic computation (a -> m a) in in to the WF monad, provides state loging and automatic resume - step :: (Monad m) => (a -> m a) -> ( a -> Workflow m a) - step f = \x -> WF(\s -> do - let stat= state s - let ind= index s - if recover s && ind < stat - then return (s{index=ind +1 }, versions s !! (stat - ind-1) ) - else do - x'<- f x - let s'= s{recover= False, versions = x': versions s, state= state s+1} - unsafeIOtoWF $ do - - let - doit1 xs - | keyResource s /= keyResource s' -- `debug` ("keys:"++keyResource s ++", "++keyResource s') - = - let newlist= newpair :(xs \\[oldpair]) - newpair= (keyResource s',original) - oldpair= (key,original) - key= keyResource s - original= case lookup key xs of - Nothing -> error $ "workflow stat not found: " ++key - Just old -> old - - in [Insert $ toIDyn $ (Workflows newlist :: Stat a) - ,Delete $ toIDyn s, Insert $ toIDyn s' - ,Insert (toIDyn x')] - -- `debug`("insert "++keyResource s'++","++keyResource x'++" delete: "++ - -- keyResource s++","++keyResource x) - | otherwise= [Insert $ toIDyn s', Insert $ toIDyn x'] - -- `debug`("insert "++keyResource s'++","++keyResource x') - let - doit [Nothing] = doit1 [] - doit [Just d] = let Workflows xs= (fromIDyn d :: Stat a) - in doit1 xs - - withDResourcesID [toIDyn $ (Workflows undefined :: Stat a)] doit - - when (sync s) $ unsafeIOtoWF $ syncCache - - return (s', x') ) - - -- | start or continue a workflow. WorkflowList is a assoclist of (name, workflow computation) - startWF :: (Monad m) => String -> a -> WorkflowList m a ->m a - startWF name v wfs= do - unsafeIOtoWF (registerType :: IO (Stat a)) - case lookup name wfs of - Nothing -> error $ "MonadWF.startWF: workflow not found: "++name; - Just f -> do - - let stat1= stat0{index=0,wfName= name,versions=[v]} ::Stat a - let key= keyResource stat1 - (vn, stat, found) <- do - wxs <- unsafeIOtoWF $ getResource $ (Workflows undefined :: Stat a) - case wxs of - Nothing -> return (v,stat1, False) - Just (Workflows xs) -> - case find (\(_,s)-> s == key) xs of - - Just (key1, oldkey1) -> do - -- already in course - let (name,_)= read key1 ::(String, String) - mst <- unsafeIOtoWF $ getResource stat0{wfName= name} - case mst of - Nothing -> error $ "no stat for key. " ++ key - Just s@Stat{versions=(a:_)} -> return (a,s{index=0,recover=True}, True) -- the last value - - Nothing -> return (v, stat1, False) - -- insert it in the running workflow list - when (found == False) $ - let addWF [Nothing] = [Workflows [(key,key)],stat] - addWF [Just (Workflows xs)]= [Workflows ((key,key):xs),stat] - - in unsafeIOtoWF $ withResources [(Workflows undefined :: Stat a)] addWF - - runWF name f vn stat -- `debug` (serialize stat) - - - - - restartWorkflows :: (IResource a, Serialize a) => WorkflowList IO a -> IO () - restartWorkflows map = do - unsafeIOtoWF (registerType :: IO (Stat a)) - mw <- getResource ((Workflows undefined ) :: Stat a) - case mw of - Nothing -> return () - Just (Workflows all) -> mapM_ start all - where - start :: (String, String) -> IO () - start (key,_)= do - let (name ,_)= read key :: (String, String) - - case lookup name map of - Just f -> do - Just st <- getResource stat0{ wfName=key} - - forkIO $ runWF key f (head $ versions st) st >> return () - return () - Nothing -> error $ "workflow not found: "++ name - - - - runWF :: (Monad m,IResource a, Serialize a) => String ->( a -> Workflow m a) -> a -> (Stat a) -> m a - runWF name f v s=do - - (s', v') <- st (f v) $ s - - let key= keyResource s' - - let delWF [Nothing] = error $ " Workflow list not found: " - delWF [Just d]= let Workflows xs= (fromIDyn d :: Stat a) in - case lookup key xs of - Nothing -> error $"runWF not found state for key: "++ key - Just oldkey -> - (map (Delete . toIDyn) $ versions s') ++ -- delete all intermediate objects generated - [Insert . toIDyn $ (Workflows (xs \\ [(key,oldkey)]) ::Stat a) - ,Delete $ toIDyn s'] - - - unsafeIOtoWF $ withDResourcesID [toIDyn $ (Workflows undefined :: Stat a)] delWF - when (sync s) $ unsafeIOtoWF $ syncCache - return v' - - -- switch on and off syncronous write for each step (default is syncronous) - -- for very fast steps, asyncronous is better.h - -- when TCache is used for other purposes, is better to define the cache policy direct - syncWrite:: (Monad m , IResource a)=> Bool -> Int -> Int -> WF m (Stat a) () - syncWrite bool time maxsize= WF(\s ->do - when (bool== False) $ do - unsafeIOtoWF $ clearSyncCacheProc time defaultCheck maxsize - return () - return (s{ sync= bool},())) - - -instance (IResource a,Serialize a,Typeable a) => Workflow_ a - - - --- return the result of the previous step -getStep :: Monad m => Int -> Workflow m a -getStep i= WF(\s ->do - let stat= state s - return (s, if i > 0 && i <= stat then versions s !! (stat - i) - else if i < 0 && i >= -stat then versions s !! (stat +i) - else error "getStep: wrong index") - ) - --- get all the step results -getAll :: Monad m => WF m (Stat a) [a] -getAll = WF(\s ->return (s, take (state s) $ versions s)) - -{- - -exec :: (Monad m) => WF m s a -> s -> m a -exec (WF f) s = do (s', x) <- f s - return x - -run :: (Monad m,Monad (WF m s)) => (a -> WF m s a) -> s -> a -> m a -run f s a= exec (f a) s - --} - - ---------- event handling-------------- -reference x=do - mv <- getDTVars [x ] - case mv of - [Nothing] -> do - insertDResources [x] - reference x - - [Just cl] -> return cl - -type Filter a= (a -> Bool) --- wait until a object (with a certaing key=keyResource x) meet a certain condition (useful to check external actions ) --- a --a -> WF m (Stat a) a ---waitFor :: (IResource a, RefSerialize a) => Filter a -> a -> WF IO (Stat a) a ---waitFor filter x= (step $ waitFor1 filter) x where ---NOTE if you Delete the object from te cache, waitFor will no longuer work -waitFor :: (IResource a, Serialize a, Typeable a) => Filter a -> a -> IO a -waitFor filter x= do - tv <- reference (toIDyn $ x) - atomically $ do - dyn <- readTVar tv - let x= fromIDyn dyn - case filter x - of - False -> retry - True -> return x - - - - -waitUntil:: Integer -> IO() -waitUntil t= do - threadDelayInteger $ delay* 1000000 - - print ("execution at tnow="++show tnow++" ,t="++show t) - - where - tnow= n where TOD n _ = unsafePerformIO getClockTime - - delay | t-tnow >0 = t-tnow - | otherwise = 0 - - threadDelayInteger:: Integer -> IO() - threadDelayInteger time| time < imaxInt = threadDelay $ fromIntegral time - | otherwise=do threadDelay maxInt - threadDelayInteger ( time - imaxInt) - where maxInt = maxBound :: Int - imaxInt= fromIntegral maxInt - - - - diff --git a/IDE.session b/IDE.session new file mode 100644 --- /dev/null +++ b/IDE.session @@ -0,0 +1,15 @@ +Time of storage: + "Thu Sep 24 12:01:27 Hora de verano romance 2009" +Layout: VerticalP (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 3, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) 420) (HorizontalP (TerminalP {paneGroups = fromList [("Debug",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just RightP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 109)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just BottomP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) 234) 680 +Population: [(Just (BreakpointsSt BreakpointsState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\Dynamic.hs" 82)),[SplitP LeftP,SplitP TopP]),(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\IDynamic.hs" 94)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\IResource.hs" 8479)),[SplitP LeftP,SplitP TopP]),(Just (InfoSt (InfoState (Descr {descrName' = "showHex", typeInfo' = "showHex :: forall a. Integral a => a -> ShowS\n", descrModu' = PM {pack = PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}, modu = ModuleName ["Numeric"]}, mbLocation' = Nothing, mbComment' = Nothing, details' = VariableDescr}))),[SplitP RightP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 195 (System,True) (Nothing,Nothing) (ExpanderState {localExp = ([],[]), localExpNoBlack = ([[5,16],[5,13],[5,1],[5],[4,0,1],[4,0,0],[4,0],[4],[1,0],[1],[0]],[]), packageExp = ([[4],[0]],[]), packageExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\Data\\Parser.hs" 289)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\RefSerialize.cabal" 2260)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\Data\\RefSerialize.hs" 370)),[SplitP LeftP,SplitP TopP]),(Just (ReferencesSt (ReferencesState {refTo = Just (Descr {descrName' = "multisetEditor", typeInfo' = "multisetEditor :: forall alpha.\n (Show alpha, Default alpha, Eq alpha) =>\n ColumnDescr alpha\n -> (Editor alpha, Parameters)\n -> Maybe ([alpha] -> [alpha])\n -> Maybe (alpha -> alpha -> Bool)\n -> Editor [alpha]\n", descrModu' = PM {pack = PackageIdentifier {pkgName = PackageName "leksah", pkgVersion = Version {versionBranch = [0,5,0], versionTags = []}}, modu = ModuleName ["Graphics","UI","Editor","Composite"]}, mbLocation' = Just (Location {locationSLine = 499, locationSCol = 0, locationELine = 616, locationECol = 25}), mbComment' = Just "An editor with a subeditor, of which a list of items can be selected\n\n", details' = VariableDescr}), refScope = Package})),[SplitP RightP,SplitP BottomP]),(Just (SearchSt (SearchState {searchString = "number", searchScope = System, searchMode = Prefix {caseSense = True}})),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\Data\\Serialize.hs" 0)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\TCache.cabal" 1673)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache.hs" 7752)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\TMVar.hs" 65)),[SplitP LeftP,SplitP TopP]),(Just (TraceSt TraceState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (VariablesSt VariablesState),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP BottomP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5.5\\Workflow.cabal" 1665)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferStateTrans "_Eval.hs" ":l demos\\DocumentApprobalRefSerial.hs\n\n:l demos\\sequence.hs\n:list\n\nlet mcount= plift $ putStr (show n ++ \" \") >> hFlush stdout >> threadDelay 1000000>>mcount (n+1)" 40)),[SplitP RightP,SplitP TopP,GroupP "Debug",SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\demo.hs" 0)),[SplitP LeftP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\tutorial.txt" 2522)),[SplitP LeftP,SplitP TopP])] +Window size: (1024,540) +Active package: + Just "C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5.5\\Workflow.cabal" +Active pane: Just "Parser.hs" +Toolbar visible: + True +FindbarState: (True,FindState {entryStr = "I.", entryHist = ["I.","ll the rest derive from it","clearSyncCacheProc","DynamicIn","takeBlocks","size","getTVars ","cate","unsa","logWFF","logWFD","orElse"], replaceStr = "PMonadTrans", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = True, regex = False, lineNr = 1}) +Recently opened files: + ["C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\Data\\Parser.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\TMVar\\Dynamic.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\Data\\RefSerialize.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5.5\\demos\\sequence.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5.5\\Control\\Workflow.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5.5\\demos\\DocumentApprobalRefSerial.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.3.tar.gz","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5\\demos\\DocumentApprobalRefSerial.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\IDynamic.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\Data\\TCache\\IResource.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\demos\\Sample.hs","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\TCache.cabal"] +Recently opened packages: + ["C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.4\\TCache.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.4\\RefSerialize.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.5\\Workflow.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.3\\Workflow.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\TCache-0.6.3\\TCache.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.4.6\\Workflow.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\RefSerialize-0.2.3\\RefSerialize.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\tests\\All\\test.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.4.5\\Workflow.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Workflow-0.4\\Workflow.cabal","C:\\Documents and Settings\\Alberto Gomez Corona\\Mis documentos\\haskell\\devel\\Cluster-0.3.3 distributed TVar nosync\\Cluster.cabal"] diff --git a/Workflow.cabal b/Workflow.cabal --- a/Workflow.cabal +++ b/Workflow.cabal @@ -1,42 +1,44 @@ name: Workflow -version: 0.3 -synopsis: library for transparent execution of computations across shutdowns and restarts -description: - transparent low level support (state logging, resume of the computation state, wait for data condition) for very long time - long living event driven processes. Workflow give the two first services to any monadic computation of type (a-> m a) - - f x >>=\x'-> g x' >>= \x''->... z +version: 0.5.5 +synopsis: library for transparent execution of interruptible computations +description: + Transparent support for interruptable computations. A workflow can be seen as a persistent thread that executes any + 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 + failures, timeouts or shutdowns. + . + The computantion can be restarted at the interrupted point because such monad is encapsulated inside + a state monad transformer that transparently checkpoint the computation state. Besides that, the package also provides + other services associated to workflows + The main features are: + . + * logging of each intermediate action results in disk. + . + * resume the monadic computation at the last checkpoint after soft or hard interruption. + . + * suspend a computation until the input object meet certain conditions. useful for inter-workflow comunications.- + . + * Communications with other processes including other workflows trough persistent data objects, + inspection of intermediate workflow results , persistent queues, persistent timeouts so that no data is lost due + to shutdowns + . + * A workflow can initiate anoter workflow and wait for the resutl + . + * workflow management and monitoriing, view workflow history and intermediate results. - by prefixing each action with the method "step": - - step f x >>= \x'-> step g x' >>= \x''->... - - This means that a workflow can be described with the familiar "do" notation. In principle, there is no other limitation - on the syntax but the restriction (a -> m a): All computations consume and produce the same type of data. - - for a monadic computation, Workflow provides: - - transparent checkpointing for each step in permanent storage (using TCache) - - sync or async syncronization of each action results with disk. - - after soft or hard interruption, resume the monadic computation at the last checkpoint - - retrieval of the returned value of any previous action - - suspend the computation until the input object meet certain conditions. useful for inter-workflow - comunications. - - For various reasons, this package force the use of TCache for storage and refSerialize for writing to/from strings - at the end of the workflow all the intermediate data is erased. - see demo.hs and the header of Control.TCache for documentation. - this version uses Data.TCache.Dynamic - -category: Control +category: Control, Workflow, Concurrent, Middleware +Stability: experimental license: BSD3 license-file: LICENSE author: Alberto Gómez Corona maintainer: agocorona@gmail.com -Tested-With: GHC == 6.8.2 +Tested-With: Build-Type: Simple -build-Depends: base, RefSerialize>=0.2.3, TCache>=0.5.5, stm > 2, old-time +build-Depends: base >=3 && <4, containers, RefSerialize>=0.2.4, TCache>=0.6.4, stm > 2, old-time, mtl Cabal-Version: >= 1.2 exposed-modules: Control.Workflow -ghc-options: +ghc-options: -O2 + + diff --git a/demos/DocumentApprobalRefSerial.hs b/demos/DocumentApprobalRefSerial.hs new file mode 100644 --- /dev/null +++ b/demos/DocumentApprobalRefSerial.hs @@ -0,0 +1,299 @@ +{-# OPTIONS -XDeriveDataTypeable #-} +{- + This program is an example of simple workflow management. Once a document + is created by the user, a workflow controls two levels of approbal (boss and superboss) trough + messages to the presentation layer of the three different users. + + A document is created by the user, then is validated by the boss and the super boss. + If any of the two dissapprobe, the document is sent to the user to modify it. + + This program can handle as many document workflows as you like simultaneously. + + this is a version with more transaction-aware communications between the workflow and + the user interfaces. Most of te Workflow and communication primitives are used. + + The second level of approbal now has a timeout . The seralization of the document is + trough the Serialize class of the RefSerialize package. + + There is also a rudimentary account of document modifications + + When te document title is modified, the workflow launches a new workflow with the new + document and stops. + + + +-} +import Control.Workflow +import Data.TCache.IDynamic +import Data.Typeable +import System.Exit +import Data.List (find,(\\)) +import Data.Maybe(fromJust) +import Control.Monad (when) +import Control.Concurrent ( forkIO,threadDelay) +import GHC.Conc( atomically, unsafeIOToSTM, STM, orElse) +import Data.RefSerialize +import Data.TCache.Dynamic + +import Debug.Trace + +debug a b= trace b a + +data Document=Document{title :: String , text :: [String]} deriving (Read, Show,Eq,Typeable) + +instance IResource Document where + keyResource (Document t _)= t + tshowp (Document title text)= do + title1 <- showp title + stext <- rshowp text + return $ "Document " ++ title1 ++ stext + + treadp= do + symbol "Document" + title <- readp + text <- rreadp + return $ Document title text + + +docWorkflows=[("docApprobal",docApprobal)] + + +main= do + -- register all the data types to be returned in the workflow steps + registerType :: IO Document + registerType :: IO () + registerType :: IO Bool + +{- + let x= toIDyn $ Document "title" ["sdfsdf", "sdfsdf"] + let str= runW $ showp [x,x] + let y = runR readp str :: [IDynamic] + putStrLn str + putStrLn "" + putStrLn "" + putStrLn "" + print y +-} + -- restart the interrupted workflows + restartWorkflows docWorkflows + + putStrLn "\nThis program is an example of simple workflow management; once a document is created a workflow thread controls the flow o mail messages to three different users that approbe or disapprobe and modify the document" + + putStrLn "A document is created by the user, then is validated by the boss and the super boss. If any of the two dissapprobe, the document is sent to the user to modify it." + putStrLn "\n please login as:\n 1- user\n 2- boss\n 3- super boss\n\n Enter the number" + + n <- getLine + case n of + "1" -> userMenu + "2" -> aprobal boss + "3" -> aprobal superboss + + + +-- The workflow. +-- Think on it as a persistent thread + +docApprobal :: Document -> Workflow IO () +docApprobal doc= do + logWF "send a message to the boss requesting approbal" + step $ writeQueue boss doc + -- wait for any respoinse from the boss + let docQueue= receiver approbal doc + + ap <- step $ readQueue docQueue + + case ap of + False -> logWF "not approbed, sent to the user for correction" >> correctWF doc + True -> do + logWF " approbed, send a message to the superboss requesting approbal" + step $ writeQueue superboss doc + + -- wait for any respoinse from the superboss + -- if no response from the superboss in 5 minutes, it is validated + + flag <- getTimeoutFlag $ 5 * 60 + + ap <- step . atomically $ readQueueSTM docQueue `orElse` waitUntilSTM flag >> return True + case ap of + False -> logWF "not approbed, sent to the user for correction" >> correctWF doc + True -> do + logWF " approbed, sent to the list of approbed documents" + step $ writeQueue approbed doc + + +correctWF :: Document -> Workflow IO () +correctWF doc= do + + step $ writeQueue user doc -- send a message to the user to correct the document + -- wait for the document approbal + doc' <- step $ readQueue (title doc) + if title doc /= title doc' + -- if doc and new doc hace different document title, then start a new workflow for this new document + -- since a workflow is identified by the workflow name and the key of the starting data, this is a convenient thing. + then step $ startWF "docApprobal" doc' docWorkflows + -- else continue the current workflow + else docApprobal doc' + + +create = do + separator + doc <- readDoc + + putStrLn "The document has been sent to the boss.\nPlease wait for the approbal" + forkIO $ startWF "docApprobal" doc docWorkflows + userMenu + +{- + finaldoc <- startWF "docApprobal" doc docWorkflows + Just sequenceAprobal <- getWFHistory "docApprobal" doc + printHistory sequenceAprobal +-} + + + +user= "user" +boss = "boss" +superboss= "superboss" +approbed = "approbed" +approbal= "approbal" + +userMenu= do + separator + putStrLn"\n\n1- Create document\n2- Documents to modify\n3- Approbed documents\n4- manage workflows\n5- exit" + n <- getLine + case n of + "1" -> create + "2" -> modify + "3" -> view + "4" -> history + "5" -> exitSuccess + userMenu + +handle = flip catch + +history= do + separator + putStr "MANAGE WORKFLOWS\n" + ks <- getWFKeys "docApprobal" + mapM (\(n,d) -> putStr (show n) >> putStr "- " >> putStrLn d) $ zip [1..] ks + putStr $ show $ length ks + 1 + putStrLn "- back" + putStrLn "" + putStrLn " select v to view the history or d to delete it" + l <- getLine + + let n= read $ drop 2 l + let docproto= Document{title= ks !! (n-1), text=undefined} + case head l of + 'v' -> do + getWFHistory "docApprobal" docproto >>= printHistory . fromJust + history + 'd' -> do + delWFHistory "docApprobal" docproto + history + +separator= putStrLn "------------------------------------------------" + +modify :: IO () +modify= do + separator + empty <- isEmptyQueue user :: IO Bool + if empty then putStrLn "thanks, enter as Boss for the approbal"else do + doc <- atomically $ do + doc <- readQueueSTM user + unreadQueueSTM user doc + return doc + putStrLn "Please correct this doc" + print doc + doc1 <- readDoc + return $ diff doc1 doc + atomically $ do + readQueueSTM user :: STM Document + writeQueueSTM (title doc) doc1 + modify + +diff (Document t xs) (Document _ ys)= Document t $ map (search ys) xs where + search xs x= case find (==x) xs of + Just x' -> x' + Nothing -> x + + +readDoc :: IO Document +readDoc = do + putStrLn "please enter the title of the document" + title1 <- getLine + h <- getWFHistory "docApprobal" $ Document title1 undefined + case h of + Just _ -> putStrLn "sorry document title already existent, try other" >> readDoc + Nothing -> do + putStrLn "please enter the text. " + putStrLn "the edition will end wth a empty line " + text <- readDoc1 [title1] + return $ Document title1 text + where + readDoc1 text= do + line <- getLine + if line == "" then return text else readDoc1 $ text ++ [line] + + +receiver name doc= name++keyResource doc + +view= do + separator + putStrLn "LIST OF APPROBED DOCUMENTS:" + view1 + where + view1= do + empty <- isEmptyQueue approbed + if empty then return () else do + doc <- readQueue approbed :: IO [Document] + print doc + view1 + + + +aprobal who= do + separator + aprobalList + + putStrLn $ "thanks , press any key to exit, "++ who + getLine + return () + + where + aprobalList= do + empty <- isEmptyQueue who + if empty + then do + putStrLn "No more document to validate. Bye" + return () + else do + doc <- atomically $do + doc <- readQueueSTM who + unreadQueueSTM who doc + return doc + syncCache + approbal1 doc + aprobalList + + + approbal1 :: Document -> IO () + approbal1 doc= do + + putStrLn $ "hi " ++ who ++", a new request for aprobal has arrived:" + print doc + putStrLn $ "Would you approbe this document? s/n" + l <- getLine + let b= head l + let res= if b == 's' then True else False + + -- send the message to the workflow + atomically $ do + empty <- isEmptyQueueSTM who + readQueueSTM who :: STM Document + writeQueueSTM (receiver approbal doc) res + syncCache + + + + diff --git a/demos/Workflows/Queue#approbaltitle b/demos/Workflows/Queue#approbaltitle new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#approbaltitle @@ -0,0 +1,1 @@ +Queue "approbaltitle" [] [] diff --git a/demos/Workflows/Queue#approbaltitle2 b/demos/Workflows/Queue#approbaltitle2 new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#approbaltitle2 @@ -0,0 +1,1 @@ +Queue "approbaltitle2" [] [] diff --git a/demos/Workflows/Queue#approbaltitle3 b/demos/Workflows/Queue#approbaltitle3 new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#approbaltitle3 @@ -0,0 +1,1 @@ +Queue "approbaltitle3" [] [] diff --git a/demos/Workflows/Queue#approbed b/demos/Workflows/Queue#approbed new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#approbed @@ -0,0 +1,1 @@ +Queue "approbed" [Dyn 46d995b5 Document "title3" v32, Dyn 46d995b5 Document "title3" v31, Dyn 46d995b5 Document "title" v28] [] where {v28= [ v36, v37, v38]; v29= "text3"; v30= "title3"; v31= [ v30, v29]; v32= [ v34, v33]; v33= "text3"; v34= "title3"; v36= "title"; v37= "text"; v38= "text2"; } diff --git a/demos/Workflows/Queue#boss b/demos/Workflows/Queue#boss new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#boss @@ -0,0 +1,1 @@ +Queue "boss" [] [] diff --git a/demos/Workflows/Queue#superboss b/demos/Workflows/Queue#superboss new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#superboss @@ -0,0 +1,1 @@ +Queue "superboss" [Dyn 46d995b5 Document "title3" v16] [] where {v15= "title3"; v16= [ v15, v22]; v22= "text3"; } diff --git a/demos/Workflows/Queue#title2 b/demos/Workflows/Queue#title2 new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#title2 @@ -0,0 +1,1 @@ +Queue "title2" [] [] diff --git a/demos/Workflows/Queue#user b/demos/Workflows/Queue#user new file mode 100644 --- /dev/null +++ b/demos/Workflows/Queue#user @@ -0,0 +1,1 @@ +Queue "user" [] [] diff --git a/demos/Workflows/RunningWorkflows b/demos/Workflows/RunningWorkflows new file mode 100644 --- /dev/null +++ b/demos/Workflows/RunningWorkflows @@ -0,0 +1,1 @@ +StatWorkflows ["count#Int", "docApprobal#title3", "docApprobal#title2", "docApprobal#title", "factorials#lastfact"] diff --git a/demos/Workflows/Stat#count#Int b/demos/Workflows/Stat#count#Int new file mode 100644 --- /dev/null +++ b/demos/Workflows/Stat#count#Int @@ -0,0 +1,1 @@ +Stat "count#Int" 16 9 False True v31 where {v15= Dyn c4d4e219 (); v16= Dyn c4d4e219 (); v17= Dyn c4d4e219 (); v18= Dyn c4d4e219 (); v19= Dyn c4d4e219 (); v20= Dyn c4d4e219 (); v21= Dyn c4d4e219 (); v22= Dyn c4d4e219 (); v23= Dyn c4d4e219 (); v24= Dyn c4d4e219 (); v25= Dyn c4d4e219 (); v26= Dyn c4d4e219 (); v27= Dyn c4d4e219 (); v28= Dyn c4d4e219 (); v29= Dyn c4d4e219 (); v30= Dyn c4d4e219 (); v31= [ v30, v29, v28, v27, v26, v25, v24, v23, v22, v21, v20, v19, v18, v17, v16, v15, v32]; v32= Dyn 6c7c14ae 0; } diff --git a/demos/Workflows/Stat#docApprobal#title b/demos/Workflows/Stat#docApprobal#title new file mode 100644 --- /dev/null +++ b/demos/Workflows/Stat#docApprobal#title @@ -0,0 +1,1 @@ +Stat "docApprobal#title" 9 6 False True v15 where {v15= [ v16, v17, v18, v19, v20, v21, v22, v23, v24, v25]; v16= Dyn c4d4e219 (); v17= Dyn 9f028ff7 "Thu Sep 24 00:00:45 Hora de verano romance 2009: approbed, sent to the list of approbed documents"; v18= Dyn ab0548b6 True; v19= Dyn 128cc0c2 1253743225; v20= Dyn c4d4e219 (); v21= Dyn 9f028ff7 "Thu Sep 24 00:00:25 Hora de verano romance 2009: approbed, send a message to the superboss requesting approbal"; v22= Dyn ab0548b6 True; v23= Dyn c4d4e219 (); v24= Dyn 9f028ff7 "Thu Sep 24 00:00:17 Hora de verano romance 2009: send a message to the boss requesting approbal"; v25= Dyn 46d995b5 Document "title" v26; v26= [ v27, v28, v29]; v27= "title"; v28= "text"; v29= "text2"; } diff --git a/demos/Workflows/Stat#docApprobal#title2 b/demos/Workflows/Stat#docApprobal#title2 new file mode 100644 --- /dev/null +++ b/demos/Workflows/Stat#docApprobal#title2 @@ -0,0 +1,1 @@ +Stat "docApprobal#title2" 6 5 False True v25 where {v15= Dyn 46d995b5 Document "title2" v26; v16= Dyn 9f028ff7 "Thu Sep 24 00:08:00 Hora de verano romance 2009: send a message to the boss requesting approbal"; v17= Dyn c4d4e219 (); v18= Dyn ab0548b6 False; v19= Dyn 9f028ff7 "Thu Sep 24 00:08:14 Hora de verano romance 2009: not approbed, sent to the user for correction"; v20= Dyn c4d4e219 (); v21= Dyn 46d995b5 Document "title3" v22; v22= [ v24, v23]; v23= "text3"; v24= "title3"; v25= [ v21, v20, v19, v18, v17, v16, v15]; v26= [ v27, v28, v29]; v27= "title2"; v28= "text2"; v29= "text21"; } diff --git a/demos/Workflows/Stat#docApprobal#title3 b/demos/Workflows/Stat#docApprobal#title3 new file mode 100644 --- /dev/null +++ b/demos/Workflows/Stat#docApprobal#title3 @@ -0,0 +1,1 @@ +Stat "docApprobal#title3" 9 6 False True v15 where {v15= [ v16, v17, v18, v19, v20, v21, v22, v23, v24, v25]; v16= Dyn c4d4e219 (); v17= Dyn 9f028ff7 "Thu Sep 24 00:14:18 Hora de verano romance 2009: approbed, sent to the list of approbed documents"; v18= Dyn ab0548b6 True; v19= Dyn 128cc0c2 1253743758; v20= Dyn c4d4e219 (); v21= Dyn 9f028ff7 "Thu Sep 24 00:09:18 Hora de verano romance 2009: approbed, send a message to the superboss requesting approbal"; v22= Dyn ab0548b6 True; v23= Dyn c4d4e219 (); v24= Dyn 9f028ff7 "Thu Sep 24 00:08:50 Hora de verano romance 2009: send a message to the boss requesting approbal"; v25= Dyn 46d995b5 Document "title3" v26; v26= [ v27, v28]; v27= "title3"; v28= "text3"; } diff --git a/demos/Workflows/Stat#factorials#lastfact b/demos/Workflows/Stat#factorials#lastfact new file mode 100644 --- /dev/null +++ b/demos/Workflows/Stat#factorials#lastfact @@ -0,0 +1,1 @@ +Stat "factorials#lastfact" 7 4 False True v22 where {v15= Dyn c655d793 8 Fact 1 1; v16= Dyn c655d793 8 Fact 2 2; v17= Dyn c655d793 8 Fact 3 6; v18= Dyn c655d793 9 Fact 4 24; v19= Dyn c655d793 8 Fact 3 6; v20= Dyn c655d793 9 Fact 4 24; v21= Dyn c655d793 10 Fact 5 120; v22= [ v21, v20, v19, v18, v17, v16, v15, v23]; v23= Dyn c655d793 8 Fact 0 0; } diff --git a/demos/demo.hs b/demos/demo.hs deleted file mode 100644 --- a/demos/demo.hs +++ /dev/null @@ -1,123 +0,0 @@ -{-# OPTIONS -fglasgow-exts #-} --- example of the Workflow package . --- two workflows that interact by modifing the structure "Data". One ask the user for a numbers. When the total number of tries --- is exhausted, update Data with termination and ends. It can end when termination comes from the other workflow. The other wait for "5", print --- a message , update Data with termination to the other and finish. t --- you can break the code at any moment. The flow with re-start in the last interrupted point --- For bugs, questions, whatever, please email me: Alberto Gómez Corona agocorona@gmail.com - -module Main where -import Data.TCache.Dynamic (IResource(..),registerType) -import Control.Workflow -import Debug.Trace -import Data.Typeable -import Control.Concurrent(forkIO, threadDelay) - - -debug a b = trace b a - -wfList= [("hello-ask",hello),("wait",wait)] - -data Data = Name String |Try Int String - | Finish String - | None deriving (Read,Show,Typeable) -- for complex data, better to define a RefSerialize interface (see RefSerialize package) - -instance IResource Data where - keyResource (Name str) = "Name" -- the filename of the object to be stored - keyResource (Try n s) = "Try-Finish" -- need to be the same key for "wait" to check these two values. - keyResource (Finish _) = "Try-Finish" -- need tp be the same key for "wait" to check these two values. - keyResource None = "None" - defPath _ = "data/" -- path where temporary problem-related data will be stored - serialize = show -- the WF monad is in charge of the persistence) - deserialize = read -- (the WF monad is in charge of the persistence) - - - - --- startWF insert a workflow in the workflow list and start it. if the WF was in a intermediate state, restart it --- A workflow state is identified by: --- the name of the workflow --- the key of the last versión of the object - --- In general the last can change, therefore a the workflow identifier change. In this case, startWF will not detect that --- condition and will restart a new workflow with the starting object --- RestartWorkflows restar all workflows in the pending workflow list --- if startWF is called when startworflow has already restarted a the same workflow -main= do - registerType None - forkIO $ do - startWF "hello-ask" None wfList - return() - - startWF "wait" None wfList - - - -hello d= do - unsafeIOtoWF $ do - putStrLn "" - putStrLn "At any step you can break and re-start the program" - putStrLn "The program will restart at the interrupted step." - putStrLn "" - --syncWrite True -- this is the default - name@(Name str) <- step askName d - step printname name - askNumbers str $ Try 0 "33" - -askName :: Data-> IO Data -askName _ = do - print "what is your name?" - str <- getLine - return $ Name str - -printname :: Data -> IO Data -printname (Name name)= do - print $ "hello Mr "++name - return None - -wait _ = do - let filter (Try _ "5") = True - filter (Finish _)= True - filter _= False - r <- step (waitFor filter) (Try 0 "13") -- wait the other thread to store an object with the same key than Try 0 "" - -- with the string "5" or termination - case r of - Try n "5" -> step1 $ return $ Finish $ "done in the step "++ show n++" !" -- the WF monad store the Finish message - - Finish str -> step2 $ print str -- finish message sent by the other thread (max count reached) - - step2 $ threadDelay 1000000 -- wait the finalization of the other thead - - -step1 f= step (\_->f) None - -step2 f= step(\_->f >> return None) None - - - -askNumbers :: String -> Data -> Workflow IO Data -askNumbers name d = do - step2 $ threadDelay 5000 -- wait for the other tread to process. - - r <- step (waitFor anything) d -- get the last value of the object with key "try-finish", to look for the other thread actions - case r of - - Finish msg -> step2 $ print msg --the other thread sent a finalize response - -- `debug` "hello-ask: finish detected" - Try 9 num -> step1 $ return $ Finish "sorry, no more guesses" --send finalization to the wait thread - -- `debug` "hello-ask: Finish returned" - _ -> do - nd <- step (askNumber name) d - - askNumbers name nd - where - anything= \_-> True - -askNumber:: String -> Data ->IO Data -askNumber name None= askNumber name (Try 0 "22") -askNumber name d@(Try i num)= do - - print $ "Mr "++name++ " this is your try number "++show (i+1) ++". Guess my number" - str <- getLine - return $ Try (i+1) str - diff --git a/demos/demo3.hs b/demos/demo3.hs deleted file mode 100644 --- a/demos/demo3.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# OPTIONS -XDeriveDataTypeable #-} --- this program imput numbers and calculate their factorials. The workflow control a record all the inputs and outputs --- so that when the program restart, all the previous results are shown. --- if the program abort by a runtime error or a power failure, the program will still work --- enter 0 for exit and finalize the workflow (all the intermediate data will be erased) --- enter any alphanumeric character for aborting and then re-start. - -module Main where -import Control.Workflow -import Data.TCache.Dynamic -import Data.Typeable - -fact 0 =1 -fact n= n * fact (n-1) - -{- -this is the origina program without workflow - -factorials= do - print "give me a number" - str<- getLine - let n= read str :: Integer - let fct= fact n - print fct - factorials - - -main1= factorials --} - - --- now the workflow versión -data Fact= Fact Integer Integer deriving (Read, Show, Typeable) - -instance IResource Fact where - keyResource _= "lastfact" - serialize= show - deserialize= read - -factorialsWF _= do - all <- getAll - unsafeIOtoWF $ putStrLn "Factorials calculated so far:" - unsafeIOtoWF $ putStrLn $ concatMap (\(Fact n fct)-> "number "++ show n ++ " factorial is "++ show fct++ "\n") all - factLoop (Fact 0 0) - where - - factLoop fct= do - - nf <- step (\_ -> do - putStrLn "give me a number if you enter a letter, the program will abort. Then, please restart to see how the program continues" - str<- getLine - let n= read str :: Integer -- if you enter alphanumeric characters the program will abort. please restart - let fct= fact n - print fct - return $ Fact n fct) fct - - case nf of - Fact 0 _ -> do - unsafeIOtoWF $ print "bye" - return (Fact 0 0) - _ -> factLoop nf - - -main = do - registerType $ Fact 0 0 -- register this datatype - startWF "factorials" (Fact 0 0) [("factorials",factorialsWF)] diff --git a/demos/demoT.hs b/demos/demoT.hs new file mode 100644 --- /dev/null +++ b/demos/demoT.hs @@ -0,0 +1,85 @@ +{-# OPTIONS -fglasgow-exts #-} +-- example of the Workflow package . +-- This demo shows inter-workflow communications. +-- two workflows that interact by modifing the structure "Data". One ask the user for a numbers. When the total number of tries +-- is exhausted, update Data with termination and ends. It can end when termination comes from the other workflow. The other wait for "5", print +-- a message , update Data with termination to the other and finish. t +-- you can break the code at any moment. The flow with re-start in the last interrupted point +-- For bugs, questions, whatever, please email me: Alberto Gómez Corona agocorona@gmail.com + +module Main where +import Data.TCache.Dynamic (IResource(..),registerType) +import Control.Workflow +import Debug.Trace +import Data.Typeable +import Control.Concurrent(forkIO, threadDelay) +import System.Exit + +debug a b = trace b a + + +wfList= [("hello-ask", hello),("wait", wait)] + +-- startWF insert a workflow in the workflow list and start it. if the WF was in a intermediate state, restart it +-- A workflow state is identified by: +-- the name of the workflow +-- the key of the last versión of the object +-- RestartWorkflows restar all workflows in the pending workflow list +-- if startWF is called when startworflow has already restarted a the same workflow + +main= do + registerType :: IO () + registerType :: IO String + registerType :: IO Int + forkIO $ startWF "hello-ask" () wfList + + + startWF "wait" () wfList + +hello _= do + unsafeIOtoWF $ do + putStrLn "" + putStrLn "At any step you can break and re-start the program" + putStrLn "The program will restart at the interrupted step." + putStrLn "" + --syncWrite True -- this is the default + name <- step $ do + print "what is your name?" + getLine + step $ putStrLn $ "hello Mr "++ name + try 0 name + + where + try i name=do + unsafeIOtoWF $ threadDelay 100000 + str <- step $ do + + putStrLn $ "Mr "++name++ " this is your try number "++show (i+1) ++". Guess my number, press \"end\" to finish" + getLine + try (i+1) name + + + + +wait _ = do + let + filter "5" = True + filter "end" = True + filter _= False + r <- step $ waitFor filter "hello-ask" () -- wait the other thread to store an object with the same key than Try 0 "" + -- with the string "5" or termination + case r of + "5" -> step $ do + print "done ! " + delwfs + exitSuccess + + "end" -> step $ print "end received. Bye" >> + delwfs >> + exitSuccess + + where + delwfs= do + delWFHistory "hello-ask" () + delWFHistory "wait" () + diff --git a/demos/fact.hs b/demos/fact.hs new file mode 100644 --- /dev/null +++ b/demos/fact.hs @@ -0,0 +1,68 @@ +{-# OPTIONS -XDeriveDataTypeable #-} +-- this program imput numbers and calculate their factorials. The workflow control a record all the inputs and outputs +-- so that when the program restart, all the previous results are shown. +-- if the program abort by a runtime error or a power failure, the program will still work +-- enter 0 for exit and finalize the workflow (all the intermediate data will be erased) +-- enter any alphanumeric character for aborting and then re-start. + +module Main where +import Control.Workflow +import Data.TCache.Dynamic +import Data.Typeable + +fact 0 =1 +fact n= n * fact (n-1) + +{- +this is the origina program without workflow + +factorials= do + print "give me a number" + str<- getLine + let n= read str :: Integer + let fct= fact n + print fct + factorials + + +main1= factorials +-} + + +-- now the workflow versión +data Fact= Fact Integer Integer deriving (Read, Show, Typeable) + +instance IResource Fact where + keyResource _= "lastfact" + serialize= show + deserialize= read + +factorialsWF _= do + all <- getAll + syncWrite True undefined undefined -- default anyway + unsafeIOtoWF $ putStrLn "Factorials calculated so far:" + unsafeIOtoWF $ putStrLn $ concatMap (\(Fact n fct)-> "number "++ show n ++ " factorial is "++ show fct++ "\n") all + + factLoop (Fact 0 1) + where + + factLoop fct= do + + nf <- plift $ do + putStrLn "give me a number if you enter a letter or 0, the program will abort. Then, please restart to see how the program continues" + str<- getLine + let n= read str :: Integer -- if you enter alphanumeric characters the program will abort. please restart + let fct= fact n + print fct + return $ Fact n fct + + case nf of + Fact 0 _ -> do + unsafeIOtoWF $ print "bye" + return (Fact 0 0) + _ -> factLoop nf + + +main = do + registerType :: IO Fact -- register this datatype + startWF "factorials" (Fact 0 0) [("factorials",factorialsWF)] diff --git a/demos/sequence.hs b/demos/sequence.hs new file mode 100644 --- /dev/null +++ b/demos/sequence.hs @@ -0,0 +1,17 @@ +module Main where +import Control.Workflow +import Control.Concurrent(threadDelay) +import System.IO (hFlush,stdout) + + +mcount n= do + plift $ putStr (show n ++ " ") >> hFlush stdout >> threadDelay 1000000 + mcount (n+1) + + + +main= do + registerType :: IO () + registerType :: IO Int + let start= 0 :: Int + startWF "count" start [("count", mcount)] :: IO () diff --git a/dist/build/autogen/Paths_Workflow.hs b/dist/build/autogen/Paths_Workflow.hs new file mode 100644 --- /dev/null +++ b/dist/build/autogen/Paths_Workflow.hs @@ -0,0 +1,29 @@ +module Paths_Workflow ( + version, + getBinDir, getLibDir, getDataDir, getLibexecDir, + getDataFileName + ) where + +import Data.Version (Version(..)) +import System.Environment (getEnv) + +version :: Version +version = Version {versionBranch = [0,5,5], versionTags = []} + +bindir, libdir, datadir, libexecdir :: FilePath + +bindir = "C:\\Archivos de programa\\Haskell\\bin" +libdir = "C:\\Archivos de programa\\Haskell\\Workflow-0.5.5\\ghc-6.10.3" +datadir = "C:\\Archivos de programa\\Haskell\\Workflow-0.5.5" +libexecdir = "C:\\Archivos de programa\\Haskell\\Workflow-0.5.5" + +getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath +getBinDir = catch (getEnv "Workflow_bindir") (\_ -> return bindir) +getLibDir = catch (getEnv "Workflow_libdir") (\_ -> return libdir) +getDataDir = catch (getEnv "Workflow_datadir") (\_ -> return datadir) +getLibexecDir = catch (getEnv "Workflow_libexecdir") (\_ -> return libexecdir) + +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir ++ "\\" ++ name) diff --git a/dist/build/autogen/cabal_macros.h b/dist/build/autogen/cabal_macros.h new file mode 100644 --- /dev/null +++ b/dist/build/autogen/cabal_macros.h @@ -0,0 +1,44 @@ +/* DO NOT EDIT: This file is automatically generated by Cabal */ + +/* package RefSerialize-0.2.4 */ +#define MIN_VERSION_RefSerialize(major1,major2,minor) \ + (major1) < 0 || \ + (major1) == 0 && (major2) < 2 || \ + (major1) == 0 && (major2) == 2 && (minor) <= 4 + +/* package TCache-0.6.4 */ +#define MIN_VERSION_TCache(major1,major2,minor) \ + (major1) < 0 || \ + (major1) == 0 && (major2) < 6 || \ + (major1) == 0 && (major2) == 6 && (minor) <= 4 + +/* package base-3.0.3.1 */ +#define MIN_VERSION_base(major1,major2,minor) \ + (major1) < 3 || \ + (major1) == 3 && (major2) < 0 || \ + (major1) == 3 && (major2) == 0 && (minor) <= 3 + +/* package containers-0.2.0.1 */ +#define MIN_VERSION_containers(major1,major2,minor) \ + (major1) < 0 || \ + (major1) == 0 && (major2) < 2 || \ + (major1) == 0 && (major2) == 2 && (minor) <= 0 + +/* package mtl-1.1.0.2 */ +#define MIN_VERSION_mtl(major1,major2,minor) \ + (major1) < 1 || \ + (major1) == 1 && (major2) < 1 || \ + (major1) == 1 && (major2) == 1 && (minor) <= 0 + +/* package old-time-1.0.0.2 */ +#define MIN_VERSION_old_time(major1,major2,minor) \ + (major1) < 1 || \ + (major1) == 1 && (major2) < 0 || \ + (major1) == 1 && (major2) == 0 && (minor) <= 0 + +/* package stm-2.1.1.2 */ +#define MIN_VERSION_stm(major1,major2,minor) \ + (major1) < 2 || \ + (major1) == 2 && (major2) < 1 || \ + (major1) == 2 && (major2) == 1 && (minor) <= 1 + diff --git a/dist/doc/Control-Workflow.html b/dist/doc/Control-Workflow.html new file mode 100644 --- /dev/null +++ b/dist/doc/Control-Workflow.html @@ -0,0 +1,2005 @@ + + +Control.Workflow
Workflow-0.5.5: library for transparent execution of interruptible computationsContentsIndex
Control.Workflow
Description

Transparent support for interruptable computations. A workflow can be seen as a persistent thread. +The main features are: +

  • Transparent state logging trough a monad transformer: step :: m a -> Workflow m a. +
  • Resume the computation state after an accidental o planned program shutdown (restartWorkflows). +
  • Event handling (waithFor, waitForData). +
  • Monitoring of workflows with state change display and other auxiliary features. +
  • Communications with other processes including other workflows trough persistent data objects, + inspecttion of intermediate workflow results , Queues so that no data is lost due to shutdowns +

In this way, a very long computation that may take more time than the average time between +hardware or software failures, shutdowns etc. The workflow can be defined transparently in a single monadic procedure. +Besides state logging and recovery, there are a number of communication primitives that are aware +of persistence across reinitiations such are persistent queues, persistent timeouts, or wait for events + in the STM monad. These primitives permits inter-woikflow communications and communications with + external threads. +

This package uses TCache for persistence and event handling. +

It also uses the package Refserialize. This package permits to reduce the workflow state load, + since the RefSerialize package permits to serialize and deserialize complex and autoreferenced data structures without + loosing such references, this is critical when big and structured data, such are documents, suffer little + modifications across a set of workflow steps. Therefore, it is also recommended to use Refserialize for + big user-defined objects that have small pieces that suffer little modifications during the workflow. As an + added bonus, the history will show such changes with more detail. +

The step primitive is the lift operation that converts a result of type m a to a type Workflow m a +with automatic state loggin and recovery. To allow such features, Every a must be instance of +Typeable and IResource (defined in the TCache package). +

In fact, Workflow can be considered as an instance of a partial monad transformed. defined as such: +

class PMonadTrans  t m a  where
+
+plift :: Monad m => m a -> t m a
+
+instance  (Monad m,MonadIO m, IResource  a, Typeable a)
+
+=> PMonadTrans (WF Stat)  m a where
+
+plift = step
+

It is partial because the lift operation is not defined for every monad m and data type a , but for monads and data +types that meet certain conditions. In this case, to be instances of MonadIO, IResource and Typeable respectively. +

to avoid to define the last two interfaces however, Read and Show' can be used to derive instances of IResource + for most of the useful cases. This is the set of automatic derivations: +

(Read a, Show a) =>  Serialize a
+
+Typeable a => Indexable a    (a single key for all values. enough for workflows)
+
+(Indexable a, Serialize a) => IResource a

Therefore deriving to be instance of Read, Show is enough for every intermediate data result along the computation +

Because Data.TCache.Dynamic from the package TCache is used for persistence, every data type must be registered +by using registerType +

Here is a compkete example: This is a counter that shows a sequence of numbers, one a second: +

module Main where
+import Control.Concurrent(threadDelay)
+import System.IO (hFlush,stdout)
+
+count n= do
+                    putStr (show n ++  ) >> hFlush stdout >> threadDelay 1000000
+                    count (n+1)
+
+main= count 0

This is the same program, with the added feature of remembering the last count after interrupted: +

module Main where
+import Control.Workflow
+import Control.Concurrent(threadDelay)
+import System.IO (hFlush,stdout)
+
+mcount n= do
+            step $  putStr (show n ++  ) >> hFlush stdout >> threadDelay 1000000
+            mcount (n+1)
+
+main= do
+   registerType :: IO ()
+   registerType :: IO Int
+   let start= 0 :: Int
+   startWF  count  start   [(count, mcount)] :: IO ()

This is the execution log: +

Worflow-0.5.5demos>runghc sequence.hs
+0 1 2 3 4 5 6 7 sequence.hs: win32ConsoleHandler
+sequence.hs: sequence.hs: interrupted
+Worflow-0.5.5demos>
+Worflow-0.5.5demos>runghc sequence.hs
+7 8 9 10 11 ....
Synopsis
type Workflow m l = WF Stat m l
type WorkflowList m a b = [(String, a -> Workflow m b)]
IResource (keyResource, serialize, deserialize, tshowp, treadp, defPath, readResource, writeResource, delResource)
registerType
class PMonadTrans t m a where
plift :: Monad m => m a -> t m a
class Indexable a where
key :: a -> String
step :: (Monad m, MonadIO m, IResource a, Typeable a) => m a -> Workflow m a
startWF :: (Monad m, MonadIO m, IResource a, Typeable a, IResource b, Typeable b) => String -> a -> WorkflowList m a b -> m b
restartWorkflows :: (IResource a, Typeable a, IResource b, Typeable b) => WorkflowList IO a b -> IO ()
getStep :: (IResource a, Typeable a, Monad m) => Int -> Workflow m a
getAll :: (IResource a, Typeable a, Monad m) => WF Stat m [a]
logWF :: (Monad m, MonadIO m) => String -> Workflow m ()
getWFKeys :: String -> IO [String]
getWFHistory :: IResource a => String -> a -> IO (Maybe Stat)
delWFHistory :: IResource a => String -> a -> IO ()
printHistory :: Stat -> IO ()
unsafeIOtoWF :: Monad m => IO a -> Workflow m a
waitFor :: (IResource a, Typeable a, IResource b, Typeable b) => (b -> Bool) -> String -> a -> IO b
waitUntil :: Integer -> IO ()
waitUntilSTM :: TVar Bool -> STM ()
syncWrite :: (Monad m, MonadIO m) => Bool -> Int -> Int -> WF Stat m ()
writeQueue :: (IResource a, Typeable a) => String -> a -> IO ()
writeQueueSTM :: (IResource a, Typeable a) => String -> a -> STM ()
readQueue :: (IResource a, Typeable a) => String -> IO a
readQueueSTM :: (IResource a, Typeable a) => String -> STM a
unreadQueue :: (IResource a, Typeable a) => String -> a -> IO ()
unreadQueueSTM :: (IResource a, Typeable a) => String -> a -> STM ()
getTimeSeconds :: IO Integer
getTimeoutFlag :: MonadIO m => Integer -> Workflow m (TVar Bool)
isEmptyQueue
isEmptyQueueSTM :: String -> STM Bool
Documentation
type Workflow m l = WF Stat m l
type WorkflowList m a b = [(String, a -> Workflow m b)]
IResource (keyResource, serialize, deserialize, tshowp, treadp, defPath, readResource, writeResource, delResource)
registerType
class PMonadTrans t m a where
PMonadTrans permits |to define a partial monad transformer. They are not defined for all kinds of data +but the ones that have instances of certain classes.That is because in the lift instance code there are some +hidden use of these classes. This also may permit an accurate control of effects. +An instance of MonadTrans is an instance of PMonadTrans +
Methods
plift :: Monad m => m a -> t m a
show/hide Instances
(Monad m, MonadIO m, IResource a, Typeable a) => PMonadTrans (WF Stat) m a
class Indexable a where

Indexablle can be used to derive instances of IResource + This is the set of automatic derivations: +

  • (Read a, Show a) => Serialize a +
  • Typeable a => Indexable a (a single key for all values. enough for workflows) +
  • (Indexable a, Serialize a) => IResource a +
Methods
key :: a -> String
step :: (Monad m, MonadIO m, IResource a, Typeable a) => m a -> Workflow m a
step lifts a monadic computation to the WF monad, and provides transparent state loging and resume of computation +
startWF
:: (Monad m, MonadIO m, IResource a, Typeable a, IResource b, Typeable b)
=> Stringname of workflow in the workflow list +
-> ainitial value (even use the initial value even to restart the workflow) +
-> WorkflowList m a bworkflow list. t is an assoc-list of (workflow name string,Workflow methods) +
-> m bresult of the computation +
start or continue a workflow. +
restartWorkflows :: (IResource a, Typeable a, IResource b, Typeable b) => WorkflowList IO a b -> IO ()
re-start the non finished workflows started for all initial values that are listed in the workflow list +
getStep
:: (IResource a, Typeable a, Monad m)
=> Intthe step number. If negative, count from the current state backwards +
-> Workflow m areturn the n-tn intermediate step result +
getAll :: (IResource a, Typeable a, Monad m) => WF Stat m [a]
return all the intermediate results. it is supposed that all the intermediate result have + the same type. +
logWF :: (Monad m, MonadIO m) => String -> Workflow m ()
log a message in the workflow history. I can be printed out with printWFhistory +
getWFKeys :: String -> IO [String]
return the list of object keys that are running +
getWFHistory :: IResource a => String -> a -> IO (Maybe Stat)
return the current state of the computation, in the IO monad +
delWFHistory :: IResource a => String -> a -> IO ()
delete the workflow. Make sure that the workdlow is not running +
printHistory :: Stat -> IO ()
print the state changes along the workflow, that is, all the intermediate results +
unsafeIOtoWF :: Monad m => IO a -> Workflow m a

executes a IO computation inside of the workflow monad whatever the monad encapsulated in the workflow. + Warning: this computation is executed whenever + the workflow restarts, no matter if it has been already executed previously. This is useful for intializations or debugging. + To avoid re-execution when restarting use: step $ unsafeIOtoWF... +

To perform IO actions in a workflow that encapsulates an IO monad, use step over the IO action directly: +

 step $ action

instead of +

  step $ unsafeIOtoWF $ action
waitFor
:: (IResource a, Typeable a, IResource b, Typeable b)
=> b -> BoolThe condition that the retrieved object must meet +
-> StringThe workflow name +
-> athe INITIAL value used in the workflow to start it +
-> IO bThe first event that meet the condition +
waitUntil :: Integer -> IO ()
waitUntilSTM :: TVar Bool -> STM ()

wait until a certain clock time, in the STM monad. + This permits to compose timeouts with locks waiting for data. +

  • example: wait for any respoinse from a Queue if no response is given in 5 minutes, it is returned True. +
+            flag <- getTimeoutFlag $  5 * 60
+            ap - step  .  atomically $  readQueueSTM docQueue  `orElse`  waitUntilSTM flag  > return True
+            case ap of
+                    False -> logWF False or timeout >> correctWF doc
+                    True -> do
+
syncWrite
:: (Monad m, MonadIO m)
=> BoolTrue means syncronoys: changes are inmediately saved after each step +
-> Intnumber of seconds between saves when asyncronous +
-> Intsize of the cache when async +
-> WF Stat m ()in the workflow monad +
change the logging policy (default is syncronous) + Workflow uses the package TCache for logging + for very fast workflow steps or when TCache is used also for other purposes , asyncronous is a better option +
writeQueue :: (IResource a, Typeable a) => String -> a -> IO ()
insert an element on top of the Queue Stack +
writeQueueSTM :: (IResource a, Typeable a) => String -> a -> STM ()
Like writeQueue, but in the STM monad +
readQueue
:: (IResource a, Typeable a)
=> StringQueue name +
-> IO athe returned elems +
delete elements from the Queue stack and return them in the IO monad +
readQueueSTM :: (IResource a, Typeable a) => String -> STM a
delete elements from the Queue stack an return them. in the STM monad +
unreadQueue :: (IResource a, Typeable a) => String -> a -> IO ()
unreadQueueSTM :: (IResource a, Typeable a) => String -> a -> STM ()
getTimeSeconds :: IO Integer
getTimeoutFlag :: MonadIO m => Integer -> Workflow m (TVar Bool)
start the timeout and return the flag to be monitored by waitUntilSTM +
isEmptyQueue
isEmptyQueueSTM :: String -> STM Bool
Produced by Haddock version 2.4.2
diff --git a/dist/doc/Workflow.haddock b/dist/doc/Workflow.haddock new file mode 100644 Binary files /dev/null and b/dist/doc/Workflow.haddock differ diff --git a/dist/doc/doc-index.html b/dist/doc/doc-index.html new file mode 100644 --- /dev/null +++ b/dist/doc/doc-index.html @@ -0,0 +1,366 @@ + + +Workflow-0.5.5: library for transparent execution of interruptible computations (Index)
Workflow-0.5.5: library for transparent execution of interruptible computationsContentsIndex
Search:
defPathControl.Workflow
delResourceControl.Workflow
delWFHistoryControl.Workflow
deserializeControl.Workflow
getAllControl.Workflow
getStepControl.Workflow
getTimeoutFlagControl.Workflow
getTimeSecondsControl.Workflow
getWFHistoryControl.Workflow
getWFKeysControl.Workflow
IndexableControl.Workflow
IResourceControl.Workflow
isEmptyQueueControl.Workflow
isEmptyQueueSTMControl.Workflow
keyControl.Workflow
keyResourceControl.Workflow
logWFControl.Workflow
pliftControl.Workflow
PMonadTransControl.Workflow
printHistoryControl.Workflow
readQueueControl.Workflow
readQueueSTMControl.Workflow
readResourceControl.Workflow
registerTypeControl.Workflow
restartWorkflowsControl.Workflow
serializeControl.Workflow
startWFControl.Workflow
stepControl.Workflow
syncWriteControl.Workflow
treadpControl.Workflow
tshowpControl.Workflow
unreadQueueControl.Workflow
unreadQueueSTMControl.Workflow
unsafeIOtoWFControl.Workflow
waitForControl.Workflow
waitUntilControl.Workflow
waitUntilSTMControl.Workflow
WorkflowControl.Workflow
WorkflowListControl.Workflow
writeQueueControl.Workflow
writeQueueSTMControl.Workflow
writeResourceControl.Workflow
diff --git a/dist/doc/frames.html b/dist/doc/frames.html new file mode 100644 --- /dev/null +++ b/dist/doc/frames.html @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + diff --git a/dist/doc/haddock-util.js b/dist/doc/haddock-util.js new file mode 100644 --- /dev/null +++ b/dist/doc/haddock-util.js @@ -0,0 +1,139 @@ +// Haddock JavaScript utilities +function toggle(button,id) +{ + var n = document.getElementById(id).style; + if (n.display == "none") + { + button.src = "minus.gif"; + n.display = "block"; + } + else + { + button.src = "plus.gif"; + n.display = "none"; + } +} + + +var max_results = 75; // 50 is not enough to search for map in the base libraries +var shown_range = null; +var last_search = null; + +function quick_search() +{ + perform_search(false); +} + +function full_search() +{ + perform_search(true); +} + + +function perform_search(full) +{ + var text = document.getElementById("searchbox").value.toLowerCase(); + if (text == last_search && !full) return; + last_search = text; + + var table = document.getElementById("indexlist"); + var status = document.getElementById("searchmsg"); + var children = table.firstChild.childNodes; + + // first figure out the first node with the prefix + var first = bisect(-1); + var last = (first == -1 ? -1 : bisect(1)); + + if (first == -1) + { + table.className = ""; + status.innerHTML = "No results found, displaying all"; + } + else if (first == 0 && last == children.length - 1) + { + table.className = ""; + status.innerHTML = ""; + } + else if (last - first >= max_results && !full) + { + table.className = ""; + status.innerHTML = "More than " + max_results + ", press Search to display"; + } + else + { + // decide what you need to clear/show + if (shown_range) + setclass(shown_range[0], shown_range[1], "indexrow"); + setclass(first, last, "indexshow"); + shown_range = [first, last]; + table.className = "indexsearch"; + status.innerHTML = ""; + } + + + function setclass(first, last, status) + { + for (var i = first; i <= last; i++) + { + children[i].className = status; + } + } + + + // do a binary search, treating 0 as ... + // return either -1 (no 0's found) or location of most far match + function bisect(dir) + { + var first = 0, finish = children.length - 1; + var mid, success = false; + + while (finish - first > 3) + { + mid = Math.floor((finish + first) / 2); + + var i = checkitem(mid); + if (i == 0) i = dir; + if (i == -1) + finish = mid; + else + first = mid; + } + var a = (dir == 1 ? first : finish); + var b = (dir == 1 ? finish : first); + for (var i = b; i != a - dir; i -= dir) + { + if (checkitem(i) == 0) return i; + } + return -1; + } + + + // from an index, decide what the result is + // 0 = match, -1 is lower, 1 is higher + function checkitem(i) + { + var s = getitem(i).toLowerCase().substr(0, text.length); + if (s == text) return 0; + else return (s > text ? -1 : 1); + } + + + // from an index, get its string + // this abstracts over alternates + function getitem(i) + { + for ( ; i >= 0; i--) + { + var s = children[i].firstChild.firstChild.data; + if (s.indexOf(' ') == -1) + return s; + } + return ""; // should never be reached + } +} + +function setSynopsis(filename) { + if (parent.window.synopsis) { + parent.window.synopsis.location = filename; + } +} diff --git a/dist/doc/haddock.css b/dist/doc/haddock.css new file mode 100644 --- /dev/null +++ b/dist/doc/haddock.css @@ -0,0 +1,297 @@ +/* -------- Global things --------- */ + +BODY { + background-color: #ffffff; + color: #000000; + font-family: sans-serif; + padding: 0 0; + } + +A:link { color: #0000e0; text-decoration: none } +A:visited { color: #0000a0; text-decoration: none } +A:hover { background-color: #e0e0ff; text-decoration: none } + +TABLE.vanilla { + width: 100%; + border-width: 0px; + /* I can't seem to specify cellspacing or cellpadding properly using CSS... */ +} + +TABLE.vanilla2 { + border-width: 0px; +} + +/* font is a little too small in MSIE */ +TT { font-size: 100%; } +PRE { font-size: 100%; } + +LI P { margin: 0pt } + +TD { + border-width: 0px; +} + +TABLE.narrow { + border-width: 0px; +} + +TD.s8 { height: 8px; } +TD.s15 { height: 15px; } + +SPAN.keyword { text-decoration: underline; } + +/* Resize the buttom image to match the text size */ +IMG.coll { width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em } + +/* --------- Contents page ---------- */ + +DIV.node { + padding-left: 3em; +} + +DIV.cnode { + padding-left: 1.75em; +} + +SPAN.pkg { + position: absolute; + left: 50em; +} + +/* --------- Documentation elements ---------- */ + +TD.children { + padding-left: 25px; + } + +TD.synopsis { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace + } + +TD.decl { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace; + vertical-align: top; + } + +TD.topdecl { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace; + vertical-align: top; +} + +TABLE.declbar { + border-spacing: 0px; + } + +TD.declname { + width: 100%; + } + +TD.declbut { + padding-left: 5px; + padding-right: 5px; + border-left-width: 1px; + border-left-color: #000099; + border-left-style: solid; + white-space: nowrap; + font-size: small; + } + +/* + arg is just like decl, except that wrapping is not allowed. It is + used for function and constructor arguments which have a text box + to the right, where if wrapping is allowed the text box squashes up + the declaration by wrapping it. +*/ +TD.arg { + padding: 2px; + background-color: #f0f0f0; + font-family: monospace; + vertical-align: top; + white-space: nowrap; + } + +TD.recfield { padding-left: 20px } + +TD.doc { + padding-top: 2px; + padding-left: 10px; + } + +TD.ndoc { + padding: 2px; + } + +TD.rdoc { + padding: 2px; + padding-left: 10px; + width: 100%; + } + +TD.body { + padding-left: 10px + } + +TD.pkg { + width: 100%; + padding-left: 10px +} + +TABLE.indexsearch TR.indexrow { + display: none; +} +TABLE.indexsearch TR.indexshow { + display: table-row; +} + +TD.indexentry { + vertical-align: top; + padding-right: 10px + } + +TD.indexannot { + vertical-align: top; + padding-left: 20px; + white-space: nowrap + } + +TD.indexlinks { + width: 100% + } + +/* ------- Section Headings ------- */ + +TD.section1 { + padding-top: 15px; + font-weight: bold; + font-size: 150% + } + +TD.section2 { + padding-top: 10px; + font-weight: bold; + font-size: 130% + } + +TD.section3 { + padding-top: 5px; + font-weight: bold; + font-size: 110% + } + +TD.section4 { + font-weight: bold; + font-size: 100% + } + +/* -------------- The title bar at the top of the page */ + +TD.infohead { + color: #ffffff; + font-weight: bold; + padding-right: 10px; + text-align: left; +} + +TD.infoval { + color: #ffffff; + padding-right: 10px; + text-align: left; +} + +TD.topbar { + background-color: #000099; + padding: 5px; +} + +TD.title { + color: #ffffff; + padding-left: 10px; + width: 100% + } + +TD.topbut { + padding-left: 5px; + padding-right: 5px; + border-left-width: 1px; + border-left-color: #ffffff; + border-left-style: solid; + white-space: nowrap; + } + +TD.topbut A:link { + color: #ffffff + } + +TD.topbut A:visited { + color: #ffff00 + } + +TD.topbut A:hover { + background-color: #6060ff; + } + +TD.topbut:hover { + background-color: #6060ff + } + +TD.modulebar { + background-color: #0077dd; + padding: 5px; + border-top-width: 1px; + border-top-color: #ffffff; + border-top-style: solid; + } + +/* --------- The page footer --------- */ + +TD.botbar { + background-color: #000099; + color: #ffffff; + padding: 5px + } +TD.botbar A:link { + color: #ffffff; + text-decoration: underline + } +TD.botbar A:visited { + color: #ffff00 + } +TD.botbar A:hover { + background-color: #6060ff + } + +/* --------- Mini Synopsis for Frame View --------- */ + +.outer { + margin: 0 0; + padding: 0 0; +} + +.mini-synopsis { + padding: 0.25em 0.25em; +} + +.mini-synopsis H1 { font-size: 130%; } +.mini-synopsis H2 { font-size: 110%; } +.mini-synopsis H3 { font-size: 100%; } +.mini-synopsis H1, .mini-synopsis H2, .mini-synopsis H3 { + margin-top: 0.5em; + margin-bottom: 0.25em; + padding: 0 0; +} + +.mini-synopsis H1 { border-bottom: 1px solid #ccc; } + +.mini-topbar { + font-size: 130%; + background: #0077dd; + padding: 0.25em; +} + + diff --git a/dist/doc/haskell_icon.gif b/dist/doc/haskell_icon.gif new file mode 100644 Binary files /dev/null and b/dist/doc/haskell_icon.gif differ diff --git a/dist/doc/index-frames.html b/dist/doc/index-frames.html new file mode 100644 --- /dev/null +++ b/dist/doc/index-frames.html @@ -0,0 +1,22 @@ + + +Workflow-0.5.5: library for transparent execution of interruptible computations

Control.Workflow

diff --git a/dist/doc/index.html b/dist/doc/index.html new file mode 100644 --- /dev/null +++ b/dist/doc/index.html @@ -0,0 +1,125 @@ + + +Workflow-0.5.5: library for transparent execution of interruptible computations
Workflow-0.5.5: library for transparent execution of interruptible computationsContentsIndex
Workflow-0.5.5: library for transparent execution of interruptible computations

Transparent support for interruptable computations. A workflow can be seen as a persistent thread that executes any +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 +failures, timeouts or shutdowns. +

The computantion can be restarted at the interrupted point because such monad is encapsulated inside +a state monad transformer that transparently checkpoint the computation state. Besides that, the package also provides +other services associated to workflows +The main features are: +

  • logging of each intermediate action results in disk. +
  • resume the monadic computation at the last checkpoint after soft or hard interruption. +
  • suspend a computation until the input object meet certain conditions. useful for inter-workflow comunications.- +
  • Communications with other processes including other workflows trough persistent data objects, +inspection of intermediate workflow results , persistent queues, persistent timeouts so that no data is lost due +to shutdowns +
  • A workflow can initiate anoter workflow and wait for the resutl +
  • workflow management and monitoriing, view workflow history and intermediate results. +
Modules
show/hideControl
Control.Workflow
Produced by Haddock version 2.4.2
diff --git a/dist/doc/mini_Control-Workflow.html b/dist/doc/mini_Control-Workflow.html new file mode 100644 --- /dev/null +++ b/dist/doc/mini_Control-Workflow.html @@ -0,0 +1,141 @@ + + +Control.Workflow
Control.Workflow
type Workflow m l
type WorkflowList m a b
class PMonadTrans t m a
class Indexable a
step
startWF
restartWorkflows
getStep
getAll
logWF
getWFKeys
getWFHistory
delWFHistory
printHistory
unsafeIOtoWF
waitFor
waitUntil
waitUntilSTM
syncWrite
writeQueue
writeQueueSTM
readQueue
readQueueSTM
unreadQueue
unreadQueueSTM
getTimeSeconds
getTimeoutFlag
isEmptyQueueSTM
diff --git a/dist/doc/minus.gif b/dist/doc/minus.gif new file mode 100644 Binary files /dev/null and b/dist/doc/minus.gif differ diff --git a/dist/doc/plus.gif b/dist/doc/plus.gif new file mode 100644 Binary files /dev/null and b/dist/doc/plus.gif differ diff --git a/dist/installed-pkg-config b/dist/installed-pkg-config new file mode 100644 --- /dev/null +++ b/dist/installed-pkg-config @@ -0,0 +1,52 @@ +name: Workflow +version: 0.5.5 +license: BSD3 +copyright: +maintainer: agocorona@gmail.com +stability: experimental +homepage: +package-url: +description: Transparent support for interruptable computations. A workflow can be seen as a persistent thread that executes any + 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 + failures, timeouts or shutdowns. + . + The computantion can be restarted at the interrupted point because such monad is encapsulated inside + a state monad transformer that transparently checkpoint the computation state. Besides that, the package also provides + other services associated to workflows + The main features are: + . + * logging of each intermediate action results in disk. + . + * resume the monadic computation at the last checkpoint after soft or hard interruption. + . + * suspend a computation until the input object meet certain conditions. useful for inter-workflow comunications.- + . + * Communications with other processes including other workflows trough persistent data objects, + inspection of intermediate workflow results , persistent queues, persistent timeouts so that no data is lost due + to shutdowns + . + * A workflow can initiate anoter workflow and wait for the resutl + . + * workflow management and monitoriing, view workflow history and intermediate results. +category: Control, Workflow, Concurrent, Middleware +author: Alberto Gómez Corona +exposed: True +exposed-modules: Control.Workflow +hidden-modules: +import-dirs: "C:\\Archivos de programa\\Haskell\\Workflow-0.5.5\\ghc-6.10.3" +library-dirs: "C:\\Archivos de programa\\Haskell\\Workflow-0.5.5\\ghc-6.10.3" +hs-libraries: HSWorkflow-0.5.5 +extra-libraries: +extra-ghci-libraries: +include-dirs: +includes: +depends: RefSerialize-0.2.4 TCache-0.6.4 base-3.0.3.1 + containers-0.2.0.1 mtl-1.1.0.2 old-time-1.0.0.2 stm-2.1.1.2 +hugs-options: +cc-options: +ld-options: +framework-dirs: +frameworks: +haddock-interfaces: "C:\\Archivos de programa\\Haskell\\doc\\Workflow-0.5.5\\html\\Workflow.haddock" +haddock-html: "C:\\Archivos de programa\\Haskell\\doc\\Workflow-0.5.5\\html" diff --git a/dist/setup-config b/dist/setup-config new file mode 100644 --- /dev/null +++ b/dist/setup-config @@ -0,0 +1,2 @@ +Saved package config for Workflow-0.5.5 written by Cabal-1.6.0.3 using ghc-6.10 +LocalBuildInfo {installDirTemplates = InstallDirs {prefix = "C:\\Archivos de programa\\Haskell", bindir = "$prefix\\bin", libdir = "$prefix", libsubdir = "$pkgid\\$compiler", dynlibdir = "$libdir", libexecdir = "$prefix\\$pkgid", progdir = "$libdir\\hugs\\programs", includedir = "$libdir\\$libsubdir\\include", datadir = "C:\\Archivos de programa\\Haskell", datasubdir = "$pkgid", docdir = "$prefix\\doc\\$pkgid", mandir = "$datadir\\man", htmldir = "$docdir\\html", haddockdir = "$htmldir"}, compiler = Compiler {compilerId = CompilerId GHC (Version {versionBranch = [6,10,3], versionTags = []}), compilerExtensions = [(CPP,"-XCPP"),(PostfixOperators,"-XPostfixOperators"),(PatternGuards,"-XPatternGuards"),(UnicodeSyntax,"-XUnicodeSyntax"),(MagicHash,"-XMagicHash"),(PolymorphicComponents,"-XPolymorphicComponents"),(ExistentialQuantification,"-XExistentialQuantification"),(KindSignatures,"-XKindSignatures"),(EmptyDataDecls,"-XEmptyDataDecls"),(ParallelListComp,"-XParallelListComp"),(TransformListComp,"-XTransformListComp"),(ForeignFunctionInterface,"-XForeignFunctionInterface"),(UnliftedFFITypes,"-XUnliftedFFITypes"),(LiberalTypeSynonyms,"-XLiberalTypeSynonyms"),(Rank2Types,"-XRank2Types"),(RankNTypes,"-XRankNTypes"),(ImpredicativeTypes,"-XImpredicativeTypes"),(TypeOperators,"-XTypeOperators"),(RecursiveDo,"-XRecursiveDo"),(Arrows,"-XArrows"),(UnknownExtension "PArr","-XPArr"),(TemplateHaskell,"-XTemplateHaskell"),(QuasiQuotes,"-XQuasiQuotes"),(Generics,"-XGenerics"),(NoImplicitPrelude,"-XNoImplicitPrelude"),(RecordWildCards,"-XRecordWildCards"),(NamedFieldPuns,"-XNamedFieldPuns"),(RecordPuns,"-XRecordPuns"),(DisambiguateRecordFields,"-XDisambiguateRecordFields"),(OverloadedStrings,"-XOverloadedStrings"),(GADTs,"-XGADTs"),(ViewPatterns,"-XViewPatterns"),(TypeFamilies,"-XTypeFamilies"),(BangPatterns,"-XBangPatterns"),(NoMonomorphismRestriction,"-XNoMonomorphismRestriction"),(NoMonoPatBinds,"-XNoMonoPatBinds"),(RelaxedPolyRec,"-XRelaxedPolyRec"),(ExtendedDefaultRules,"-XExtendedDefaultRules"),(ImplicitParams,"-XImplicitParams"),(ScopedTypeVariables,"-XScopedTypeVariables"),(PatternSignatures,"-XPatternSignatures"),(UnboxedTuples,"-XUnboxedTuples"),(StandaloneDeriving,"-XStandaloneDeriving"),(DeriveDataTypeable,"-XDeriveDataTypeable"),(TypeSynonymInstances,"-XTypeSynonymInstances"),(FlexibleContexts,"-XFlexibleContexts"),(FlexibleInstances,"-XFlexibleInstances"),(ConstrainedClassMethods,"-XConstrainedClassMethods"),(MultiParamTypeClasses,"-XMultiParamTypeClasses"),(FunctionalDependencies,"-XFunctionalDependencies"),(GeneralizedNewtypeDeriving,"-XGeneralizedNewtypeDeriving"),(OverlappingInstances,"-XOverlappingInstances"),(UndecidableInstances,"-XUndecidableInstances"),(IncoherentInstances,"-XIncoherentInstances"),(PackageImports,"-XPackageImports"),(NewQualifiedOperators,"-XNewQualifiedOperators")]}, buildDir = "dist\\build", scratchDir = "dist\\scratch", packageDeps = [PackageIdentifier {pkgName = PackageName "RefSerialize", pkgVersion = Version {versionBranch = [0,2,4], versionTags = []}},PackageIdentifier {pkgName = PackageName "TCache", pkgVersion = Version {versionBranch = [0,6,4], versionTags = []}},PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [3,0,3,1], versionTags = []}},PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,2,0,1], versionTags = []}},PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [1,1,0,2], versionTags = []}},PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,2], versionTags = []}},PackageIdentifier {pkgName = PackageName "stm", pkgVersion = Version {versionBranch = [2,1,1,2], versionTags = []}}], installedPkgs = PackageIndex (fromList [(PackageName "RefSerialize",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "RefSerialize", pkgVersion = Version {versionBranch = [0,2,4], versionTags = []}}, license = BSD3, copyright = "", maintainer = "agocorona@gmail.com", author = "Alberto G\243mez Corona", stability = "", homepage = "", pkgUrl = "", description = "Read, Show and Data.Binary do not check for repeated references to the same address.\nAs a result, the data is duplicated when serialized. This is a waste of space in the filesystem\nand also a waste of serialization time. but the worst consequence is that, when the serialized data is read,\nit allocates multiple copies for the same object when referenced multiple times. Because multiple referenced\ndata is very typical in a pure language such is Haskell, this means that the resulting data loose the beatiful\neconomy of space and processing time that referential transparency permits.\nEvery instance of Show/Read is also a instance of Data.RefSerialize.\nThis package allows the serialization and deserialization of large data structures without duplication of data, with\nthe result of optimized performance and memory usage. It is also useful for debugging purposes.\nThere are automatic derived instances for instances of Read/Show. Lists of non-chars have its own instance.\nThe deserializer contains a subset of Parsec.Token for defining deserializing parsers.\nthe serialized string has the form \"expr( var1, ...varn) where var1=value1,..valn=valueN \" so that the\nstring can be EVALuated. So the entire deserialization can be substituted by eval.\nSee demo.hs and tutorial. I presumably will add a entry in haskell-web.blogspot.com\nin this release:.\n* Proper trailing withespace handlling for instances of Read\n* Error handllig for instances of Read.\nTo do: -derived instances for Data.Binary\n-serialization to/from ByteStings", category = "Parsing", exposed = True, exposedModules = [ModuleName ["Data","RefSerialize"],ModuleName ["Data","Parser"],ModuleName ["Data","Serialize"]], hiddenModules = [], importDirs = ["C:\\Archivos de programa\\Haskell\\RefSerialize-0.2.4\\ghc-6.10.3"], libraryDirs = ["C:\\Archivos de programa\\Haskell\\RefSerialize-0.2.4\\ghc-6.10.3"], hsLibraries = ["HSRefSerialize-0.2.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,2,0,1], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\Archivos de programa\\Haskell\\doc\\RefSerialize-0.2.4\\html\\RefSerialize.haddock"], haddockHTMLs = ["C:\\Archivos de programa\\Haskell\\doc\\RefSerialize-0.2.4\\html"]}]),(PackageName "TCache",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "TCache", pkgVersion = Version {versionBranch = [0,6,4], versionTags = []}}, license = BSD3, copyright = "", maintainer = "agocorona@gmail.com", author = "Alberto G\243mez Corona", stability = "", homepage = "", pkgUrl = "", description = "Data.Tcache is a transactional cache with configurable persistence. It tries to simulate Hibernate\nfor Java or Rails for Ruby. The main difference is that transactions are done in memory trough STM.\nThere are transactional cache implementations for some J2EE servers like JBOSS.\n\nTCache uses STM. It can atomically apply a function to a list of cached objects. The resulting\nobjects go back to the cache (withResources). It also can retrieve these objects (getResources).\nPersistence can be syncronous (syncCache) or asyncronous, wtih configurable time between cache\nwrites and configurable cache clearance strategy. the size of the cache can be configured too .\nAll of this can be done trough clearSyncCacheProc. Even the TVar variables can be accessed\ndirectly (getTVar) to acceess all the semantic of atomic blocks while maintaining the persistence of the\nTVar updates.\n\nPersistence can be defined for each object: Each object must have a defined key, a default filename\npath (if applicable). Persistence is pre-defined in files, but the readResource writeResource and\ndelResource methods can be redefined to persist in databases or whatever.\n\nSerialization is also configurable.\n\nThere are Samples here that explain the main features.\n\nIn this release\n\n* added withSTMResources. Most of the rest of the methods are derived from withSTMResources . the results are returned in the STM monad, so this method can be part of al larger STM transaction\nIt also can perforn used defined retries.\n\n* added modules for cached TMVars\nData.TCache.TMVar and Data.TCache.TMVar.Dynamic uses TMVars instead of TVars (See Control.Concurrent.STM.TMVar)\n\nIt is not possible tu mix TVars and TMVars packages in the same executable. However code that uses dynamic and non dynamic can\ncan be mixed\n\n* Data.TCache - cached TVars of object of type a.\n\n* Data.TCache.Dynamic - cached TVars of objects of type IDynamic.\n\n* Data.TCache.TMVar - cached TMVars of objects of type a.\n\n* Data.TCache..TMVar.Dynamic - cached TMVars of objects of type IDynamic.", category = "Middleware, Data, Database, Concurrency", exposed = True, exposedModules = [ModuleName ["Data","TCache"],ModuleName ["Data","TCache","IResource"],ModuleName ["Data","TCache","Dynamic"],ModuleName ["Data","TCache","TMVar"],ModuleName ["Data","TCache","TMVar","Dynamic"],ModuleName ["Data","TCache","IDynamic"]], hiddenModules = [], importDirs = ["C:\\Archivos de programa\\Haskell\\TCache-0.6.4\\ghc-6.10.3"], libraryDirs = ["C:\\Archivos de programa\\Haskell\\TCache-0.6.4\\ghc-6.10.3"], hsLibraries = ["HSTCache-0.6.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "RefSerialize", pkgVersion = Version {versionBranch = [0,2,4], versionTags = []}},PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [3,0,3,1], versionTags = []}},PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,2,0,1], versionTags = []}},PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}},PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,2], versionTags = []}},PackageIdentifier {pkgName = PackageName "stm", pkgVersion = Version {versionBranch = [2,1,1,2], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\Archivos de programa\\Haskell\\doc\\TCache-0.6.4\\html\\TCache.haddock"], haddockHTMLs = ["C:\\Archivos de programa\\Haskell\\doc\\TCache-0.6.4\\html"]}]),(PackageName "Win32",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "Win32", pkgVersion = Version {versionBranch = [2,2,0,0], versionTags = []}}, license = BSD3, copyright = "Alastair Reid, 1999-2003", maintainer = "Esa Ilari Vuokko ", author = "Alastair Reid", stability = "", homepage = "", pkgUrl = "", description = "", category = "System, Graphics", exposed = True, exposedModules = [ModuleName ["Graphics","Win32","GDI"],ModuleName ["Graphics","Win32","GDI","Bitmap"],ModuleName ["Graphics","Win32","GDI","Brush"],ModuleName ["Graphics","Win32","GDI","Clip"],ModuleName ["Graphics","Win32","GDI","Font"],ModuleName ["Graphics","Win32","GDI","Graphics2D"],ModuleName ["Graphics","Win32","GDI","HDC"],ModuleName ["Graphics","Win32","GDI","Palette"],ModuleName ["Graphics","Win32","GDI","Path"],ModuleName ["Graphics","Win32","GDI","Pen"],ModuleName ["Graphics","Win32","GDI","Region"],ModuleName ["Graphics","Win32","GDI","Types"],ModuleName ["Graphics","Win32"],ModuleName ["Graphics","Win32","Control"],ModuleName ["Graphics","Win32","Dialogue"],ModuleName ["Graphics","Win32","Icon"],ModuleName ["Graphics","Win32","Key"],ModuleName ["Graphics","Win32","Menu"],ModuleName ["Graphics","Win32","Message"],ModuleName ["Graphics","Win32","Misc"],ModuleName ["Graphics","Win32","Resource"],ModuleName ["Graphics","Win32","Window"],ModuleName ["System","Win32"],ModuleName ["System","Win32","DebugApi"],ModuleName ["System","Win32","DLL"],ModuleName ["System","Win32","File"],ModuleName ["System","Win32","FileMapping"],ModuleName ["System","Win32","Info"],ModuleName ["System","Win32","Mem"],ModuleName ["System","Win32","NLS"],ModuleName ["System","Win32","Process"],ModuleName ["System","Win32","Registry"],ModuleName ["System","Win32","SimpleMAPI"],ModuleName ["System","Win32","Time"],ModuleName ["System","Win32","Console"],ModuleName ["System","Win32","Security"],ModuleName ["System","Win32","Types"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\Win32-2.2.0.0"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\Win32-2.2.0.0"], hsLibraries = ["HSWin32-2.2.0.0"], extraLibraries = ["user32","gdi32","winmm","kernel32","advapi32"], extraGHCiLibraries = [], includeDirs = ["C:\\ghc\\ghc-6.10.3\\Win32-2.2.0.0\\include"], includes = ["HsWin32.h","HsGDI.h","WndProc.h"], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,4], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/Win32\\Win32.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/Win32"]}]),(PackageName "array",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,2,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package defines the classes @IArray@ of immutable arrays and\n@MArray@ of arrays mutable within appropriate monads, as well as\nsome instances of these classes.", category = "Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Array","Base"],ModuleName ["Data","Array","Diff"],ModuleName ["Data","Array","IArray"],ModuleName ["Data","Array","IO"],ModuleName ["Data","Array","IO","Internals"],ModuleName ["Data","Array","MArray"],ModuleName ["Data","Array","ST"],ModuleName ["Data","Array","Storable"],ModuleName ["Data","Array","Unboxed"],ModuleName ["Data","Array"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\array-0.2.0.0"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\array-0.2.0.0"], hsLibraries = ["HSarray-0.2.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "syb", pkgVersion = Version {versionBranch = [0,1,0,1], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/array\\array.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/array"]}]),(PackageName "base",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [3,0,3,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This is a backwards-compatible version of the base package.\nIt depends on a later version of base, and was probably supplied\nwith your compiler when it was installed.", category = "", exposed = True, exposedModules = [ModuleName ["Data","Generics"],ModuleName ["Data","Generics","Aliases"],ModuleName ["Data","Generics","Basics"],ModuleName ["Data","Generics","Instances"],ModuleName ["Data","Generics","Schemes"],ModuleName ["Data","Generics","Text"],ModuleName ["Data","Generics","Twins"],ModuleName ["Foreign","Concurrent"],ModuleName ["GHC","Arr"],ModuleName ["GHC","Base"],ModuleName ["GHC","Conc"],ModuleName ["GHC","ConsoleHandler"],ModuleName ["GHC","Desugar"],ModuleName ["GHC","Dotnet"],ModuleName ["GHC","Enum"],ModuleName ["GHC","Environment"],ModuleName ["GHC","Err"],ModuleName ["GHC","Exception"],ModuleName ["GHC","Exts"],ModuleName ["GHC","Float"],ModuleName ["GHC","ForeignPtr"],ModuleName ["GHC","Handle"],ModuleName ["GHC","IO"],ModuleName ["GHC","IOBase"],ModuleName ["GHC","Int"],ModuleName ["GHC","List"],ModuleName ["GHC","Num"],ModuleName ["GHC","PArr"],ModuleName ["GHC","Pack"],ModuleName ["GHC","Ptr"],ModuleName ["GHC","Read"],ModuleName ["GHC","Real"],ModuleName ["GHC","ST"],ModuleName ["GHC","STRef"],ModuleName ["GHC","Show"],ModuleName ["GHC","Stable"],ModuleName ["GHC","Storable"],ModuleName ["GHC","TopHandler"],ModuleName ["GHC","Unicode"],ModuleName ["GHC","Weak"],ModuleName ["GHC","Word"],ModuleName ["System","Timeout"],ModuleName ["Control","Applicative"],ModuleName ["Control","Arrow"],ModuleName ["Control","Category"],ModuleName ["Control","Concurrent"],ModuleName ["Control","Concurrent","Chan"],ModuleName ["Control","Concurrent","MVar"],ModuleName ["Control","Concurrent","QSem"],ModuleName ["Control","Concurrent","QSemN"],ModuleName ["Control","Concurrent","SampleVar"],ModuleName ["Control","Exception"],ModuleName ["Control","Monad"],ModuleName ["Control","Monad","Fix"],ModuleName ["Control","Monad","Instances"],ModuleName ["Control","Monad","ST"],ModuleName ["Control","Monad","ST","Lazy"],ModuleName ["Control","Monad","ST","Strict"],ModuleName ["Data","Bits"],ModuleName ["Data","Bool"],ModuleName ["Data","Char"],ModuleName ["Data","Complex"],ModuleName ["Data","Dynamic"],ModuleName ["Data","Either"],ModuleName ["Data","Eq"],ModuleName ["Data","Fixed"],ModuleName ["Data","Foldable"],ModuleName ["Data","Function"],ModuleName ["Data","HashTable"],ModuleName ["Data","IORef"],ModuleName ["Data","Int"],ModuleName ["Data","Ix"],ModuleName ["Data","List"],ModuleName ["Data","Maybe"],ModuleName ["Data","Monoid"],ModuleName ["Data","Ord"],ModuleName ["Data","Ratio"],ModuleName ["Data","STRef"],ModuleName ["Data","STRef","Lazy"],ModuleName ["Data","STRef","Strict"],ModuleName ["Data","String"],ModuleName ["Data","Traversable"],ModuleName ["Data","Tuple"],ModuleName ["Data","Typeable"],ModuleName ["Data","Unique"],ModuleName ["Data","Version"],ModuleName ["Data","Word"],ModuleName ["Debug","Trace"],ModuleName ["Foreign"],ModuleName ["Foreign","C"],ModuleName ["Foreign","C","Error"],ModuleName ["Foreign","C","String"],ModuleName ["Foreign","C","Types"],ModuleName ["Foreign","ForeignPtr"],ModuleName ["Foreign","Marshal"],ModuleName ["Foreign","Marshal","Alloc"],ModuleName ["Foreign","Marshal","Array"],ModuleName ["Foreign","Marshal","Error"],ModuleName ["Foreign","Marshal","Pool"],ModuleName ["Foreign","Marshal","Utils"],ModuleName ["Foreign","Ptr"],ModuleName ["Foreign","StablePtr"],ModuleName ["Foreign","Storable"],ModuleName ["Numeric"],ModuleName ["Prelude"],ModuleName ["System","Console","GetOpt"],ModuleName ["System","CPUTime"],ModuleName ["System","Environment"],ModuleName ["System","Exit"],ModuleName ["System","IO"],ModuleName ["System","IO","Error"],ModuleName ["System","IO","Unsafe"],ModuleName ["System","Info"],ModuleName ["System","Mem"],ModuleName ["System","Mem","StableName"],ModuleName ["System","Mem","Weak"],ModuleName ["System","Posix","Internals"],ModuleName ["System","Posix","Types"],ModuleName ["Text","ParserCombinators","ReadP"],ModuleName ["Text","ParserCombinators","ReadPrec"],ModuleName ["Text","Printf"],ModuleName ["Text","Read"],ModuleName ["Text","Read","Lex"],ModuleName ["Text","Show"],ModuleName ["Text","Show","Functions"],ModuleName ["Unsafe","Coerce"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\base-3.0.3.1"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\base-3.0.3.1"], hsLibraries = ["HSbase-3.0.3.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "syb", pkgVersion = Version {versionBranch = [0,1,0,1], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/base\\base.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/base"]},InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains the Prelude and its support libraries,\nand a large collection of useful libraries ranging from data\nstructures to parsing combinators and debugging utilities.", category = "", exposed = True, exposedModules = [ModuleName ["Foreign","Concurrent"],ModuleName ["GHC","Arr"],ModuleName ["GHC","Base"],ModuleName ["GHC","Classes"],ModuleName ["GHC","Conc"],ModuleName ["GHC","ConsoleHandler"],ModuleName ["GHC","Desugar"],ModuleName ["GHC","Enum"],ModuleName ["GHC","Environment"],ModuleName ["GHC","Err"],ModuleName ["GHC","Exception"],ModuleName ["GHC","Exts"],ModuleName ["GHC","Float"],ModuleName ["GHC","ForeignPtr"],ModuleName ["GHC","Handle"],ModuleName ["GHC","IO"],ModuleName ["GHC","IOBase"],ModuleName ["GHC","Int"],ModuleName ["GHC","List"],ModuleName ["GHC","Num"],ModuleName ["GHC","PArr"],ModuleName ["GHC","Pack"],ModuleName ["GHC","Ptr"],ModuleName ["GHC","Read"],ModuleName ["GHC","Real"],ModuleName ["GHC","ST"],ModuleName ["GHC","STRef"],ModuleName ["GHC","Show"],ModuleName ["GHC","Stable"],ModuleName ["GHC","Storable"],ModuleName ["GHC","TopHandler"],ModuleName ["GHC","Unicode"],ModuleName ["GHC","Weak"],ModuleName ["GHC","Word"],ModuleName ["System","Timeout"],ModuleName ["Control","Applicative"],ModuleName ["Control","Arrow"],ModuleName ["Control","Category"],ModuleName ["Control","Concurrent"],ModuleName ["Control","Concurrent","Chan"],ModuleName ["Control","Concurrent","MVar"],ModuleName ["Control","Concurrent","QSem"],ModuleName ["Control","Concurrent","QSemN"],ModuleName ["Control","Concurrent","SampleVar"],ModuleName ["Control","Exception"],ModuleName ["Control","Exception","Base"],ModuleName ["Control","OldException"],ModuleName ["Control","Monad"],ModuleName ["Control","Monad","Fix"],ModuleName ["Control","Monad","Instances"],ModuleName ["Control","Monad","ST"],ModuleName ["Control","Monad","ST","Lazy"],ModuleName ["Control","Monad","ST","Strict"],ModuleName ["Data","Bits"],ModuleName ["Data","Bool"],ModuleName ["Data","Char"],ModuleName ["Data","Complex"],ModuleName ["Data","Dynamic"],ModuleName ["Data","Either"],ModuleName ["Data","Eq"],ModuleName ["Data","Data"],ModuleName ["Data","Fixed"],ModuleName ["Data","Foldable"],ModuleName ["Data","Function"],ModuleName ["Data","HashTable"],ModuleName ["Data","IORef"],ModuleName ["Data","Int"],ModuleName ["Data","Ix"],ModuleName ["Data","List"],ModuleName ["Data","Maybe"],ModuleName ["Data","Monoid"],ModuleName ["Data","Ord"],ModuleName ["Data","Ratio"],ModuleName ["Data","STRef"],ModuleName ["Data","STRef","Lazy"],ModuleName ["Data","STRef","Strict"],ModuleName ["Data","String"],ModuleName ["Data","Traversable"],ModuleName ["Data","Tuple"],ModuleName ["Data","Typeable"],ModuleName ["Data","Unique"],ModuleName ["Data","Version"],ModuleName ["Data","Word"],ModuleName ["Debug","Trace"],ModuleName ["Foreign"],ModuleName ["Foreign","C"],ModuleName ["Foreign","C","Error"],ModuleName ["Foreign","C","String"],ModuleName ["Foreign","C","Types"],ModuleName ["Foreign","ForeignPtr"],ModuleName ["Foreign","Marshal"],ModuleName ["Foreign","Marshal","Alloc"],ModuleName ["Foreign","Marshal","Array"],ModuleName ["Foreign","Marshal","Error"],ModuleName ["Foreign","Marshal","Pool"],ModuleName ["Foreign","Marshal","Utils"],ModuleName ["Foreign","Ptr"],ModuleName ["Foreign","StablePtr"],ModuleName ["Foreign","Storable"],ModuleName ["Numeric"],ModuleName ["Prelude"],ModuleName ["System","Console","GetOpt"],ModuleName ["System","CPUTime"],ModuleName ["System","Environment"],ModuleName ["System","Exit"],ModuleName ["System","IO"],ModuleName ["System","IO","Error"],ModuleName ["System","IO","Unsafe"],ModuleName ["System","Info"],ModuleName ["System","Mem"],ModuleName ["System","Mem","StableName"],ModuleName ["System","Mem","Weak"],ModuleName ["System","Posix","Internals"],ModuleName ["System","Posix","Types"],ModuleName ["Text","ParserCombinators","ReadP"],ModuleName ["Text","ParserCombinators","ReadPrec"],ModuleName ["Text","Printf"],ModuleName ["Text","Read"],ModuleName ["Text","Read","Lex"],ModuleName ["Text","Show"],ModuleName ["Text","Show","Functions"],ModuleName ["Unsafe","Coerce"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\base-4.1.0.0"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\base-4.1.0.0"], hsLibraries = ["HSbase-4.1.0.0"], extraLibraries = ["wsock32","msvcrt","kernel32","user32","shell32"], extraGHCiLibraries = [], includeDirs = ["C:\\ghc\\ghc-6.10.3\\base-4.1.0.0\\include"], includes = ["HsBase.h"], depends = [PackageIdentifier {pkgName = PackageName "ghc-prim", pkgVersion = Version {versionBranch = [0,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "integer", pkgVersion = Version {versionBranch = [0,1,0,1], versionTags = []}},PackageIdentifier {pkgName = PackageName "rts", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/base\\base.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/base"]}]),(PackageName "bytestring",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,4], versionTags = []}}, license = BSD3, copyright = "Copyright (c) Don Stewart 2005-2008,\n(c) Duncan Coutts 2006-2008,\n(c) David Roundy 2003-2005.", maintainer = "dons@galois.com, duncan@haskell.org", author = "Don Stewart, Duncan Coutts", stability = "provisional", homepage = "http://www.cse.unsw.edu.au/~dons/fps.html", pkgUrl = "", description = "A time and space-efficient implementation of byte vectors using\npacked Word8 arrays, suitable for high performance use, both in terms\nof large data quantities, or high speed requirements. Byte vectors\nare encoded as strict 'Word8' arrays of bytes, and lazy lists of\nstrict chunks, held in a 'ForeignPtr', and can be passed between C\nand Haskell with little effort.\n\nTest coverage data for this library is available at:\n", category = "Data", exposed = True, exposedModules = [ModuleName ["Data","ByteString"],ModuleName ["Data","ByteString","Char8"],ModuleName ["Data","ByteString","Unsafe"],ModuleName ["Data","ByteString","Internal"],ModuleName ["Data","ByteString","Lazy"],ModuleName ["Data","ByteString","Lazy","Char8"],ModuleName ["Data","ByteString","Lazy","Internal"],ModuleName ["Data","ByteString","Fusion"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\bytestring-0.9.1.4"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\bytestring-0.9.1.4"], hsLibraries = ["HSbytestring-0.9.1.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["C:\\ghc\\ghc-6.10.3\\bytestring-0.9.1.4\\include"], includes = ["fpstring.h"], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "ghc-prim", pkgVersion = Version {versionBranch = [0,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/bytestring\\bytestring.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/bytestring"]}]),(PackageName "containers",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,2,0,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains efficient general-purpose implementations\nof various basic immutable container types. The declared cost of\neach operation is either worst-case or amortized, but remains\nvalid even if structures are shared.", category = "Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Graph"],ModuleName ["Data","IntMap"],ModuleName ["Data","IntSet"],ModuleName ["Data","Map"],ModuleName ["Data","Sequence"],ModuleName ["Data","Set"],ModuleName ["Data","Tree"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\containers-0.2.0.1"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\containers-0.2.0.1"], hsLibraries = ["HScontainers-0.2.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,2,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/containers\\containers.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/containers"]}]),(PackageName "directory",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides a library for handling directories.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Directory"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\directory-1.0.0.3"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\directory-1.0.0.3"], hsLibraries = ["HSdirectory-1.0.0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["C:\\ghc\\ghc-6.10.3\\directory-1.0.0.3\\include"], includes = ["HsDirectory.h"], depends = [PackageIdentifier {pkgName = PackageName "Win32", pkgVersion = Version {versionBranch = [2,2,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,1,0,2], versionTags = []}},PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,2], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/directory\\directory.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/directory"]}]),(PackageName "filepath",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,1,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "", author = "Neil Mitchell", stability = "", homepage = "http://www-users.cs.york.ac.uk/~ndm/filepath/", pkgUrl = "", description = "", category = "System", exposed = True, exposedModules = [ModuleName ["System","FilePath"],ModuleName ["System","FilePath","Posix"],ModuleName ["System","FilePath","Windows"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\filepath-1.1.0.2"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\filepath-1.1.0.2"], hsLibraries = ["HSfilepath-1.1.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/filepath\\filepath.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/filepath"]}]),(PackageName "ghc-prim",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "ghc-prim", pkgVersion = Version {versionBranch = [0,1,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "GHC primitives.", category = "", exposed = True, exposedModules = [ModuleName ["GHC","Prim"],ModuleName ["GHC","Bool"],ModuleName ["GHC","Generics"],ModuleName ["GHC","Ordering"],ModuleName ["GHC","PrimopWrappers"],ModuleName ["GHC","IntWord32"],ModuleName ["GHC","IntWord64"],ModuleName ["GHC","Tuple"],ModuleName ["GHC","Types"],ModuleName ["GHC","Unit"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\ghc-prim-0.1.0.0"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\ghc-prim-0.1.0.0"], hsLibraries = ["HSghc-prim-0.1.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "rts", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/ghc-prim\\ghc-prim.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/ghc-prim"]}]),(PackageName "integer",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "integer", pkgVersion = Version {versionBranch = [0,1,0,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains an Integer library based on GMP.", category = "", exposed = True, exposedModules = [ModuleName ["GHC","Integer"],ModuleName ["GHC","Integer","Internals"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\integer-0.1.0.1"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\integer-0.1.0.1"], hsLibraries = ["HSinteger-0.1.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "ghc-prim", pkgVersion = Version {versionBranch = [0,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/integer\\integer.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/integer"]}]),(PackageName "mtl",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [1,1,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "Andy Gill", stability = "", homepage = "", pkgUrl = "", description = "A monad transformer library, inspired by the paper /Functional\nProgramming with Overloading and Higher-Order Polymorphism/,\nby Mark P Jones (),\nAdvanced School of Functional Programming, 1995.", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Monad","Cont"],ModuleName ["Control","Monad","Cont","Class"],ModuleName ["Control","Monad","Error"],ModuleName ["Control","Monad","Error","Class"],ModuleName ["Control","Monad","Identity"],ModuleName ["Control","Monad","List"],ModuleName ["Control","Monad","RWS"],ModuleName ["Control","Monad","RWS","Class"],ModuleName ["Control","Monad","RWS","Lazy"],ModuleName ["Control","Monad","RWS","Strict"],ModuleName ["Control","Monad","Reader"],ModuleName ["Control","Monad","Reader","Class"],ModuleName ["Control","Monad","State"],ModuleName ["Control","Monad","State","Class"],ModuleName ["Control","Monad","State","Lazy"],ModuleName ["Control","Monad","State","Strict"],ModuleName ["Control","Monad","Trans"],ModuleName ["Control","Monad","Writer"],ModuleName ["Control","Monad","Writer","Class"],ModuleName ["Control","Monad","Writer","Lazy"],ModuleName ["Control","Monad","Writer","Strict"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\mtl-1.1.0.2"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\mtl-1.1.0.2"], hsLibraries = ["HSmtl-1.1.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/mtl\\mtl.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/mtl"]}]),(PackageName "old-locale",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "old-locale", pkgVersion = Version {versionBranch = [1,0,0,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides the old locale library.\nFor new code, the new locale library is recommended.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Locale"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\old-locale-1.0.0.1"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\old-locale-1.0.0.1"], hsLibraries = ["HSold-locale-1.0.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/old-locale\\old-locale.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/old-locale"]}]),(PackageName "old-time",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides the old time library.\nFor new code, the new time library is recommended.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Time"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\old-time-1.0.0.2"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\old-time-1.0.0.2"], hsLibraries = ["HSold-time-1.0.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["C:\\ghc\\ghc-6.10.3\\old-time-1.0.0.2\\include"], includes = ["HsTime.h"], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "old-locale", pkgVersion = Version {versionBranch = [1,0,0,1], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/old-time\\old-time.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/old-time"]}]),(PackageName "rts",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "rts", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "glasgow-haskell-users@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "", category = "", exposed = True, exposedModules = [], hiddenModules = [], importDirs = [], libraryDirs = ["C:\\ghc\\ghc-6.10.3","C:\\ghc\\ghc-6.10.3/gcc-lib"], hsLibraries = ["HSrts"], extraLibraries = ["m","ffi","gmp","wsock32"], extraGHCiLibraries = [], includeDirs = ["C:\\ghc\\ghc-6.10.3/include","PAPI_INCLUDE_DIR"], includes = ["Stg.h"], depends = [], hugsOptions = [], ccOptions = [], ldOptions = ["-u","_ghczmprim_GHCziTypes_Izh_static_info","-u","_ghczmprim_GHCziTypes_Czh_static_info","-u","_ghczmprim_GHCziTypes_Fzh_static_info","-u","_ghczmprim_GHCziTypes_Dzh_static_info","-u","_base_GHCziPtr_Ptr_static_info","-u","_base_GHCziWord_Wzh_static_info","-u","_base_GHCziInt_I8zh_static_info","-u","_base_GHCziInt_I16zh_static_info","-u","_base_GHCziInt_I32zh_static_info","-u","_base_GHCziInt_I64zh_static_info","-u","_base_GHCziWord_W8zh_static_info","-u","_base_GHCziWord_W16zh_static_info","-u","_base_GHCziWord_W32zh_static_info","-u","_base_GHCziWord_W64zh_static_info","-u","_base_GHCziStable_StablePtr_static_info","-u","_ghczmprim_GHCziTypes_Izh_con_info","-u","_ghczmprim_GHCziTypes_Czh_con_info","-u","_ghczmprim_GHCziTypes_Fzh_con_info","-u","_ghczmprim_GHCziTypes_Dzh_con_info","-u","_base_GHCziPtr_Ptr_con_info","-u","_base_GHCziPtr_FunPtr_con_info","-u","_base_GHCziStable_StablePtr_con_info","-u","_ghczmprim_GHCziBool_False_closure","-u","_ghczmprim_GHCziBool_True_closure","-u","_base_GHCziPack_unpackCString_closure","-u","_base_GHCziIOBase_stackOverflow_closure","-u","_base_GHCziIOBase_heapOverflow_closure","-u","_base_ControlziExceptionziBase_nonTermination_closure","-u","_base_GHCziIOBase_blockedOnDeadMVar_closure","-u","_base_GHCziIOBase_blockedIndefinitely_closure","-u","_base_ControlziExceptionziBase_nestedAtomically_closure","-u","_base_GHCziWeak_runFinalizzerBatch_closure","-u","_base_GHCziTopHandler_runIO_closure","-u","_base_GHCziTopHandler_runNonIO_closure","-u","_base_GHCziConc_runHandlers_closure","-u","_base_GHCziConc_ensureIOManagerIsRunning_closure"], frameworkDirs = [], frameworks = [], haddockInterfaces = [], haddockHTMLs = []}]),(PackageName "stm",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "stm", pkgVersion = Version {versionBranch = [2,1,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "A modular composable concurrency abstraction.", category = "Concurrency", exposed = True, exposedModules = [ModuleName ["Control","Concurrent","STM"],ModuleName ["Control","Concurrent","STM","TArray"],ModuleName ["Control","Concurrent","STM","TVar"],ModuleName ["Control","Concurrent","STM","TChan"],ModuleName ["Control","Concurrent","STM","TMVar"],ModuleName ["Control","Monad","STM"]], hiddenModules = [ModuleName ["Control","Sequential","STM"]], importDirs = ["C:\\ghc\\ghc-6.10.3\\stm-2.1.1.2"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\stm-2.1.1.2"], hsLibraries = ["HSstm-2.1.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,2,0,0], versionTags = []}},PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/stm\\stm.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/stm"]}]),(PackageName "syb",[InstalledPackageInfo {package = PackageIdentifier {pkgName = PackageName "syb", pkgVersion = Version {versionBranch = [0,1,0,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains the generics system described in the\n/Scrap Your Boilerplate/ papers (see ).\nIt defines the @Data@ class of types permitting folding and unfolding\nof constructor applications, instances of this class for primitive\ntypes, and a variety of traversals.", category = "", exposed = True, exposedModules = [ModuleName ["Data","Generics"],ModuleName ["Data","Generics","Aliases"],ModuleName ["Data","Generics","Basics"],ModuleName ["Data","Generics","Instances"],ModuleName ["Data","Generics","Schemes"],ModuleName ["Data","Generics","Text"],ModuleName ["Data","Generics","Twins"]], hiddenModules = [], importDirs = ["C:\\ghc\\ghc-6.10.3\\syb-0.1.0.1"], libraryDirs = ["C:\\ghc\\ghc-6.10.3\\syb-0.1.0.1"], hsLibraries = ["HSsyb-0.1.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,1,0,0], versionTags = []}}], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\ghc\\ghc-6.10.3/doc/libraries/syb\\syb.haddock"], haddockHTMLs = ["$httptopdir/doc/libraries/syb"]}])]), pkgDescrFile = Just ".\\Workflow.cabal", localPkgDescr = PackageDescription {package = PackageIdentifier {pkgName = PackageName "Workflow", pkgVersion = Version {versionBranch = [0,5,5], versionTags = []}}, license = BSD3, licenseFile = "LICENSE", copyright = "", maintainer = "agocorona@gmail.com", author = "Alberto G\243mez Corona", stability = "experimental", testedWith = [], homepage = "", pkgUrl = "", bugReports = "", sourceRepos = [], synopsis = "library for transparent execution of interruptible computations", description = "Transparent support for interruptable computations. A workflow can be seen as a persistent thread that executes any\nmonadic computation. Therefore, it can be used in very time consuming computations such are CPU intensive calculations\nor procedures that are most of the time waiting for the action of a process or an user, that are prone to comunication\nfailures, timeouts or shutdowns.\n\nThe computantion can be restarted at the interrupted point because such monad is encapsulated inside\na state monad transformer that transparently checkpoint the computation state. Besides that, the package also provides\nother services associated to workflows\nThe main features are:\n\n* logging of each intermediate action results in disk.\n\n* resume the monadic computation at the last checkpoint after soft or hard interruption.\n\n* suspend a computation until the input object meet certain conditions. useful for inter-workflow comunications.-\n\n* Communications with other processes including other workflows trough persistent data objects,\ninspection of intermediate workflow results , persistent queues, persistent timeouts so that no data is lost due\nto shutdowns\n\n* A workflow can initiate anoter workflow and wait for the resutl\n\n* workflow management and monitoriing, view workflow history and intermediate results.", category = "Control, Workflow, Concurrent, Middleware", customFieldsPD = [], buildDepends = [Dependency (PackageName "RefSerialize") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,4], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,4], versionTags = []}))),Dependency (PackageName "TCache") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,4], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,4], versionTags = []}))),Dependency (PackageName "base") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3], versionTags = []})) (LaterVersion (Version {versionBranch = [3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4], versionTags = []}))),Dependency (PackageName "containers") AnyVersion,Dependency (PackageName "mtl") AnyVersion,Dependency (PackageName "old-time") AnyVersion,Dependency (PackageName "stm") (LaterVersion (Version {versionBranch = [2], versionTags = []}))], descCabalVersion = UnionVersionRanges (ThisVersion (Version {versionBranch = [1,2], versionTags = []})) (LaterVersion (Version {versionBranch = [1,2], versionTags = []})), buildType = Just Simple, library = Just (Library {exposedModules = [ModuleName ["Control","Workflow"]], libExposed = True, libBuildInfo = BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = ["."], otherModules = [], extensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,["-O2"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = []}}), executables = [], dataFiles = [], dataDir = "", extraSrcFiles = [], extraTmpFiles = []}, withPrograms = [("ar",ConfiguredProgram {programId = "ar", programVersion = Nothing, programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\bin\\ar.exe"}}),("cpphs",ConfiguredProgram {programId = "cpphs", programVersion = Just (Version {versionBranch = [1,7], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\Archivos de programa\\Haskell\\bin\\cpphs.exe"}}),("gcc",ConfiguredProgram {programId = "gcc", programVersion = Just (Version {versionBranch = [3,4,5], versionTags = []}), programArgs = ["-BC:\\ghc\\ghc-6.10.3\\gcc-lib","-IC:\\ghc\\ghc-6.10.3\\include\\mingw"], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\gcc.exe"}}),("ghc",ConfiguredProgram {programId = "ghc", programVersion = Just (Version {versionBranch = [6,10,3], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\bin\\ghc.exe"}}),("ghc-pkg",ConfiguredProgram {programId = "ghc-pkg", programVersion = Just (Version {versionBranch = [6,10,3], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\bin\\ghc-pkg.exe"}}),("haddock",ConfiguredProgram {programId = "haddock", programVersion = Just (Version {versionBranch = [2,4,2], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\bin\\haddock.exe"}}),("happy",ConfiguredProgram {programId = "happy", programVersion = Just (Version {versionBranch = [1,18,4], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\bin\\happy.exe"}}),("hsc2hs",ConfiguredProgram {programId = "hsc2hs", programVersion = Just (Version {versionBranch = [0,67], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\bin\\hsc2hs.exe"}}),("hscolour",ConfiguredProgram {programId = "hscolour", programVersion = Just (Version {versionBranch = [1,13], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\Archivos de programa\\Haskell\\bin\\HsColour.exe"}}),("ld",ConfiguredProgram {programId = "ld", programVersion = Nothing, programArgs = ["-x"], programLocation = FoundOnSystem {locationPath = "C:\\ghc\\ghc-6.10.3\\gcc-lib\\ld.exe"}}),("pkg-config",ConfiguredProgram {programId = "pkg-config", programVersion = Just (Version {versionBranch = [0,23], versionTags = []}), programArgs = [], programLocation = FoundOnSystem {locationPath = "c:\\gtk2hs\\0.10.1\\bin\\pkg-config.exe"}}),("tar",ConfiguredProgram {programId = "tar", programVersion = Nothing, programArgs = [], programLocation = FoundOnSystem {locationPath = "C:\\Archivos de programa\\UnixUtils\\usr\\local\\wbin\\tar.exe"}})], withPackageDB = GlobalPackageDB, withVanillaLib = True, withProfLib = False, withSharedLib = False, withProfExe = False, withOptimization = NormalOptimisation, withGHCiLib = True, splitObjs = False, stripExes = True, progPrefix = "", progSuffix = ""} diff --git a/notes.txt b/notes.txt new file mode 100644 --- /dev/null +++ b/notes.txt @@ -0,0 +1,36 @@ +class Keyable a where + Key a -> String + + +class Keyable a => IResource abs + + + +instance (Keyable a, Serialize a) => IResource a + + +data forall a.(Keyable a, Serialize a) => IDynamic a + + +como ahorrar espacio usando Dynamic + +cuand se serializa, RefSerialize va buscando en un map de direcciones de objetos, si encuentra esa direccion usada, +apunta hacia ella. Los Dynamic ocultan eso. como hacer para que se vean? + +now <- whenThisHappened +let x= now + delay +waitForFIFO xs >>= Just `orElse` waitUntil x >> Nothing + + +waitUntil:: Integer -> STM() +waitUntil t= do + + threadDelay $ delay* 1000000 + if t - tnow <= 0 then return () else retry + + where + + + delay | t-tnow >interval = interval + | otherwise = t - tnow +