|  | 
| 1 |  | -import Test.HUnit (Assertion, (@=?), runTestTT, Test(..), Counts(..)) | 
| 2 |  | -import System.Exit (ExitCode(..), exitWith) | 
| 3 |  | -import Robot (Bearing(..), Robot, mkRobot, | 
| 4 |  | -              coordinates, simulate, | 
| 5 |  | -              bearing, turnRight, turnLeft) | 
|  | 1 | +{-# OPTIONS_GHC -fno-warn-type-defaults #-} | 
| 6 | 2 | 
 | 
| 7 |  | -exitProperly :: IO Counts -> IO () | 
| 8 |  | -exitProperly m = do | 
| 9 |  | -  counts <- m | 
| 10 |  | -  exitWith $ if failures counts /= 0 || errors counts /= 0 then ExitFailure 1 else ExitSuccess | 
|  | 3 | +import Test.Hspec        (Spec, describe, it, shouldBe) | 
|  | 4 | +import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith) | 
| 11 | 5 | 
 | 
| 12 |  | -testCase :: String -> Assertion -> Test | 
| 13 |  | -testCase label assertion = TestLabel label (TestCase assertion) | 
|  | 6 | +import Robot | 
|  | 7 | +  ( Bearing ( East | 
|  | 8 | +            , North | 
|  | 9 | +            , South | 
|  | 10 | +            , West | 
|  | 11 | +            ) | 
|  | 12 | +  , bearing | 
|  | 13 | +  , coordinates | 
|  | 14 | +  , mkRobot | 
|  | 15 | +  , simulate | 
|  | 16 | +  , turnLeft | 
|  | 17 | +  , turnRight | 
|  | 18 | +  ) | 
| 14 | 19 | 
 | 
| 15 | 20 | main :: IO () | 
| 16 |  | -main = exitProperly $ runTestTT $ TestList | 
| 17 |  | -  [ TestList robotTests ] | 
| 18 |  | - | 
| 19 |  | -robotTests :: [Test] | 
| 20 |  | -robotTests = | 
| 21 |  | -  [ testCase "turning cases" $ do | 
| 22 |  | -    West  @=? turnLeft North | 
| 23 |  | -    South @=? turnLeft West | 
| 24 |  | -    East  @=? turnLeft South | 
| 25 |  | -    North @=? turnLeft East | 
| 26 |  | -    East  @=? turnRight North | 
| 27 |  | -    South @=? turnRight East | 
| 28 |  | -    West  @=? turnRight South | 
| 29 |  | -    North @=? turnRight West | 
| 30 |  | -  , testCase "robbie" $ do | 
| 31 |  | -    let robbie :: Robot | 
| 32 |  | -        robbie = mkRobot East (-2, 1) | 
| 33 |  | -    East @=? bearing robbie | 
| 34 |  | -    (-2, 1) @=? coordinates robbie | 
| 35 |  | -    let movedRobbie = simulate robbie "RLAALAL" | 
| 36 |  | -    West @=? bearing movedRobbie | 
| 37 |  | -    (0, 2) @=? coordinates movedRobbie | 
| 38 |  | -    mkRobot West (0, 2) @=? movedRobbie | 
| 39 |  | -  , testCase "clutz" $ do | 
| 40 |  | -    let clutz = mkRobot North (0, 0) | 
| 41 |  | -    mkRobot West (-4, 1) @=? simulate clutz "LAAARALA" | 
| 42 |  | -  , testCase "sphero" $ do | 
| 43 |  | -    let sphero = mkRobot East (2, -7) | 
| 44 |  | -    mkRobot South (-3, -8) @=? simulate sphero "RRAAAAALA" | 
| 45 |  | -  , testCase "roomba" $ do | 
| 46 |  | -    let roomba = mkRobot South (8, 4) | 
| 47 |  | -    mkRobot North (11, 5) @=? simulate roomba "LAAARRRALLLL" | 
| 48 |  | -  ] | 
|  | 21 | +main = hspecWith defaultConfig {configFastFail = True} specs | 
|  | 22 | + | 
|  | 23 | +specs :: Spec | 
|  | 24 | +specs = describe "robot-simulator" $ do | 
|  | 25 | + | 
|  | 26 | +    -- Test cases adapted from `exercism/x-common/robot-simulator.json` | 
|  | 27 | +    -- on 2016-08-02. Some deviations exist and are noted in comments. | 
|  | 28 | + | 
|  | 29 | +    describe "mkRobot" $ do | 
|  | 30 | + | 
|  | 31 | +    -- The function described by the reference file | 
|  | 32 | +    -- as `create` is called `mkRobot` in this track. | 
|  | 33 | + | 
|  | 34 | +      it "A robot is created with a position and a direction" $ do | 
|  | 35 | +        let robot = mkRobot North (0, 0) | 
|  | 36 | +        coordinates robot `shouldBe` (0, 0) | 
|  | 37 | +        bearing     robot `shouldBe` North | 
|  | 38 | + | 
|  | 39 | +      it "Negative positions are allowed" $ do | 
|  | 40 | +        let robot = mkRobot South (-1, -1) | 
|  | 41 | +        coordinates robot `shouldBe` (-1, -1) | 
|  | 42 | +        bearing     robot `shouldBe` South | 
|  | 43 | + | 
|  | 44 | +    -- The reference tests for `turnLeft` and `turnRight` describe | 
|  | 45 | +    -- functions that are applied to robots positioned at (0, 0). | 
|  | 46 | +    -- In this track, they are functions over directions, so those | 
|  | 47 | +    -- test cases cannot be completely implemented. | 
|  | 48 | + | 
|  | 49 | +    describe "turnRight" $ do | 
|  | 50 | + | 
|  | 51 | +      it "turn from North" $ turnRight North `shouldBe` East | 
|  | 52 | +      it "turn from East"  $ turnRight East  `shouldBe` South | 
|  | 53 | +      it "turn from South" $ turnRight South `shouldBe` West | 
|  | 54 | +      it "turn from West"  $ turnRight West  `shouldBe` North | 
|  | 55 | + | 
|  | 56 | +    describe "turnLeft" $ do | 
|  | 57 | + | 
|  | 58 | +      it "turn from North" $ turnLeft North `shouldBe` West | 
|  | 59 | +      it "turn from West"  $ turnLeft West  `shouldBe` South | 
|  | 60 | +      it "turn from South" $ turnLeft South `shouldBe` East | 
|  | 61 | +      it "turn from East"  $ turnLeft East  `shouldBe` North | 
|  | 62 | + | 
|  | 63 | +    describe "simulate advance" $ do | 
|  | 64 | + | 
|  | 65 | +    -- The function described by the reference file as `advance` | 
|  | 66 | +    -- doesn't exist in this track, so we test `simulate` with "A". | 
|  | 67 | + | 
|  | 68 | +      let dir `from` pos = simulate (mkRobot dir pos) "A" | 
|  | 69 | + | 
|  | 70 | +      it "does not change the direction" $ | 
|  | 71 | +        bearing (North `from` (0, 0)) `shouldBe` North | 
|  | 72 | + | 
|  | 73 | +      it "increases the y coordinate one when facing north" $ | 
|  | 74 | +        coordinates (North `from` (0, 0)) `shouldBe` (0, 1) | 
|  | 75 | + | 
|  | 76 | +      it "decreases the y coordinate by one when facing south" $ | 
|  | 77 | +        coordinates (South `from` (0, 0)) `shouldBe` (0, -1) | 
|  | 78 | + | 
|  | 79 | +      it "increases the x coordinate by one when facing east" $ | 
|  | 80 | +        coordinates (East `from` (0, 0)) `shouldBe` (1, 0) | 
|  | 81 | + | 
|  | 82 | +      it "decreases the x coordinate by one when facing west" $ | 
|  | 83 | +        coordinates (West `from` (0, 0)) `shouldBe `(-1, 0) | 
|  | 84 | + | 
|  | 85 | +    describe "simulate" $ do | 
|  | 86 | + | 
|  | 87 | +    -- The function described by the reference file as | 
|  | 88 | +    -- `instructions` is called `simulate` in this track. | 
|  | 89 | + | 
|  | 90 | +      let simulation pos dir = simulate (mkRobot dir pos) | 
|  | 91 | + | 
|  | 92 | +      it "instructions to move west and north" $ do | 
|  | 93 | +        let robot = simulation (0, 0) North "LAAARALA" | 
|  | 94 | +        coordinates robot `shouldBe` (-4, 1) | 
|  | 95 | +        bearing     robot `shouldBe` West | 
|  | 96 | + | 
|  | 97 | +      it "instructions to move west and south" $ do | 
|  | 98 | +        let robot = simulation (2, -7) East "RRAAAAALA" | 
|  | 99 | +        coordinates robot `shouldBe` (-3, -8) | 
|  | 100 | +        bearing     robot `shouldBe` South | 
|  | 101 | + | 
|  | 102 | +      it "instructions to move east and north" $ do | 
|  | 103 | +        let robot = simulation (8, 4) South "LAAARRRALLLL" | 
|  | 104 | +        coordinates robot `shouldBe` (11, 5) | 
|  | 105 | +        bearing     robot `shouldBe` North | 
0 commit comments