-- Eval.hs
-- Tom Moertel <tom@moertel.com>
-- CVS $Id: Eval.hs,v 1.6 2002/09/09 19:56:13 thor Exp $

-- | The Eval module provides functions to evaluate the historical
-- actions that occurred during each turn of a Game.  The actions
-- are evaluated in the context of a 'GameState', which represents
-- everything we know about the the current state of a game.  The
-- 'GameState' tracks both robots and packages in detail.

module Eval (evalGame, evalTurn) where

import Control.Monad.State
import Data.FiniteMap
import Data.List ((\\), delete)

import BasicTypes
import Board
import Commands
import Game
import GameState

-- |Evaluates every turn in the game to yield a complete turn-by-turn
-- analysis.

evalGame                :: Game -> [GameState]
evalGame g              =  scanl evalTurn emptyState adjustedHistory
    where
    adjustedHistory     =  turn0 { gtServerResponse = adj0Response } : turnRest
    turn0 : turnRest    =  gameHistory g
    adj0Response        =  gtServerResponse turn0 ++ rbtConfigCmds
    rbtConfigCmds       =  [RCL rid [SetMoney m] 
                            | (rid, cfg) <- gameRobotConfigs g
                            , let m = rcRbtInitialMoney cfg]

-- |Evaluates the server updates for a turn in the context of the
-- given GameState to yield a new GameState that represents the state
-- of the game after the turn has ended.

evalTurn                :: GameState -> GameTurn -> GameState
evalTurn g gt@(GameTurn pkgHistory bidHistory rbtHistory)
                        =  flip execState g $ do
                               evalPkgHistory pkgHistory
                               evalBidHistory bidHistory
                               evalRbtHistory rbtHistory

-- |Evaluates the list of packages that each robot sees and updates
-- the GameState accordingly.

evalPkgHistory          :: [(RobotID, [PackageInfo])] -> State GameState ()
evalPkgHistory pkhs     =  mapM_ robotSeesPackages pkhs
    where
    robotSeesPackages (rid, pinfos)
                        =  do
                           (GS rbtK _) <- get
                           let Just rbt = lookupFM rbtK rid
                           let rloc = rbtLocation rbt
                           mapM_ (declarePkgInfo rloc) pinfos
    declarePkgInfo loc (PackageInfo pid dest weight)
                        =  modifyPackage_ pid $ \pkg ->
                           pkg { pkgLocation    = Just (OnGround loc)
                               , pkgDestination = Just dest
                               , pkgWeight      = Just weight
                               }

-- |Evaluates the list of commands that the robots sent to the server
-- in order to extract bid information and update the GameState's
-- robot knowledge accordingly.

evalBidHistory          :: [(RobotID, String)] -> State GameState ()
evalBidHistory cmds     =  mapM_ (uncurry evalBidCmd) cmds
    where
    evalBidCmd rid cmd  =  modifyRobot_ rid (processBid cmd)
    processBid cmd rbt  =  rbt { rbtMoney = case rbtMoney rbt of
                                                Just m -> Just (m - abs bid)
                                                _      -> Nothing
                               , rbtBidAndCommand = cmd
                               }
        where
        bid             =  (read . head . words $ cmd) :: Money

-- |Evaluates the list of commands that each robot executed during the
-- turn.  This is the list of commands that is provided in the server
-- response at the end of each turn, not the commands that the robot
-- /tried/ to execute.  The list of commands serves not only to tell
-- us what the robots did during the turn but also to let us know
-- which robots are still alive.  Only live robots are reported as
-- having executed commands. The GameState is updated to reflect the
-- game after the commands have been executed.

evalRbtHistory          :: [RobotCommandList] -> State GameState ()
evalRbtHistory rcls     =  do
                           removeAllButLiveRobots rcls
                           mapM_ evalRCL rcls

-- |Evaluates the /here is what the robots did/ portion of the robot
-- turn history and updates the GameState accordingly.

evalRCL                 :: RobotCommandList -> State GameState ()
evalRCL (RCL rid cmds)  =  mapM_ e cmds
    where
    e (SetRobot loc)    =  declareRobot rid loc
    e (SetMoney amt)    =  modifyRobot_ rid $ \rbt -> rbt {rbtMoney = Just amt}
    e (Move North)      =  move ( 0, 1)
    e (Move South)      =  move ( 0,-1)
    e (Move East)       =  move ( 1, 0)
    e (Move West)       =  move (-1, 0)
    e (Drop pkgIds)     =  mapM_ (dropPackage rid) pkgIds
    e (PickUp pkgIds)   =  mapM_ (pickupPackage rid) pkgIds
    move                =  moveRobot rid

-- |Move the robot by the provided relative adjustment.

moveRobot               :: RobotID -> Point -> State GameState ()
moveRobot rid (dx, dy)  =  modifyRobot_ rid robotLocation
    where
    robotLocation rbt   =  rbt { rbtLocation = loc' }
        where
        loc'            =  (x + dx, y + dy)
        (x, y)          =  rbtLocation rbt

-- |Make the given robot pickup the given package.

pickupPackage           :: RobotID -> PackageID -> State GameState ()
pickupPackage rid pid   =  do
                           modifyPackage_ pid $
                             \pkg -> pkg { pkgLocation = Just (OnRobot rid) }
                           modifyRobot_ rid $
                             \rbt -> rbt {rbtPackages = pid : rbtPackages rbt}

-- |Make the given robot drop the given package.  Updates the robot's
-- score if enough knowledge is available to do so.  Reliable scoring
-- is possible only for robots whose perspectives are incorporated
-- into the Game being analyzed.

dropPackage             :: RobotID -> PackageID -> State GameState ()
dropPackage rid pid     =  do
                           (GS rbtK pkgK) <- get
                           let Just rbt = lookupFM rbtK rid
                           let Just pkg = lookupFM pkgK pid
                           let rloc = rbtLocation rbt
                           modifyRobot_ rid robotDrops
                           case (pkgDestination pkg) of
                               Just pdest | pdest == rloc
                                   -> do -- robot delivers a package
                                      modifyRobot_ rid (robotScores pkg)
                                      modifyPackageKnowlg_ $
                                          \pkgK -> delFromFM pkgK pid
                               _   -> do -- robot merely drops a package
                                      modifyPackage_ pid $
                                          \pkg -> pkg { pkgLocation = 
                                                        Just (OnGround rloc) }
    where
    robotDrops rbt      =  rbt { rbtPackages = delete pid (rbtPackages rbt) }
    robotScores pkg rbt =  rbt { rbtScore = score' }
        where
        score'          =  case (rbtScore rbt, pkgWeight pkg) of
                               (Just score, Just weight) -> Just (score+weight)
                               _                         -> Nothing
                                                            
-- |Declares that a robot a with the given ID exits at the given location

declareRobot            :: RobotID -- ^ ID of robot being declared
                        -> Point   -- ^ Location of robot
                        -> State GameState ()
                             -- ^ Action that declares the robot.

declareRobot rid loc    =  modifyRobotKnowlg_ $ \rbtK ->
                               addToFM_C update rbtK rid newRobot
    where
    update rbt _        =  rbt { rbtLocation = loc }
    newRobot            =  Robot { rbtID            = rid
                                 , rbtLocation      = loc
                                 , rbtPackages      = []
                                 , rbtMoney         = Nothing
                                 , rbtScore         = Just 0
                                 , rbtAlive         = True
                                 , rbtBidAndCommand = "?"
                                 }

-- |Removes dead robots (i.e., all robots not listed as being alive)

removeAllButLiveRobots  :: [RobotCommandList]
                            -- ^Command list (which lists live robots)
                        -> State GameState [RobotID] 
                            -- ^Action that marks dead robots as dead,
                            -- removes their packages from the game,
                            -- and returns the deceased robots' IDs
removeAllButLiveRobots rcls
                        =  do
                           gs@(GS rbtK _) <- get
                           let allRobots = keysFM rbtK
                           let liveRobots = map rclRobotID rcls
                           let deadRobots = allRobots \\ liveRobots
                           lostRbtPkgs <- mapM markAsDead deadRobots
                           modifyPackageKnowlg_ $ \pkgK ->
                               delListFromFM pkgK (concat lostRbtPkgs)
                           return deadRobots
    where
    markAsDead rid      =  modifyRobot rid $ \rbt ->
                               ( rbt { rbtAlive = False, rbtPackages = [] }
                               , rbtPackages rbt 
                               )

-- |Helper function that modifies the game state's robot knowledge

modifyRobotKnowlg_      :: (RobotKnowledge -> RobotKnowledge)
                        -> State GameState ()
modifyRobotKnowlg_ f    =  modify $ \gs -> gs { gsRobots = f ( gsRobots gs ) }


-- |Hepler function that modifies the state for a single robot and
-- allows a value to be returned.

modifyRobot             :: RobotID -- ^ ID of robot to modify
                        -> (Robot -> (Robot,a)) -- ^ Robot modifier function
                        -> State GameState a
                           -- ^Action that performs the modification
                           --  and returns the extra value provided by the
                           --  modifier function.
modifyRobot rid f       =  do
                           gs@(GS rbtK _) <- get
                           let Just rbt = lookupFM rbtK rid
                           let (rbt', misc) = f rbt
                           modifyRobotKnowlg_ $ \rbtK ->
                               addToFM_C (update rbt') rbtK rid dummyRobot
                           return misc
    where
    update rbt' _ _     =  rbt'
    dummyRobot          =  error ("Eval: modifyRobot: robot " ++ show rid
                                  ++ " doesn't exist!")

-- |Hepler function that modifies the state for a single robot.

modifyRobot_            :: RobotID -- ^ ID of robot to modify
                        -> (Robot -> Robot) -- ^ Robot modifier function
                        -> State GameState ()
                           -- ^ Action that modifies the robot
modifyRobot_ rid f      =  modifyRobot rid g
    where
    g rbt               =  (f rbt, ())


-- |Helper function that modifies the game state's package knowledge

modifyPackageKnowlg_    :: (PackageKnowledge -> PackageKnowledge)
                        -> State GameState ()
modifyPackageKnowlg_ f  =  modify $ \gs -> gs { gsPackages = f (gsPackages gs)}

-- |Hepler function that modifies the state for a single package.  If
-- the specified package doesn't exist, it is created on the fly.

modifyPackage_          :: PackageID -- ^ ID of package to modify
                        -> (Package -> Package) -- ^ Modifier function
                        -> State GameState ()
                           -- ^ Action that modfies the package
modifyPackage_ pid f    =  modifyPackageKnowlg_ $ \pkgK ->
                           addToFM_C update pkgK pid newPackage
    where
    update pkg _        =  f pkg
    newPackage          =  f (Package { pkgID          = pid
                                      , pkgLocation    = Nothing
                                      , pkgDestination = Nothing
                                      , pkgWeight      = Nothing
                                      }
                              )


-- =================================================================
--
-- Copyright (C) 2002 Thomas Moertel.
-- 
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License
-- as published by the Free Software Foundation; either version 2
-- of the License, or (at your option) any later version.
-- 
-- The text of the GNU GPL may be found in the LICENSE file,
-- included with this software, or online at the following URL:
-- 
--     http://www.gnu.org/copyleft/gpl.html
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- Except as provided for under the terms of the GNU GPL, all rights
-- are reserved worldwide.
--
-- =================================================================