--
-- |
-- Module      : RobberStrategy
-- Authors     : Sean Seefried (http://www.cse.unsw.edu.au/~sseefried)
-- Copyright   : (c) 2005
-- License     : GPL version 2 or later
-- Created     : 10 Jul 2005
--
module RobberStrategy
where

import Data.List

-- local imports
import Logging
import CR
import Syntax
import KnowledgeBase
import Graph 
import Utils

import CopInform  ( informMessage )

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


delay = genericDelay 4000

-- NB: precomputeFun must run in a separate thread!
robberStrat :: CR () -> CR Move -> RobberStrategy
robberStrat precomputeFun 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'
                   precomputeFun
        , rsMkInformMsg = 
          do kb <- getKB
             if kb_worldCount kb == 0
                then do info "not delaying in mkInformMsg"
                        mkInformMsg
                else delay mkInformMsg
        , rsMkPlanMsg   = \fi -> delay $ mkPlanMsg fi
        , rsMkVoteMsg   = \fp -> delay $ mkVoteMsg fp
        , rsMkBribeMsg  = \vr -> delay $ mkBribeMsg vr
        , rsMkMoveMsg   = mkMoveMsg moveFun
        }
    

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

mkInformMsg :: CR InformMsg
mkInformMsg   = return $  InformMsg []

mkPlanMsg :: FromInform -> CR PlanMsg
mkPlanMsg   _ = return $ PlanMsg []

mkVoteMsg :: FromPlan -> CR VoteMsg
mkVoteMsg   _ = 
    do 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)

--
-- Never bribes.
--

mkBribeMsg :: VoteResult -> CR BribeMsg
mkBribeMsg _ = 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
       move <- moveFun 
       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 firstCopName = head copNames
                               cops = kb_cops kb
                               firstCop = findCop firstCopName cops 
                           nodes <- pushNodes firstCop
                           return $ Push firstCopName (locOfNode (head nodes))
                      else -- bribe first cop
                          return $ Choose (ChooseBlock [head copNames])
       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)