module Control.Workflow.Text.TextDefs where
import Control.Workflow.IDynamic
import Control.Workflow.GenSerializer
import Data.RefSerialize
import System.IO.Unsafe
import Data.TCache.DefaultPersistence(Indexable(..))
import Data.IORef
import Unsafe.Coerce
import Data.ByteString.Lazy.Char8 as B hiding (index)
import Control.Workflow.Stat
import Data.Map as M
import Control.Concurrent
import Data.TCache
instance Serialize a => Serializer ST ST a where
serial = showp
deserial = readp
instance RunSerializer ST ST where
runSerial = runW
runDeserial = runR
instance Serialize a => DynSerializer ST ST a where
serialM = showps
fromDynData s c= runRC c readp s
instance Serialize IDynamic where
showp (IDyn t)=
case unsafePerformIO $ readIORef t of
DRight x -> do
insertString $ pack dynPrefix
showpx <- unsafeCoerce $ serialM x
showpText . fromIntegral $ B.length showpx
insertString showpx
DLeft (showpx,_) ->
do
insertString $ pack dynPrefix
showpText 0
readp = do
symbol dynPrefix
n <- readpText
s <- takep n
c <- getContext
return . IDyn . unsafePerformIO . newIORef $ DLeft ( s, c)
<?> "IDynamic"
instance Serialize Stat where
showp (Running map)= do
insertString $ pack "Running"
showp $ Prelude.map (\(k,(w,_)) -> (k,w)) $ M.toList map
showp stat@( Stat wfName state index recover versions _ )=do
insertString $ pack "Stat"
showpText wfName
showpText state
showpText index
showpText recover
showp versions
readp = choice [rStat, rWorkflows] where
rStat= do
symbol "Stat"
wfName <- stringLiteral
state <- integer >>= return . fromIntegral
index <- integer >>= return . fromIntegral
recover <- bool
versions <- readp
return $ Stat wfName state index recover versions Nothing
<?> "Stat"
rWorkflows= do
symbol "Running"
list <- readp
return $ Running $ M.fromList $ Prelude.map(\(k,w)-> (k,(w,Nothing))) list
<?> "RunningWoorkflows"
instance Serialize ThreadId where
showp th= insertString . pack $ show th
readp = (readp :: ST ByteString) >> (return . unsafePerformIO . forkIO $ return ())
newtype Pretty = Pretty Stat
instance Show Pretty where
show= unpack . runW . sp
where
sp (Pretty (Stat wfName state index recover versions _ ))= do
insertString $ pack "Workflow name= "
showp wfName
insertString $ pack "\n"
showElem $ Prelude.reverse $ (Prelude.zip ( Prelude.reverse [1..] ) versions )
showElem :: [(Int,IDynamic)] -> ST ()
showElem [] = insertChar '\n'
showElem ((n, dyn):es) = do
showp $ pack "Step "
showp n
showp $ pack ": "
showp dyn
insertChar '\n'
showElem es
statPrefix= "Stat#"
instance Indexable Stat where
key s@Stat{wfName=name}= statPrefix ++ name
key (Running _)= keyRunning
defPath= const "WorkflowState/Text/"
wFRefStr = "WFRef"
instance Serialize (WFRef a) where
showp (WFRef n ref)= do
insertString $ pack wFRefStr
showp n
showp $ keyObjDBRef ref
readp= do
symbol wFRefStr
n <- readp
k <- readp
return . WFRef n $ getDBRef k
printHistory :: Stat -> IO ()
printHistory stat= do
Prelude.putStrLn . show $ Pretty stat
Prelude.putStrLn "-----------------------------------"