#### 168 lines 4.5 KiB Haskell Raw Normal View History

 2019-02-25 01:05:39 -08:00 `-- | This module defines the state of a running Karel program.` `module KarelState where` ``` ``` `import Prelude hiding (Either(..))` `import KarelSyntax` ``` ``` ``` ``` `--` `-- * Positions and directions` `--` ``` ``` `-- | A cartesian coordinate, representing a position in the world.` `type Pos = (Int,Int)` ``` ``` `-- | Get the position next to the given position, offset by one square` `-- in the indicated *cardinal* direction.` `neighbor :: Card -> Pos -> Pos` `neighbor North (x,y) = (x,y+1)` `neighbor South (x,y) = (x,y-1)` `neighbor East (x,y) = (x+1,y)` `neighbor West (x,y) = (x-1,y)` ``` ``` `-- | Get a cardinal direction relative to the current one.` `cardTurn :: Dir -> Card -> Card` `cardTurn Front c = c` `cardTurn Back North = South` `cardTurn Back South = North` `cardTurn Back East = West` `cardTurn Back West = East` `cardTurn Left North = West` `cardTurn Left South = East` `cardTurn Left East = North` `cardTurn Left West = South` `cardTurn Right North = East` `cardTurn Right South = West` `cardTurn Right East = South` `cardTurn Right West = North` ``` ``` ``` ``` `--` `-- * World state` `--` ``` ``` `-- | The state of the world is represented by a function that returns` `-- for each position:` `-- * Nothing, if the position is a wall` `-- * Just k, if the position is clear and has k beepers` `-- You can assume k is always >= 0.` `type World = Pos -> Maybe Int` ``` ``` `-- | Is the given position clear?` `isClear :: Pos -> World -> Bool` `isClear p w = w p /= Nothing` ``` ``` `-- | Is there a beeper at the given position?` `hasBeeper :: Pos -> World -> Bool` `hasBeeper p w = maybe False (>0) (w p)` ``` ``` `-- | Increment the number of beepers at the given position.` `incBeeper :: Pos -> World -> World` `incBeeper p w = \q -> if p == q ` ` then case w q of` ` Nothing -> Just 1` ` Just i -> Just (i+1)` ` else w q` ``` ``` `-- | Decrement the number of beepers at the given position. Note that this` `-- function can yield a world with negative beepers, so you should make` `-- sure to only decrement the beepers at a position after first checking` `-- to make sure there is at least one beeper there (using `hasBeeper`).` `decBeeper :: Pos -> World -> World` `decBeeper p w = \q -> if p == q then fmap (subtract 1) (w q) else w q` ``` ``` ``` ``` `--` `-- * Robot state` `--` ``` ``` `-- | The state of the robot is represented by a triple containing:` `-- * the current position` `-- * the current facing (cardinal direction)` `-- * the number of beepers in the beeper bag` `type Robot = (Pos,Card,Int)` ``` ``` ``` ``` `-- ** Robot position` ``` ``` `-- | The robot's position.` `getPos :: Robot -> Pos` `getPos (p,_,_) = p` ``` ``` `-- | Get a position relative to the robot's current facing and position.` `relativePos :: Dir -> Robot -> Pos` `relativePos d (p,c,_) = neighbor (cardTurn d c) p` ``` ``` `-- | Set the robot's position.` `setPos :: Pos -> Robot -> Robot` `setPos p (_,c,b) = (p,c,b)` ``` ``` `-- | Update the robot's position using an update function.` `updatePos :: (Pos -> Pos) -> Robot -> Robot` `updatePos f (p,c,b) = (f p,c,b)` ``` ``` ``` ``` `-- ** Robot facing` ``` ``` `-- | The robot's facing (cardinal direction).` `getFacing :: Robot -> Card` `getFacing (_,c,_) = c` ``` ``` `-- | Set the robot's facing.` `setFacing :: Card -> Robot -> Robot` `setFacing c (p,_,b) = (p,c,b)` ``` ``` `-- | Update the robot's facing using an update function.` `updateFacing :: (Card -> Card) -> Robot -> Robot` `updateFacing f (p,c,b) = (p,f c,b)` ``` ``` ``` ``` `-- ** Beeper bag` ``` ``` `-- | The number of beepers in the beeper bag.` `getBag :: Robot -> Int` `getBag (_,_,b) = b` ``` ``` `-- | Is the beeper bag empty?` `isEmpty :: Robot -> Bool` `isEmpty (_,_,b) = b <= 0` ``` ``` `-- | Increment the number of beepers in the bag.` `incBag :: Robot -> Robot` `incBag (p,c,b) = (p,c,b+1)` ``` ``` `-- | Decrement the number of beepers in the bag.` `decBag :: Robot -> Robot` `decBag (p,c,b) = (p,c,b-1)` ``` ``` ``` ``` `--` `-- * Statement results` `--` ``` ``` `-- | The result of executing a statement.` `-- ` `-- * OK: The statement executed successfully, so return the updated state` `-- of the world and the robot. OK to execute the next statement.` `--` `-- * Done: Produced only by the Shutdown statement. This returns the final` `-- state of the robot. No further statements should be executed.` `--` `-- * Error: An error occurred. Includes a string for reporting error messages.` `-- No further statements should be executed.` `--` `data Result = OK World Robot` ` | Done Robot` ` | Error String` ``` ``` `instance Show Result where` ` show (OK _ r) = "OK: " ++ show r` ` show (Done r) = "Done: " ++ show r` ` show (Error s) = "Error: " ++ s` ``` ``` `-- | Applies a function to the result if its an OK, otherwise returns` `-- the result unchanged.` `onOK :: (World -> Robot -> Result) -> Result -> Result` `onOK f (OK w r) = f w r` `onOK _ result = result`