{-# LANGUAGE GADTs, TemplateHaskell, DoAndIfThenElse #-}

-- | This module implements the events that can affect a game.
module Language.Nomyx.Engine.GameEvents where

import Prelude hiding (log)
import Control.Monad.State
import Data.List
import Language.Nomyx.Expression
import Language.Nomyx.Engine.Evaluation
import Language.Nomyx.Engine.Game
import Language.Nomyx.Engine.Utils
import Data.Lens
import Control.Category ((>>>))
import Data.Lens.Template
import Control.Exception as E
import Control.Monad.Trans.State hiding (get)
import Data.Maybe
import Data.Time


-- | a list of possible events affecting a game
data GameEvent = GameSettings      GameName GameDesc UTCTime
               | JoinGame          PlayerNumber PlayerName
               | LeaveGame         PlayerNumber
               | ProposeRuleEv     PlayerNumber SubmitRule
               | InputResult       PlayerNumber EventNumber UInputData
               | GLog              (Maybe PlayerNumber) String
               | TimeEvent         UTCTime
               | SystemAddRule     SubmitRule
                 deriving (Show, Read, Eq, Ord)

data TimedEvent = TimedEvent UTCTime GameEvent deriving (Show, Read, Eq, Ord)

-- | A game being non serializable, we have to store events in parralel in order to rebuild the state latter.
data LoggedGame = LoggedGame { _game :: Game,
                               _gameLog :: [TimedEvent]}
                               deriving (Read, Show)

instance Eq LoggedGame where
   (LoggedGame {_game=g1}) == (LoggedGame {_game=g2}) = g1 == g2

instance Ord LoggedGame where
   compare (LoggedGame {_game=g1}) (LoggedGame {_game=g2}) = compare g1 g2

$( makeLens ''LoggedGame)

-- | perform a game event
enactEvent :: GameEvent -> Maybe (RuleCode -> IO RuleFunc) -> StateT Game IO ()
enactEvent (GameSettings name desc date) _    = mapStateIO $ gameSettings name desc date
enactEvent (JoinGame pn name) _               = mapStateIO $ joinGame name pn
enactEvent (LeaveGame pn) _                   = mapStateIO $ leaveGame pn
enactEvent (ProposeRuleEv pn sr) (Just inter) = void $ proposeRule sr pn inter
enactEvent (InputResult pn en ir) _           = mapStateIO $ inputResult pn en ir
enactEvent (GLog mpn s) _                     = mapStateIO $ logGame s mpn
enactEvent (TimeEvent t) _                    = mapStateIO $ runEvalError 0 $ void $ evTriggerTime t
enactEvent (SystemAddRule r) (Just inter)     = systemAddRule r inter
enactEvent (ProposeRuleEv _ _) Nothing        = error "ProposeRuleEv: interpreter function needed"
enactEvent (SystemAddRule _) Nothing          = error "SystemAddRule: interpreter function needed"

enactTimedEvent :: Maybe (RuleCode -> IO RuleFunc) -> TimedEvent -> StateT Game IO ()
enactTimedEvent inter (TimedEvent t ge) = flip stateCatch updateError $ do
   currentTime ~= t
   enactEvent ge inter
   lg <- get
   lift $ evaluate lg
   return ()

updateError :: SomeException -> StateT Game IO ()
updateError e = do
   liftIO $ putStrLn $ "IO error: " ++ (show e)
   mapStateIO $ logGame ("IO error: " ++ (show e)) Nothing

execGameEvent :: GameEvent -> StateT LoggedGame IO ()
execGameEvent ge = execGameEvent' Nothing ge

execGameEvent' :: Maybe (RuleCode -> IO RuleFunc) -> GameEvent -> StateT LoggedGame IO ()
execGameEvent' inter ge = do
   t <- access $ game >>> currentTime
   let te = TimedEvent t ge
   gameLog %= \gl -> gl ++ [te]
   focus game $ enactTimedEvent inter te

getLoggedGame :: Game -> (RuleCode -> IO RuleFunc) -> [TimedEvent] -> IO LoggedGame
getLoggedGame g mInter tes = do
   let a = mapM_ (enactTimedEvent (Just mInter)) tes
   g' <- execStateT a g
   return $ LoggedGame g' tes


-- | initialize the game.
gameSettings :: GameName -> GameDesc -> UTCTime -> State Game ()
gameSettings name desc date = do
   gameName ~= name
   gameDesc ~= desc
   currentTime ~= date
   return ()


-- | join the game.
joinGame :: PlayerName -> PlayerNumber -> State Game ()
joinGame name pn = do
   g <- get
   case find ((== pn) . getL playerNumber) (_players g) of
      Just _ -> return ()
      Nothing -> do
         tracePN pn $ "Joining game: " ++ (_gameName g)
         let player = PlayerInfo { _playerNumber = pn, _playerName = name}
         players %= (player : )
         runEvalError pn $ triggerEvent_ (Player Arrive) (PlayerData player)


-- | leave the game.
leaveGame :: PlayerNumber -> State Game ()
leaveGame pn = runEvalError pn $ void $ evDelPlayer pn

-- | insert a rule in pending rules.
proposeRule :: SubmitRule -> PlayerNumber -> (RuleCode -> IO RuleFunc) -> StateT Game IO ()
proposeRule sr pn inter = do
   rule <- createRule sr pn inter
   mapStateIO $ runEvalError pn $ do
      r <- evProposeRule rule
      if r == True then tracePN pn $ "Your rule has been added to pending rules."
      else tracePN pn $ "Error: Rule could not be proposed"

-- | add a rule forcefully (no votes etc.)
systemAddRule :: SubmitRule -> (RuleCode -> IO RuleFunc) -> StateT Game IO ()
systemAddRule sr inter = do
   rule <- createRule sr 0 inter
   let sysRule = (rStatus ^= Active) >>> (rAssessedBy ^= Just 0)
   rules %= (sysRule rule : )
   mapStateIO $ runEvalError 0 $ void $ evalExp (_rRuleFunc rule) (_rNumber rule)

-- | insert a log message.
logGame :: String -> (Maybe PlayerNumber) -> State Game ()
logGame s mpn = do
   time <- access currentTime
   void $ logs %= (Log mpn time s : )

-- | the user has provided an input result
inputResult :: PlayerNumber -> EventNumber -> UInputData -> State Game ()
inputResult pn en ir = do
   tracePN pn $ "input result: Event " ++ (show en) ++ ", choice " ++  (show ir)
   runEvalError pn $ triggerInput en ir


getEventHandler :: EventNumber -> LoggedGame -> EventHandler
getEventHandler en g = fromJust $ findEvent en (_events $ _game g)


getTimes :: EventHandler -> Maybe UTCTime
getTimes (EH _ _ (Time t) _ SActive) = Just t
getTimes _ = Nothing

-- | A helper function to use the state transformer GameState.
-- It additionally sets the current time.
execWithGame :: UTCTime -> State LoggedGame () -> LoggedGame -> LoggedGame
execWithGame t gs g = execState gs $ ((game >>> currentTime) `setL` t $ g)

execWithGame' :: UTCTime -> StateT LoggedGame IO () -> LoggedGame -> IO LoggedGame
execWithGame' t gs g = execStateT gs ((game >>> currentTime) `setL` t $ g)


activeRules :: Game -> [Rule]
activeRules = sort . filter ((==Active) . getL rStatus) . _rules

pendingRules :: Game -> [Rule]
pendingRules = sort . filter ((==Pending) . getL rStatus) . _rules

rejectedRules :: Game -> [Rule]
rejectedRules = sort . filter ((==Reject) . getL rStatus) . _rules


createRule :: SubmitRule -> PlayerNumber -> (RuleCode -> IO RuleFunc) -> StateT Game IO Rule
createRule (SubmitRule name desc code) pn inter = do
   rs <- access rules
   let rn = getFreeNumber $ map _rNumber rs
   rf <- lift $ inter code
   tracePN pn $ "Creating rule n=" ++ (show rn) ++ " code=" ++ code
   return $ Rule {_rNumber = rn,
                  _rName = name,
                  _rDescription = desc,
                  _rProposedBy = pn,
                  _rRuleCode = code,
                  _rRuleFunc = rf,
                  _rStatus = Pending,
                  _rAssessedBy = Nothing}


stateCatch = liftCatch E.catch