--
-- 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)
--

--
--
-- RobberMcGruff Main
--

module Main (main) where

import Logging
import FSM
import CR
import Syntax 
import KnowledgeBase
import RobberFSM
import Graph 
import Utils
import System
import CmdlineArgs
import qualified RobberSPMoveFun        ( moveFun )

import Data.IORef
import System.IO.Unsafe         ( unsafePerformIO )

import Data.List


type MoveFun = CR Move

defaultMoveFun :: MoveFun
defaultMoveFun = RobberSPMoveFun.moveFun

main :: IO ()
main = do (flags,_) <- parseArgs
          let ll = Info  -- getLogLevel flags -- Ignore 
          initLogging ll UseStderr -- (Filename "robber.log")
          runCR robber (robberCRState defaultMoveFun)

robber :: CR ()
robber = do initState <- mkStateInitial "MrStoopid"
            runFSM initState

------------------------------------------------------------------------

robberCRState :: CR Move -> CRState
robberCRState mfun =
  CRState { 
    crCopStrat = niceError "No cop strategy for robber",
    crRobberStrat = robberStrat mfun,
    crKB = Nothing
  }

robberStrat :: CR Move -> RobberStrategy
robberStrat moveFun = 
    RobberStrategy 
        { rsMkRegisterMsg  = \name -> 
            do return $ Register name Robber
        , rsStoreWorldSkel = 
          \wks -> do let kb = mkInitialKnowledge wks kbRobberCfg
                     setKB kb
        , rsStoreWorld     = 
          \w -> do kb <- getKB
                   let kb' = updateKnowledge kb w
                   setKB kb'
        , rsMkInformMsg = mkInformMsg
        , rsMkPlanMsg   = \fi -> mkPlanMsg fi
        , rsMkVoteMsg   = \fp -> mkVoteMsg fp
        , rsMkBribeMsg  = \vr -> mkBribeMsg vr
        , rsMkMoveMsg   = mkMoveMsg moveFun
        }

------------------------------------------------------------------------

-- an IORef to store any move we got from a dirty cop.

maybeMove :: IORef (Maybe Location)
maybeMove = unsafePerformIO $ newIORef Nothing
{-# NOINLINE maybeMove #-}

----------------------------------------------------------------------

-- don't bother
mkInformMsg :: CR InformMsg
mkInformMsg   = return $  InformMsg []

-- don't bother
mkPlanMsg :: FromInform -> CR PlanMsg
mkPlanMsg   _ = return $ PlanMsg []

-- if we get a non-null plan, find our location, and store it in the state.
mkVoteMsg :: FromPlan -> CR VoteMsg


-- a single plan for us to move to.
mkVoteMsg (FromPlan [FromMsgP _ [Plan _ loc Robber _]]) = do
        kb <- getKB
        let ourName = kb_ownName  kb
        liftIO $ modifyIORef maybeMove (const $ Just loc)
        return (VoteMsg [ourName])

mkVoteMsg (FromPlan _) = 
    do liftIO $ modifyIORef maybeMove (const Nothing) -- blank it out if no plans
       kb <- getKB
       let cops = kb_cops kb
           dirtyCops = map cop_name (filter (\cop -> cop_dirty cop 
                                             == DirtyForSure) cops)
           ourName = kb_ownName  kb
       return $ VoteMsg (ourName : dirtyCops)

--
-- try to bribe
--
mkBribeMsg :: VoteResult -> CR BribeMsg
mkBribeMsg _ = do
        kb <- getKB
        let loot = kb_robberLoot kb
        if loot > 50
                then info "RobberBribe" >> return RobberBribe
                else info ("RobberLoot: " ++ show loot) >> return RobberNoBribe

--
-- This just puts a wrapper around the moveFun provided. This means
-- that cops that are offering to be bribed does *not* affect the robber's 
-- move. If you want to do this then the logic will have to be moved 
-- inside @moveFun.
--
mkMoveMsg :: CR Move -> OfferedCops -> CR RobberMove
mkMoveMsg moveFun offeredCops =
    do kb <- getKB

       bribeResult <- case offeredCops of
             NotTelling -> return NoBribe
             OfferedCops copNames -> 
                 --
                 -- FIXME: Must check whether cop has EVER been bribed
                 --
                  if null copNames 
                      then -- push a cop randomly 
                        do let firstCop = head (kb_cops kb)
                           nodes <- pushNodes firstCop
                           return $ Push (cop_name firstCop) 
                                      (locOfNode (head nodes))
                      else -- bribe first cop
                          return $ Choose (ChooseBlock [head copNames])

       let ownName = kb_ownName kb 

       -- only run this if no move in plan.
       -- move <- moveFun  -- 
       mloc  <- liftIO $ readIORef maybeMove
       move  <- case mloc  of
                        Just mv -> return (Move mv Robber ownName)
                        Nothing -> moveFun

       return $ RobberMove move bribeResult

    where findCop name cops = 
             case find (\cop -> cop_name cop == name) cops of
                Just cop -> cop
                Nothing -> niceError $ "Cop with name " ++ show name ++ 
                                       " not found"
----------------------------------------------------------------------

--
-- Takes a cop and returns a number of nodes it could be pushed to
--

pushNodes :: Cop -> CR [GNode]
pushNodes cop = 
    do kb <- getKB 
       let graph = case cop_type cop of
                     ByFoot -> kb_footMap kb
                     ByCar -> kb_carMap kb
       return $ gsucc graph (cop_node cop)