{-# LANGUAGE

              MultiParamTypeClasses
            , FlexibleInstances
            , UndecidableInstances


          #-}
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,_) ->   --  error $ "IDynamic not reified :: "++  unpack 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

-- | print the state changes along the workflow, that is, all the intermediate results
printHistory :: Stat -> IO ()
printHistory stat= do
       Prelude.putStrLn  . show $ Pretty stat
       Prelude.putStrLn "-----------------------------------"