module ServerMessages ( -- * Functions msgParse, isBadObject, -- * Data Types MarsMsg(..), Object(..), -- * Constants tests, blankInitMsg, blankTelemMsg ) where import Test.HUnit data MarsMsg = -- | Message received on first run InitMsg { dx :: Float, -- ^ Span of map's x-axis (meters) dy :: Float, -- ^ Span of map's y-axis (meters) time_limit :: Int, -- ^ Time limit for map (milliseconds) min_sensor :: Float, -- ^ Minimum range of visual sensor (meters) max_sensor :: Float, -- ^ Maximum range of visual sensor (meters) max_speed :: Float, -- ^ Maximum speed of the vehicle (meters per second) max_turn :: Float, -- ^ Maximum rotational speed when turning (degrees per second) max_hard_turn :: Float -- ^ Maximal rotational speed when turning hard (degrees per second) } | -- | Telemetry message, received every 100ms TelemMsg { time_stamp :: Int, -- ^ Number of milliseconds since start of run vehicle_ctl :: String, -- ^ Vehicle control state. First character is acceleration (a, b, -), second is turning (L, l, -, r, R). vehicle_x :: Float, -- ^ X-coordinate of vehicle's current position vehicle_y :: Float, -- ^ Y-coordinate of vehicle's current position vehicle_dir :: Float, -- ^ Direction of vehicle as a counterclockwise angle from the x-axis vehicle_speed :: Float, -- ^ Vehicle's current speed (meters per second) objects :: [Object] -- ^ Objects visible to the vehicle } | -- | We ran into a boulder (non-fatal) BoulderCrashMsg { time_stamp :: Int -- ^ Number of milliseconds since start of run } | -- | We fell into a crater (end of run) FallIntoCraterMsg { time_stamp :: Int -- ^ Number of milliseconds since start of run } | -- | We were killed by a martian (end of run) KilledByMartianMsg { time_stamp :: Int -- ^ Number of milliseconds since start of run } | -- | We reached home base (end of run) SuccessMsg { time_stamp :: Int -- ^ Number of milliseconds since start of run } | -- | Run is over (time limit reached, or adverse event) EndMsg { time_stamp :: Int, -- ^ Time since beginning of run (milliseconds) score :: Int -- ^ Score (run time + penalties) } deriving (Show, Read, Eq) blankInitMsg = InitMsg 0 0 0 0 0 0 0 0 blankTelemMsg = TelemMsg 0 "-" 0 0 0 0 [] data Object = Object { object_kind :: Char, -- ^ (b)oulder, (c)rater, (h)omebase object_x :: Float, -- ^ X-coordinate of object's center object_y :: Float, -- ^ Y-coordinate of object's center object_r :: Float -- ^ Object's radius (meters) } | Martian { object_x :: Float, -- ^ X-coordinate of enemy's center object_y :: Float, -- ^ Y-coordinate of enemy's center enemy_dir :: Float, -- ^ Enemy's radius (degrees) enemy_speed :: Float -- ^ Enemy's speed (meters per second) } deriving (Show, Read, Eq) msgParse :: String -> MarsMsg msgParse s@(h:xs) = case h of 'I' -> initMsgParse s 'T' -> telemMsgParse s 'B' -> BoulderCrashMsg $ readTimestamp xs 'C' -> FallIntoCraterMsg $ readTimestamp xs 'K' -> KilledByMartianMsg $ readTimestamp xs 'S' -> SuccessMsg $ readTimestamp xs 'E' -> endMsgParse s where readTimestamp ts = read $ (head (words ts)) endMsgParse :: String -> MarsMsg endMsgParse str = let tag:time:score:ws = words str in EndMsg (read time) (read score) initMsgParse :: String -> MarsMsg initMsgParse str = let _:b:c:d:e:f:g:h:i:zs = words str in InitMsg (read b) (read c) (read d) (read e) (read f) (read g) (read h) (read i) telemMsgParse :: String -> MarsMsg telemMsgParse str = let tok = words str in TelemMsg (read (tok !! 1)) (tok !! 2) (read (tok !! 3)) (read (tok !! 4)) (read (tok !! 5)) (read (tok !! 6)) (telemObjectsParse (drop 7 tok)) telemObjectsParse :: [String] -> [Object] telemObjectsParse (a:b:c:d:as) = case a of "m" -> (Martian (read b) (read c) (read d) (read $ head as)) : (telemObjectsParse (tail as)) otherwise -> (Object (head a) (read b) (read c) (read d)) : (telemObjectsParse as) telemObjectsParse x = [] -- Account for trailing ';' -- | Predicate for bad/enemy objects: crater, boulder, martian. -- Useful to remove home base from objects we want to avoid isBadObject :: Object -> Bool isBadObject o = case o of Object k x y r-> (k /= 'h') otherwise -> True tests = TestList [TestLabel "Initialization Message" testInitMsg, TestLabel "Telemetry Message" testTelemMsg, TestLabel "Telemetry Message with martian" testTelemObjsMsg, TestLabel "Telemetry Message with boulders" testTelemBoulderMsg, TestLabel "Boulder Crash Message" testAdverseMsgBoulder, TestLabel "Success Message" testSuccessMsg, TestLabel "End Message" testEndMsg] testTelemMsg = TestCase $ do let str = "T 500 -- 187.500 -187.500 125.0 0.000 ;" let msg = msgParse str case msg of TelemMsg _ _ _ _ _ _ [] -> do assertEqual "telem msg" (TelemMsg 500 "--" 187.500 (-187.500) 125.0 0.000 []) msg otherwise -> assertFailure "Expected Telemetry Msg" testTelemObjsMsg = TestCase $ do let str = "T 9400 -- 187.500 -187.500 125.0 0.000 m 152.899 -149.660 -34.3 11.700 ;" let msg = telemMsgParse str case msg of TelemMsg _ _ _ _ _ _ (m:ms) -> do assertEqual "timestamp" 9400 (time_stamp msg) assertEqual "martian" (Martian 152.899 (-149.660) (-34.3) 11.700) m otherwise -> assertFailure "Expected Telemetry Msg" testTelemBoulderMsg = TestCase $ do let str = "T 0 -- 156.250 -156.250 62.5 0.000 b 148.438 -101.563 1.462 b 132.813 -117.188 1.462 b 195.313 -117.188 1.096 " let msg = telemMsgParse str case msg of TelemMsg _ _ _ _ _ _ (a:b:bs) -> do assertEqual "timestamp" 0 (time_stamp msg) assertEqual "boulder #1" (Object 'b' 148.438 (-101.563) 1.462) a otherwise -> assertFailure "Expected Telemetry Msg" testInitMsg = TestCase $ do let str = "I 500.000 500.000 30000 30.000 60.000 20.000 20.0 60.0 ;" let msg = msgParse str case msg of InitMsg _ _ _ _ _ _ _ _ -> do assertEqual "dx" 500.000 (dx msg) assertEqual "dy" 500.000 (dy msg) otherwise -> assertFailure "Expected Initialization Msg" testAdverseMsgBoulder = TestCase $ do let ts = 5000 let str = "B " ++ (show ts) ++ " ;" let msg = msgParse str case msg of BoulderCrashMsg t -> do assertEqual "boulder crash timestamp" ts t otherwise -> assertFailure "Expected Boulder Crash Msg" testSuccessMsg = TestCase $ do let ts = 5000 let str = "S " ++ (show ts) ++ " ;" let msg = msgParse str case msg of SuccessMsg t -> do assertEqual "Success timestamp" ts t otherwise -> assertFailure "Expected Success Msg" testEndMsg = TestCase $ do let ts = 5000 let score = 1000 let str = "E " ++ (show ts) ++ " " ++ (show score) ++ " ;" let msg = msgParse str case msg of EndMsg t s -> do assertEqual "End timestamp" ts t assertEqual "End score" score s otherwise -> assertFailure "Expected Success Msg"