Skip to content

Commit c7ea245

Browse files
rbassorbasso
authored
Merge pull request #298 from rbasso/hspec-connect
connect: Rewrite test to use hspec with fail-fast.
2 parents 8013662 + 37a7127 commit c7ea245

File tree

4 files changed

+132
-138
lines changed

4 files changed

+132
-138
lines changed

‎exercises/connect/package.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,4 +17,4 @@ tests:
1717
source-dirs: test
1818
dependencies:
1919
- connect
20-
- HUnit
20+
- hspec

‎exercises/connect/src/Connect.hs‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
1-
module Connect (resultFor, Color(..)) where
1+
module Connect (Mark(..), winner) where
22

3-
data Color = Black
4-
| White
5-
deriving (Show,Eq)
3+
data Mark = Cross | Nought deriving (Eq, Show)
64

7-
resultFor :: [String] -> Maybe Color
8-
resultFor = undefined
5+
winner :: [String] -> Maybe Mark
6+
winner = undefined

‎exercises/connect/src/Example.hs‎

Lines changed: 30 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Connect (resultFor, Color(..)) where
1+
module Connect (winner, Mark(..)) where
22

33
import Control.Arrow ((***), first, second)
44
import Control.Monad.ST (ST, runST)
@@ -7,12 +7,12 @@ import qualified Data.Array.MArray as MA
77
import qualified Data.Array.ST as STA
88
import Prelude hiding (lines)
99

10-
data Color
11-
= White
12-
| Black
10+
data Mark
11+
= Cross
12+
| Nought
1313
deriving (Show,Eq)
1414

15-
type Board = A.Array (Int,Int) (Maybe Color)
15+
type Board = A.Array (Int,Int) (Maybe Mark)
1616

1717
-- Parse the lines into a board, assuming the list of lines is not empty
1818
-- and the lines are of equal non-0 size.
@@ -23,13 +23,13 @@ parseLines lines@(firstLine:_) =
2323
let height = length lines
2424
width = length firstLine
2525
in A.array ((0,0),(width - 1,height - 1)) fieldAssocs
26-
where fieldAssocs :: [((Int,Int),Maybe Color)]
26+
where fieldAssocs :: [((Int,Int),Maybe Mark)]
2727
fieldAssocs =
2828
do (l,y) <- zip lines [0 ..]
2929
(c,x) <- zip l [0 ..]
3030
let f = case c of
31-
'O' -> Just White
32-
'X' -> Just Black
31+
'O' -> Just Nought
32+
'X' -> Just Cross
3333
_ -> Nothing
3434
return ((x,y),f)
3535

@@ -52,50 +52,50 @@ neighbours b c =
5252
,(+ 1) *** subtract 1]
5353
in filter (A.inRange (A.bounds b)) . map ($ c) $ dirs
5454

55-
isTargetEdge :: Board -> Color -> (Int,Int) -> Bool
56-
isTargetEdge b Black (x,_) =
55+
isTargetEdge :: Board -> Mark -> (Int,Int) -> Bool
56+
isTargetEdge b Cross (x,_) =
5757
let (_,(ux,_)) = A.bounds b
5858
in x == ux
59-
isTargetEdge b White (_,y) =
59+
isTargetEdge b Nought (_,y) =
6060
let (_,(_,uy)) = A.bounds b
6161
in y == uy
6262

63-
startCoords :: Board -> Color -> [(Int,Int)]
64-
startCoords b Black =
63+
startCoords :: Board -> Mark -> [(Int,Int)]
64+
startCoords b Cross =
6565
let ((_,ly),(_,uy)) = A.bounds b
6666
in [(0,y) | y <- [ly .. uy]]
67-
startCoords b White =
67+
startCoords b Nought =
6868
let ((lx,_),(ux,_)) = A.bounds b
6969
in [(x,0) | x <- [lx .. ux]]
7070

71-
tryConnect :: Board -> Color -> ConnArr s -> (Int,Int) -> ST s Bool
72-
tryConnect b color ca c =
71+
tryConnect :: Board -> Mark -> ConnArr s -> (Int,Int) -> ST s Bool
72+
tryConnect b mark ca c =
7373
case b A.! c of
74-
Just fieldColor
75-
| fieldColor == color ->
74+
Just fieldMark
75+
| fieldMark == mark ->
7676
do seen <- MA.readArray ca c
7777
if seen
7878
then return False
79-
else if isTargetEdge b fieldColor c
79+
else if isTargetEdge b fieldMark c
8080
then return True
8181
else do MA.writeArray ca c True
8282
or `fmap`
83-
mapM (tryConnect b color ca)
83+
mapM (tryConnect b mark ca)
8484
(neighbours b c)
8585
_ -> return False
8686

87-
resultFor :: [String] -> Maybe Color
88-
resultFor lines =
87+
winner :: [String] -> Maybe Mark
88+
winner lines =
8989
let board = parseLines lines
90-
in if resultFor' board Black
91-
then Just Black
92-
else if resultFor' board White
93-
then Just White
90+
in if winner' board Cross
91+
then Just Cross
92+
else if winner' board Nought
93+
then Just Nought
9494
else Nothing
95-
where resultFor' :: Board -> Color -> Bool
96-
resultFor' b color =
95+
where winner' :: Board -> Mark -> Bool
96+
winner' b mark =
9797
runST $
9898
do ca <- emptyConnArr b
9999
or `fmap`
100-
mapM (tryConnect b color ca)
101-
(startCoords b color)
100+
mapM (tryConnect b mark ca)
101+
(startCoords b mark)

‎exercises/connect/test/Tests.hs‎

Lines changed: 97 additions & 101 deletions
Original file line numberDiff line numberDiff line change
@@ -1,109 +1,105 @@
1-
import Test.HUnit (Assertion, (@=?), runTestTT, Test(..), Counts(..))
2-
import System.Exit (ExitCode(..), exitWith)
3-
import Connect (resultFor, Color(Black, White))
4-
import Prelude hiding (lines) -- don't complain about redefining lines
1+
{-# LANGUAGE RecordWildCards #-}
52

6-
exitProperly :: IO Counts -> IO ()
7-
exitProperly m = do
8-
counts <- m
9-
exitWith $ if failures counts /= 0 || errors counts /= 0 then ExitFailure 1 else ExitSuccess
3+
import Data.Foldable (for_)
4+
import Test.Hspec (Spec, describe, it, shouldBe)
5+
import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith)
106

11-
testCase :: String -> Assertion -> Test
12-
testCase label assertion = TestLabel label (TestCase assertion)
7+
import Connect (Mark(Cross,Nought), winner)
138

14-
-- | Remove spaces to turn a readable board into valid input for resultFor.
15-
makeBoard :: [String] -> [String]
16-
makeBoard = map (filter (/=' '))
17-
18-
test_emptyBoard :: Assertion
19-
test_emptyBoard =
20-
let lines = [". . . . ."
21-
," . . . . ."
22-
," . . . . ."
23-
," . . . . ."
24-
," . . . . ."
25-
]
26-
in Nothing @=? resultFor (makeBoard lines)
27-
28-
test_oneByOneBlack :: Assertion
29-
test_oneByOneBlack =
30-
let lines = ["X"]
31-
in Just Black @=? resultFor (makeBoard lines)
32-
33-
test_oneByOneWhite :: Assertion
34-
test_oneByOneWhite =
35-
let lines = ["O"]
36-
in Just White @=? resultFor (makeBoard lines)
37-
38-
test_convultedPath :: Assertion
39-
test_convultedPath =
40-
let lines = [". X X . ."
41-
," X . X . X"
42-
," . X . X ."
43-
," . X X . ."
44-
," O O O O O"
45-
]
46-
in Just Black @=? resultFor (makeBoard lines)
47-
48-
test_rectangleBlack :: Assertion
49-
test_rectangleBlack =
50-
let lines = [". O . ."
51-
," O X X X"
52-
," O X O ."
53-
," X X O X"
54-
," . O X ."
55-
]
56-
in Just Black @=? resultFor (makeBoard lines)
9+
main :: IO ()
10+
main = hspecWith defaultConfig {configFastFail = True} specs
5711

58-
test_rectangleWhite :: Assertion
59-
test_rectangleWhite =
60-
let lines = [". O . ."
61-
," O X X X"
62-
," O O O ."
63-
," X X O X"
64-
," . O X ."
65-
]
66-
in Just White @=? resultFor (makeBoard lines)
12+
specs :: Spec
13+
specs = describe "connect" $
14+
describe "winner" $ for_ cases test
15+
where
6716

68-
test_spiralBlack :: Assertion
69-
test_spiralBlack =
70-
let board = ["OXXXXXXXX"
71-
,"OXOOOOOOO"
72-
,"OXOXXXXXO"
73-
,"OXOXOOOXO"
74-
,"OXOXXXOXO"
75-
,"OXOOOXOXO"
76-
,"OXXXXXOXO"
77-
,"OOOOOOOXO"
78-
,"XXXXXXXXO"
79-
]
80-
in Just Black @=? resultFor board
17+
test Case{..} = it description assertion
18+
where
19+
assertion = winner testBoard `shouldBe` expected
20+
testBoard = filter (/=' ') <$> board
8121

82-
test_spiralNone :: Assertion
83-
test_spiralNone =
84-
let board = ["OXXXXXXXX"
85-
,"OXOOOOOOO"
86-
,"OXOXXXXXO"
87-
,"OXOXOOOXO"
88-
,"OXOX.XOXO"
89-
,"OXOOOXOXO"
90-
,"OXXXXXOXO"
91-
,"OOOOOOOXO"
92-
,"XXXXXXXXO"
93-
]
94-
in Nothing @=? resultFor board
22+
-- Test cases adapted from `exercism/x-common` on 2016-09-16.
9523

96-
resultForTests :: [Test]
97-
resultForTests =
98-
[ testCase "empty board has no winner" test_emptyBoard
99-
, testCase "1x1 board with black stone" test_oneByOneBlack
100-
, testCase "1x1 board with white stone" test_oneByOneWhite
101-
, testCase "convulted path" test_convultedPath
102-
, testCase "rectangle, black wins" test_rectangleBlack
103-
, testCase "rectangle, white wins" test_rectangleWhite
104-
, testCase "spiral, black wins" test_spiralBlack
105-
, testCase "spiral, nobody wins" test_spiralNone
106-
]
24+
data Case = Case { description :: String
25+
, board :: [String]
26+
, expected :: Maybe Mark
27+
}
10728

108-
main :: IO ()
109-
main = exitProperly (runTestTT (TestList resultForTests))
29+
cases :: [Case]
30+
cases = [ Case { description = "an empty board has no winner"
31+
, board = [ ". . . . ."
32+
, " . . . . ."
33+
, " . . . . ."
34+
, " . . . . ."
35+
, " . . . . ." ]
36+
, expected = Nothing
37+
}
38+
, Case { description = "X can win on a 1x1 board"
39+
, board = [ "X" ]
40+
, expected = Just Cross
41+
}
42+
, Case { description = "O can win on a 1x1 board"
43+
, board = [ "O" ]
44+
, expected = Just Nought
45+
}
46+
, Case { description = "only edges does not make a winner"
47+
, board = [ "O O O X"
48+
, " X . . X"
49+
, " X . . X"
50+
, " X O O O" ]
51+
, expected = Nothing
52+
}
53+
, Case { description = "illegal diagonal does not make a winner"
54+
, board = [ "X O . ."
55+
, " O X X X"
56+
, " O X O ."
57+
, " . O X ."
58+
, " X X O O" ]
59+
, expected = Nothing
60+
}
61+
, Case { description = "nobody wins crossing adjacent angles"
62+
, board = [ "X . . ."
63+
, " . X O ."
64+
, " O . X O"
65+
, " . O . X"
66+
, " . . O ." ]
67+
, expected = Nothing
68+
}
69+
, Case { description = "X wins crossing from left to right"
70+
, board = [ ". O . ."
71+
, " O X X X"
72+
, " O X O ."
73+
, " X X O X"
74+
, " . O X ." ]
75+
, expected = Just Cross
76+
}
77+
, Case { description = "O wins crossing from top to bottom"
78+
, board = [ ". O . ."
79+
, " O X X X"
80+
, " O O O ."
81+
, " X X O X"
82+
, " . O X ." ]
83+
, expected = Just Nought
84+
}
85+
, Case { description = "X wins using a convoluted path"
86+
, board = [ ". X X . ."
87+
, " X . X . X"
88+
, " . X . X ."
89+
, " . X X . ."
90+
, " O O O O O" ]
91+
, expected = Just Cross
92+
}
93+
, Case { description = "X wins using a spiral path"
94+
, board = [ "O X X X X X X X X"
95+
, " O X O O O O O O O"
96+
, " O X O X X X X X O"
97+
, " O X O X O O O X O"
98+
, " O X O X X X O X O"
99+
, " O X O O O X O X O"
100+
, " O X X X X X O X O"
101+
, " O O O O O O O X O"
102+
, " X X X X X X X X O" ]
103+
, expected = Just Cross
104+
}
105+
]

0 commit comments

Comments
 (0)