--
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
--                    Sean Seefried <http://www.cse.unsw.edu.au/~sseefried>
--                    Stefan Wehr   <http://www.stefanwehr.de>
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)
--

module CR( 
      CR, runCR, CRState(..), liftIO
    , DirtyFlag(..), CopStrategy(..), RobberStrategy(..)
    , getCopStrat, appCopStrat, appCopStrat0
    , getRobberStrat, appRobberStrat, appRobberStrat0
    , getKB, setKB, setDynKB

    , watchdogCR, watchdogIO, genericDelay
  ) where

import Prelude hiding ( catch )

import Control.Monad.State
import System.IO
import System.Time

-- local imports
import Syntax
import KnowledgeBase
import Logging

import Control.Exception
import Control.Concurrent
import Control.Concurrent.MVar


type CR = StateT CRState IO

runCR :: CR a -> CRState -> IO a
runCR cr crState = 
  do hSetBuffering stdout NoBuffering -- sets no buffering on input and output
     hSetBuffering stdin NoBuffering 
     evalStateT cr crState

data CRState = 
    CRState { crCopStrat    :: CopStrategy
            , crRobberStrat :: RobberStrategy 
            , crKB          :: Maybe KnowledgeBase}

getCRState :: CR CRState
getCRState = get

getKB :: CR KnowledgeBase
getKB = 
    do kb <- gets crKB
       case kb of
         Just kb' -> return kb'
         Nothing -> fatal "getKB called, but KB not initialized"

setKB :: KnowledgeBase -> CR ()
setKB kb = 
    modify (\s -> s { crKB = Just kb })

setDynKB :: KnowledgeBaseDynamic -> CR ()
setDynKB dynkb = 
    do kb <- getKB
       setKB (kb { kb_dynamic = Just dynkb })


--
-- Update the KnowledgeBase in the CRState using updateKnowledge
--
updateCRKB :: World -> CR ()
updateCRKB world =
    do crState <- get
       case crKB crState of
         Just kb-> 
             put (crState { crKB = Just (updateKnowledge kb world)})
         Nothing -> fatal "KnowledgeBase is not intialised"

--
-- Get a copy strategy
--
getCopStrat :: (CopStrategy -> a) -> CR a
getCopStrat sel = gets (sel . crCopStrat)


--
-- Apply a Cop Strategy of one argument to some data
--
-- e.g. appCopState crMkRegisterMsg "officer"
--
appCopStrat :: (CopStrategy -> a -> CR b) -> a -> CR b
appCopStrat sel a = 
    do f <- gets (sel . crCopStrat)
       f a 


appCopStrat0 :: (CopStrategy -> CR a) -> CR a
appCopStrat0 sel = join (gets (sel . crCopStrat))
                   

--
-- getRobberStrat
--
getRobberStrat :: (RobberStrategy -> a) -> CR a
getRobberStrat sel = gets (sel . crRobberStrat)


--
-- Apply a Robber Strategy of one argument to some data
--
appRobberStrat :: (RobberStrategy -> a -> CR b) -> a -> CR b
appRobberStrat sel a = 
    do f <- gets (sel . crRobberStrat)
       f a


appRobberStrat0 :: (RobberStrategy -> CR a) -> CR a
appRobberStrat0 sel = join (gets (sel . crRobberStrat))

----------------------------------------------------------------------
-- The strategy data structure

data DirtyFlag = Dirty | NotDirty deriving (Eq,Show)

data CopStrategy = 
    CopStrategy { csMkRegisterMsg  :: Name -> CR Register
                , csStoreWorldSkel :: WorldSkeleton -> CR ()
                , csStoreWorld     :: World -> CR ()
                , csMkInformMsg    :: CR InformMsg
                , csMkPlanMsg      :: FromInform -> CR PlanMsg
                , csMkVoteMsg      :: FromPlan -> CR VoteMsg
                , csMkMoveMsg      :: VoteResult -> CR (CopMove, DirtyFlag)
                -- dirty cops
                , csDirtyStoreWorld      :: World -> CR ()
                , csDirtyMkInformMsg     :: CR InformMsg
                , csDirtyMkPlanMsg       :: FromInform -> CR PlanMsg
                , csDirtyMkVoteMsg       :: FromPlan -> CR VoteMsg
                , csDirtyHandleVoteRes   :: VoteResult -> CR ()
                }

data RobberStrategy = 
    RobberStrategy { rsMkRegisterMsg  :: Name -> CR Register
                   , rsStoreWorldSkel :: WorldSkeleton -> CR ()
                   , rsStoreWorld     :: World -> CR ()
                   , rsMkInformMsg    :: CR InformMsg
                   , rsMkPlanMsg      :: FromInform -> CR PlanMsg
                   , rsMkVoteMsg      :: FromPlan -> CR VoteMsg
                   , rsMkBribeMsg     :: VoteResult -> CR BribeMsg
                   , rsMkMoveMsg      :: OfferedCops -> CR RobberMove
                   } 



--
-- watchdog
--

watchdogCR :: Int -> CR a -> CR a -> CR a
watchdogCR m e c = 
    do state <- getCRState
       let eIO = runCR e state
           cIO = runCR c state
       liftIO $ watchdogIO m eIO cIO


watchdogIO :: Int  -- milliseconds
         -> IO a   -- expensive computation
         -> IO a   -- cheap computation
         -> IO a
watchdogIO millis expensive cheap = 
    do mvar <- newEmptyMVar
       tid1 <- forkIO $ do x <- expensive
                           x `seq` putMVar mvar (Just x)
       tid2 <- forkIO $ do threadDelay (millis * 1000)
                           putMVar mvar Nothing
       res <- takeMVar mvar
       case res of
         Just x -> 
             do info ("EXPENSIVE was used")
                killThread tid2 `catch` (\e -> warn (show e))
                return x
         Nothing ->
             do info ("WATCHDOG after " ++ show millis ++ " milliseconds")
                killThread tid1 `catch` (\e -> warn (show e))
                cheap

--
-- delay
--

genericDelay :: Int -> CR a -> CR a
genericDelay maxTime cr = 
    do liftIO $ threadDelay (maxTime*1000)
       cr