-- -- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) -- -- -- abstract syntax for communication protocol in icfp 05 -- module Syntax where type Name = String type Names = [Name] data Message = SendMessage SendMessage | RecvMessage RecvMessage deriving (Show,Eq) data SendMessage = MsgRegister Register | MsgCopMove CopMove | MsgRobberMove RobberMove | MsgInform InformMsg | MsgPlan PlanMsg | MsgVote VoteMsg | MsgBribe BribeMsg deriving (Show,Eq) data RecvMessage = MsgWorldSkel WorldSkeleton | MsgWorld World | MsgGameOver GameOver | MsgAccused Accused | MsgVoteRes VoteResult | MsgFromInf FromInform | MsgFromPlan FromPlan | MsgOfferedCops OfferedCops deriving (Show,Eq) ------------------------------------------------------------------------ -- A World Skeleton Message (S -> C) ------------------------------------------------------------------------ -- -- A world skeleton -- data WorldSkeleton = WorldSkeleton !Name !Name -- Robber ![Name] -- Cops !Nodes !Edges deriving (Show,Eq) -- --------------------------------------------------------------------- -- A Node descriptor data Node = Node !Location !NodeTag !(Coord,Coord) deriving (Show,Eq) type Nodes = [Node] -- A location type Location = Name -- Tags on nodes data NodeTag = HqTag | BankTag | RobberStartTag | OrdinaryTag deriving (Show,Eq) mkNodeTag :: String -> NodeTag mkNodeTag s = case s of "hq" -> HqTag -- exactly one hq "bank" -> BankTag "robber-start" -> RobberStartTag -- exactly one robber-start "ordinary" -> OrdinaryTag s -> error ("invalid argument: " ++ show s) -- A Co-ordinate [0 .. 1023] type Coord = Int -- (0,0) is top left -- --------------------------------------------------------------------- -- An edge descriptor data Edge = Edge !Location !Location !EdgeType deriving (Show,Eq) data EdgeType = Car | Foot deriving (Show,Eq) mkEdgeType :: String -> EdgeType mkEdgeType s = case s of "car" -> Car "foot" -> Foot s -> error ("invalid argument: " ++ show s) type Edges = [Edge] ------------------------------------------------------------------------ -- The World Message: (S -> C) ------------------------------------------------------------------------ -- -- A World. All the data available in a world: -- * values at banks -- * if there's evidence -- * location and types of players -- data World = World !WorldNum !Loot !(Maybe [Name])-- Just the dirty cops, Nothing for the clean cop ![(Name,Name)] -- associate controlled cops with their controllers ![FAccuse] -- all false accusations !BankValues !Evidences !(Maybe Smell) -- a smell of 0 means no robber. We use Nothing !Players deriving (Show,Eq) -- -- false accusations -- data FAccuse = FAccuse !Name !Name !WorldNum deriving (Show,Eq) -- --------------------------------------------------------------------- -- bank values -- type BankValues = [BankValue] findBankValue :: Monad m => Location -> BankValues -> m BankValue findBankValue loc [] = fail ("no bank at location " ++ show loc) findBankValue loc (bv@(BankValue loc' _) : rest) | loc == loc' = return bv | otherwise = findBankValue loc rest data BankValue = BankValue !Location !Money deriving (Show,Eq) type WorldNum = Int -- 0 .. 200 type Loot = Int -- 0 .. 6000 type Money = Int -- 0 .. 1000 -- --------------------------------------------------------------------- -- evidence values -- type Evidences = [Evidence] data Evidence = Evidence !Location !WorldNum deriving (Show,Eq) -- --------------------------------------------------------------------- -- smells data Smell = Smell !Distance deriving (Show,Eq) type Distance = Int -- 0 .. (1024*1024) ------------------------------------------------------------------------ -- Players type Players = [Player] data Player = Player !Name !Location !PlayerType deriving (Show,Eq) findPlayer :: Monad m => Name -> Players -> m Player findPlayer name [] = fail ("no player with name " ++ show name) findPlayer name (p@(Player name' _ _) : rest) | name == name' = return p | otherwise = findPlayer name rest findRobber :: Monad m => Players -> m Player findRobber [] = fail ("no robber in players list") findRobber (p@(Player _ _ Robber) : _) = return p findRobber (_ : rest) = findRobber rest data PlayerType = CopFoot | CopCar | Robber deriving (Show,Eq) mkPType :: String -> PlayerType mkPType s = case s of "cop-foot" -> CopFoot "cop-car" -> CopCar "robber" -> Robber s -> error ("invalid argument: " ++ show s) ------------------------------------------------------------------------ -- The Game Over Message (S -> C) ------------------------------------------------------------------------ data GameOver = GameOver deriving (Show,Eq) ------------------------------------------------------------------------ -- valid accusation, game over for us ------------------------------------------------------------------------ data Accused = Accused deriving (Show,Eq) ------------------------------------------------------------------------ -- The Vote Tally Message (S -> C) ------------------------------------------------------------------------ data VoteResult = Winner !Name | NoWinner deriving (Show,Eq) ------------------------------------------------------------------------ -- From Messages Informs from other Cops (S -> C) ------------------------------------------------------------------------ -- -- The parser constructs an untyped form for the following, which is -- then rewritten to distinguish FromInforms and FromPlans -- -- and a better-typed FromMsgs newtype FromInform = FromInform [FromMsgI] deriving (Show,Eq) newtype FromPlan = FromPlan [FromMsgP] deriving (Show,Eq) data FromMsgI = FromMsgI !Name !Informs deriving (Show,Eq) data FromMsgP = FromMsgP !Name !Plans deriving (Show,Eq) ------------------------------------------------------------------------ -- An Inform msg ------------------------------------------------------------------------ -- -- This message is sent by us to the server -- newtype InformMsg = InformMsg Informs deriving (Show,Eq) -- informs can be sent by the `inform' message type Informs = [Inform] data Inform = Inform !Name !Location !PlayerType !WorldNum !Certainty deriving (Show,Eq) type Certainty = Int -- -100 .. 100 ------------------------------------------------------------------------ -- A Suggest Plan ------------------------------------------------------------------------ -- -- This message is sent by us to the server -- newtype PlanMsg = PlanMsg Plans deriving (Show,Eq) -- Plans can be sent by the 'suggest plan' message type Plans = [Plan] data Plan = Plan !Name !Location !PlayerType !WorldNum deriving (Show,Eq) ------------------------------------------------------------------------ -- THE FOLLOWING ARE MESSAGE TYPES WE NEED TO PASS TO THE SERVER ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- A Register Message ------------------------------------------------------------------------ data Register = Register !Name !PlayerType deriving (Show,Eq) ------------------------------------------------------------------------ -- A Cop Move Message ------------------------------------------------------------------------ data CopMove = CopMove !Offer !MoveBlock -- list of moves for bots under our control !AccuseBlock deriving (Show,Eq) ------------------------------------------------------------------------ newtype MoveBlock = MoveBlock [Move] deriving (Show,Eq) newtype AccuseBlock = AccuseBlock Accusations deriving (Show,Eq) -- -- Offer to be bribed, or not. -- data Offer = TurnCoat | Straight deriving (Show,Eq) -- -- An accusation of corruption -- type Accusations = Names ------------------------------------------------------------------------ -- A Robber Move Message ------------------------------------------------------------------------ data RobberMove = RobberMove !Move !BribeResult deriving (Show,Eq) data BribeResult = Push !Name !Location | Choose ChooseBlock | NoBribe deriving (Show,Eq) newtype ChooseBlock = ChooseBlock [Choice] deriving (Show,Eq) type Choice = Name ------------------------------------------------------------------------ -- -- A Move Message -- data Move = Move !Location !PlayerType !Name{-new field-} deriving (Show,Eq) ------------------------------------------------------------------------ -- A Vote Message ------------------------------------------------------------------------ newtype VoteMsg = VoteMsg Names deriving (Show,Eq) ------------------------------------------------------------------------ -- An Offered Cops Message (to the robber) ------------------------------------------------------------------------ data OfferedCops -- isomorphic to Maybe = NotTelling | OfferedCops Names deriving (Show,Eq) ------------------------------------------------------------------------ -- A Bribe/NoBribe message ------------------------------------------------------------------------ data BribeMsg = RobberBribe | RobberNoBribe deriving (Show, Eq) ------------------------------------------------------------------------ -- -- used to disambiguate 'from' messages -- data ParseStateFlag = InformSt | PlanSt | DontCareSt