{-# OPTIONS -XUndecidableInstances -XDeriveDataTypeable -XTypeSynonymInstances -XExistentialQuantification -XMultiParamTypeClasses -XFlexibleInstances -XOverloadedStrings #-} module Control.Workflow.Stat where import Data.TCache import Data.ByteString.Lazy.Char8(pack, unpack) import System.IO.Unsafe import Data.Typeable import qualified Data.Map as M import Control.Concurrent(ThreadId) import Control.Concurrent.STM(TVar, newTVarIO) import Data.IORef import Control.Workflow.GenSerializer import Control.Workflow.IDynamic import Control.Monad(replicateM) import Data.TCache.DefaultPersistence import Data.ByteString.Lazy.Char8 hiding (index) import Control.Workflow.IDynamic data WF s m l = WF { st :: s -> m (s,l) } data SyncMode= Synchronous -- ^ write state after every step | Asyncronous {frecuency :: Int -- ^ number of seconds between saves when asyncronous ,cacheSize :: Int -- ^ size of the cache when async } | SyncManual -- ^ use Data.TCache.syncCache to write the state deriving Eq tvSyncWrite= unsafePerformIO $ newTVarIO (Synchronous, Nothing) data Stat = Running (M.Map String (String, (Maybe ThreadId))) | Stat{ wfName :: String , state:: Int , index :: Int , recover:: Bool , versions ::[IDynamic] , timeout :: Maybe (TVar Bool)} deriving (Typeable) stat0 = Stat{ wfName="", state=0, index=0, recover=False, versions = [] , timeout= Nothing} -- return the unique name of a workflow with a parameter (executed with exec or start) keyWF :: Indexable a => String -> a -> String keyWF wn x= wn ++ "#" ++ key x data WFRef a= WFRef !Int !(DBRef Stat) deriving (Typeable, Show) instance Indexable (WFRef a) where key (WFRef n ref)= keyObjDBRef ref++('#':show n) instance (Serializer w r a, RunSerializer w r) => Serializable a where serialize = runSerial . serial deserialize = runDeserial deserial keyRunning= "Running"