{-# 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"