Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Bullet-proofing and testing coverage.

- Converted the various index to square and algebraic squares to use
  Maybe types and handle errors sensibly.

- Added tests for a few missing items and cleaned up some of the
  existing tests a bit.

- Ran HPC reports on the whole thing and, aside from a few unused
  Show instances and one thunk in some (intentionally) bad data,
  everything is executed by the test suite.
  • Loading branch information...
commit 6508e0a8215794b885d1c66816308420fd945846 1 parent c4c1b54
Malcolm Tredinnick authored
1  .gitignore
@@ -4,4 +4,5 @@ html/
4 4 *.hi
5 5 *.o
6 6 *.tix
  7 +Suite
7 8
3  src/ChessTools/Board.hs
@@ -39,6 +39,7 @@ module ChessTools.Board (
39 39
40 40 import Data.Array ((!))
41 41 import Data.List (groupBy, sort)
  42 +import Data.Maybe (fromJust)
42 43
43 44 import ChessTools.Board.Internal
44 45
@@ -102,7 +103,7 @@ repIndexList s@(BoardSize h v _) = CL $ map head $ groupBy compFirst $ sort l
102 103 where l = [(d1 `biMinus` d2, (s1, s2)) |
103 104 (d1, s1) <- squares, (d2, s2) <- squares]
104 105 compFirst x y = fst x == fst y
105   - squares = zip (map (squareToIndex s) sqs) sqs
  106 + squares = zip (map (fromJust . squareToIndex s) sqs) sqs
106 107 sqs = [Square (x, y) | x <- [0 .. h - 1], y <- [0 .. v - 1]]
107 108
108 109
15 src/ChessTools/Board/Internal.hs
@@ -24,7 +24,7 @@ data BoardSize = BoardSize {
24 24 boardVertBuffer :: Int -- ^ Vertical buffer size for
25 25 -- jumping pieces.
26 26 }
27   - deriving (Show, Eq)
  27 + deriving (Show)
28 28
29 29 -- | The coordinates of a cell on the board.
30 30 --
@@ -80,20 +80,23 @@ newtype CoveringIndexList = CL [(LIndex, (Square, Square))]
80 80
81 81 -- | Convert a 'Square' to an index into a board array. The index is the same
82 82 -- for all board arrays associated with a given 'BoardSize'.
83   -squareToIndex :: BoardSize -> Square -> BIndex
  83 +squareToIndex :: BoardSize -> Square -> Maybe BIndex
84 84 squareToIndex s (Square (x, y))
85   - | x < 0 || y < 0 || x >= h || y >= v = BI 0
86   - | otherwise = BI $ (y + vBuf) * rowLength s + leftBuf s + x
  85 + | x < 0 || y < 0 || x >= h || y >= v = Nothing
  86 + | otherwise = Just . BI $ (y + vBuf) * rowLength s + leftBuf s + x
87 87 where BoardSize h v vBuf = s
88 88
89 89 -- | Convert a board array index to a 'Square'. This is the inverse of
90 90 -- 'squareToIndex'.
91   -indexToSquare :: BoardSize -> BIndex -> Square
92   -indexToSquare s (BI idx) = Square (x, y)
  91 +indexToSquare :: BoardSize -> BIndex -> Maybe Square
  92 +indexToSquare s (BI idx)
  93 + | x < 0 || y < 0 || x >= h || y >= v = Nothing
  94 + | otherwise = Just $ Square (x, y)
93 95 where rl = rowLength s
94 96 idx' = idx - rl * boardVertBuffer s
95 97 (y, x') = idx' `divMod` rl
96 98 x = x' - leftBuf s
  99 + BoardSize h v _ = s
97 100
98 101 -- | The length of a single (virtual) row in the board array. This is wider
99 102 -- than the board row length due to the buffer space at each end of the row.
27 src/ChessTools/Board/Western.hs
@@ -4,6 +4,7 @@
4 4 module ChessTools.Board.Western (
5 5 algebraicToIndex
6 6 , indexToAlgebraic
  7 + , westernBoardSize
7 8 ) where
8 9
9 10
@@ -22,25 +23,21 @@ westernBoardSize = BoardSize 8 8 2
22 23 -- | Converts a square name, such as /"e5"/ to an index into a board array.
23 24 -- Returns 'Nothing' if the provided string is invalid (too long or not a
24 25 -- reference to a legal square).
25   -algebraicToIndex :: [Char] -> Maybe BIndex
26   -algebraicToIndex cs
27   - | length cs /= 2 = Nothing
28   - | file < 0 || file > 7 = Nothing
29   - | rank < 0 || rank > 7 = Nothing
30   - | otherwise = Just . squareToIndex westernBoardSize $ Square (file, rank)
31   - where f:r:[] = cs
32   - file = ord f - ord 'a'
  26 +algebraicToIndex :: String -> Maybe BIndex
  27 +algebraicToIndex (f:r:[]) = squareToIndex westernBoardSize $ Square (file, rank)
  28 + where file = ord f - ord 'a'
33 29 rank = ord r - ord '1'
34 30
  31 +algebraicToIndex _ = Nothing
  32 +
  33 +
35 34 -- | Converts an index into a board array back into an algebraic notation
36 35 -- square designation, such as "/e5/".
37   -
38   --- FIXME: How to handle errors? How to even detect errors? (I don't want
39   --- indexToSquare having to go through Maybe all the time, since it will be
40   --- called all over the place.)
41   -indexToAlgebraic :: BIndex -> Maybe [Char]
42   -indexToAlgebraic x = Just $ chr (f + ord 'a') : chr (r + ord '1') : []
43   - where Square (f, r) = indexToSquare westernBoardSize x
  36 +indexToAlgebraic :: BIndex -> Maybe String
  37 +indexToAlgebraic x = case sq of
  38 + Just (Square (f, r)) -> Just $ chr (f + ord 'a') : [chr (r + ord '1')]
  39 + _ -> Nothing
  40 + where sq = indexToSquare westernBoardSize x
44 41
45 42 -- | Determine if a move /from/ an index /to/ another index is legal on the
46 43 -- given 'Board'.
69 src/ChessTools/Test/Board.hs
@@ -2,24 +2,16 @@ module ChessTools.Test.Board
2 2 where
3 3
4 4 import Control.Applicative ((<$>), (<*>))
  5 +import Control.Monad (join, liftM)
5 6 import Data.List (group, sort)
  7 +import Data.Maybe (fromJust)
6 8 import Test.QuickCheck
7 9
8 10 import ChessTools.Board
9 11 import ChessTools.Board.Internal
  12 +import ChessTools.Test.Utils
10 13
11 14
12   --- This could be an Arbitrary instance, but it would be an orphan. We don't
13   --- want to put the instance in ChessTools.Board.Internal to avoid unnecessary
14   --- QuickCheck dependencies, so prefer to use a direct Gen function here.
15   -boardSizeGen :: Gen BoardSize
16   -boardSizeGen = sized $ \n -> do
17   - let n' = n + 2
18   - dx <- choose (2, n')
19   - dy <- choose (2, n')
20   - vbuf <- choose (0, 4)
21   - return $ BoardSize dx dy vbuf
22   -
23 15 -- | For some of the more complex tests (there's at least one function that is
24 16 -- O(n^4), for example), it's more feasible to only generate small realistic
25 17 -- board sizes. An upper bound of 11 by 11 is arbitrarily used here.
@@ -27,13 +19,17 @@ smallBoardGen :: Gen BoardSize
27 19 smallBoardGen = sized $ \n ->
28 20 resize (min n 11) boardSizeGen
29 21
30   --- | Square coordinates depend upon the dimensions of the board that contains
31   --- them. Hence, this generator requires a seeding parameter: the board size.
32   -genSquare :: BoardSize -> Gen Square
33   -genSquare bs = do
34   - sx <- choose (0, boardHorizSize bs - 1)
35   - sy <- choose (0, boardVertSize bs - 1)
36   - return $ Square (sx, sy)
  22 +genBadSquare :: BoardSize -> Gen Square
  23 +genBadSquare (BoardSize h v _) = oneof [badX, badY]
  24 + where badX = do
  25 + sx <- oneof [choose (-5, -1), choose (h, h + 5)]
  26 + sy <- choose (-5, v + 5)
  27 + return $ Square (sx, sy)
  28 +
  29 + badY = do
  30 + sx <- choose (-5, h + 5)
  31 + sy <- oneof [choose (-5, -1), choose (v, v + 5)]
  32 + return $ Square (sx, sy)
37 33
38 34 genTwoSquares :: BoardSize -> Gen (Square, Square)
39 35 genTwoSquares bs = (,) <$> genSquare bs <*> genSquare bs
@@ -51,6 +47,11 @@ boardAndTwoSquareGen = do
51 47 s2 <- genSquare bs
52 48 return (bs, s1, s2)
53 49
  50 +boardAndBadSquareGen :: Gen (BoardSize, Square)
  51 +boardAndBadSquareGen = do
  52 + bs <- boardSizeGen
  53 + sq <- genBadSquare bs
  54 + return (bs, sq)
54 55
55 56 -- XXX: It's a little annoying that this is precisely how squareToIndex is
56 57 -- implemented, so it's not really verifying the result of that conversion by
@@ -59,9 +60,14 @@ boardAndTwoSquareGen = do
59 60 boardAndIndexGen :: Gen (BoardSize, BIndex)
60 61 boardAndIndexGen = do
61 62 bs <- boardSizeGen
62   - Square (dx, dy) <- genSquare bs
63   - return (bs, BI ((dy + boardVertBuffer bs) * rowLength bs + dx + leftBuf bs))
  63 + idx <- genIndex bs
  64 + return (bs, idx)
64 65
  66 +boardAndBadIndexGen :: Gen (BoardSize, BIndex)
  67 +boardAndBadIndexGen = do
  68 + bs <- boardSizeGen
  69 + idx <- genBadIndex bs
  70 + return (bs, idx)
65 71
66 72 -- The squareToIndex and indexToSquare functions should be inverses of each
67 73 -- other. That is:
@@ -69,11 +75,20 @@ boardAndIndexGen = do
69 75 -- square -> index -> square should be the identity
70 76 prop_indexToSquareInverse :: Property
71 77 prop_indexToSquareInverse = forAll boardAndIndexGen $ \(b, idx) ->
72   - squareToIndex b (indexToSquare b idx) == idx
  78 + join (squareToIndex b `liftM` indexToSquare b idx) == Just idx
73 79
74 80 prop_squareToIndexInverse :: Property
75 81 prop_squareToIndexInverse = forAll boardAndSquareGen $ \(b, sq) ->
76   - indexToSquare b (squareToIndex b sq) == sq
  82 + join (indexToSquare b `liftM` squareToIndex b sq) == Just sq
  83 +
  84 +-- squareToIndex and indexToSquare should handle bad input appropriately.
  85 +prop_errorSquareToIndex :: Property
  86 +prop_errorSquareToIndex = forAll boardAndBadSquareGen $ \(b, sq) ->
  87 + squareToIndex b sq == Nothing
  88 +
  89 +prop_errorIndexToSquare :: Property
  90 +prop_errorIndexToSquare = forAll boardAndBadIndexGen $ \(b, idx) ->
  91 + indexToSquare b idx == Nothing
77 92
78 93 -- As squares move from lower left ("a1" in western chess) to upper right (h8),
79 94 -- the index into the lookup table should increase.
@@ -123,15 +138,17 @@ rTable2 = rankTable repList2
123 138 sTable1 = squareTable repList1
124 139 sTable2 = squareTable repList2
125 140
126   -fileCheckFunc, rankCheckFunc, squareCheckFunc :: Square -> Square -> Int
  141 +type SquareCmpFunc = Square -> Square -> Int
  142 +
  143 +fileCheckFunc, rankCheckFunc, squareCheckFunc :: SquareCmpFunc
127 144 fileCheckFunc (Square s1) (Square s2) = abs $ fst s1 - fst s2
128 145 rankCheckFunc (Square s1) (Square s2) = abs $ snd s1 - snd s2
129 146 squareCheckFunc sq1 sq2 = max (fileCheckFunc sq1 sq2) (rankCheckFunc sq1 sq2)
130 147
131   -checkLookup :: LookupTable -> (Square -> Square -> Int) -> BoardSize -> Property
  148 +checkLookup :: LookupTable -> SquareCmpFunc -> BoardSize -> Property
132 149 checkLookup lt cmp b = forAll (genTwoSquares b) $ \(sq1, sq2) ->
133   - let idx1 = squareToIndex b sq1
134   - idx2 = squareToIndex b sq2
  150 + let idx1 = fromJust $ squareToIndex b sq1
  151 + idx2 = fromJust $ squareToIndex b sq2
135 152 in fetch lt idx1 idx2 == cmp sq1 sq2
136 153
137 154 prop_checkFileDistance1 :: Property
4 src/ChessTools/Test/Suite.hs
@@ -21,6 +21,8 @@ tests = [
21 21 testGroup "Board arrays" [
22 22 testProperty "index to square" prop_indexToSquareInverse
23 23 , testProperty "square to index" prop_squareToIndexInverse
  24 + , testProperty "bad square to index" prop_errorSquareToIndex
  25 + , testProperty "bad index to square" prop_errorIndexToSquare
24 26 , testProperty "indices increase" prop_indexIncreasesWithSquare
25 27 , testProperty "array size" prop_boardArraySize
26 28 ]
@@ -36,6 +38,8 @@ tests = [
36 38 , testGroup "Western notation" [
37 39 testProperty "good algebraic squares" prop_goodAlgebraicSquares
38 40 , testProperty "bad algebraic squares" prop_badAlgebraicSquares
  41 + , testProperty "index to algebraic" prop_indexToAlgebraic
  42 + , testProperty "bad index to algebraic" prop_errorIndexToAlgebraic
39 43 ]
40 44 ]
41 45
59 src/ChessTools/Test/Utils.hs
... ... @@ -0,0 +1,59 @@
  1 +{- Some QuickCheck generators and other utility functions used in a few test
  2 + - modules.
  3 + -}
  4 +
  5 +module ChessTools.Test.Utils (
  6 + boardSizeGen
  7 + , genIndex
  8 + , genBadIndex
  9 + , genSquare
  10 +) where
  11 +
  12 +import Test.QuickCheck
  13 +
  14 +import ChessTools.Board
  15 +import ChessTools.Board.Internal
  16 +
  17 +
  18 +-- This could be an Arbitrary instance, but it would be an orphan. We don't
  19 +-- want to put the instance in ChessTools.Board.Internal to avoid unnecessary
  20 +-- QuickCheck dependencies, so prefer to use a direct Gen function here.
  21 +boardSizeGen :: Gen BoardSize
  22 +boardSizeGen = sized $ \n -> do
  23 + let n' = n + 2
  24 + dx <- choose (2, n')
  25 + dy <- choose (2, n')
  26 + vbuf <- choose (0, 4)
  27 + return $ BoardSize dx dy vbuf
  28 +
  29 +genIndex :: BoardSize -> Gen BIndex
  30 +genIndex bs = do
  31 + Square (dx, dy) <- genSquare bs
  32 + return $ BI ((dy + boardVertBuffer bs) * rowLength bs + dx + leftBuf bs)
  33 +
  34 +genBadIndex :: BoardSize -> Gen BIndex
  35 +genBadIndex (BoardSize h v vbuf)
  36 + | vbuf == 0 = leftBuffer
  37 + | otherwise = oneof [leftBuffer, above, below]
  38 + where rl = 2 * h - 1
  39 + leftBuffer = do
  40 + x <- choose (0, v - 1)
  41 + y <- choose (0, h `div` 2 - 1)
  42 + return $ BI ((vbuf + x) * rl + y)
  43 +
  44 + above = do
  45 + x <- choose (0, vbuf - 1)
  46 + y <- choose (0, rl - 1)
  47 + return $ BI ((vbuf + v + x) * rl + y)
  48 +
  49 + below = do
  50 + x <- choose (0, vbuf - 1)
  51 + y <- choose (0, rl - 1)
  52 + return $ BI (x * rl + y)
  53 +
  54 +genSquare :: BoardSize -> Gen Square
  55 +genSquare bs = do
  56 + sx <- choose (0, boardHorizSize bs - 1)
  57 + sy <- choose (0, boardVertSize bs - 1)
  58 + return $ Square (sx, sy)
  59 +
47 src/ChessTools/Test/WesternBoard.hs
@@ -2,22 +2,23 @@ module ChessTools.Test.WesternBoard
2 2 where
3 3
4 4 import Data.Char (ord, chr)
  5 +import Data.Maybe (fromJust)
5 6 import Test.QuickCheck
6 7
7 8 import ChessTools.Board.Western
  9 +import ChessTools.Test.Utils
8 10
9   -pairToCoords :: Int -> Int -> [Char]
10   -pairToCoords f r = chr (f + ord 'a') : chr (r + ord '1') : []
  11 +pairToCoords :: Int -> Int -> String
  12 +pairToCoords f r = chr (f + ord 'a') : [chr (r + ord '1')]
11 13
12   -validAlgebraicSquaresGen :: Gen [Char]
13   -validAlgebraicSquaresGen = do
  14 +algebraicSquaresGen :: Gen String
  15 +algebraicSquaresGen = do
14 16 file <- choose (0, 7)
15 17 rank <- choose (0, 7)
16 18 return $ pairToCoords file rank
17 19
18   -invalidAlgebraicSquaresGen :: Gen [Char]
19   -invalidAlgebraicSquaresGen =
20   - oneof [badFile, badRank, longName]
  20 +badAlgebraicSquaresGen :: Gen String
  21 +badAlgebraicSquaresGen = oneof [badFile, badRank, nameTooLong]
21 22 where badFile = do
22 23 file <- oneof [choose (-10, -1), choose (8, 12)]
23 24 rank <- choose (-3, 10)
@@ -28,21 +29,29 @@ invalidAlgebraicSquaresGen =
28 29 rank <- oneof [choose (-10, -1), choose (8, 12)]
29 30 return $ pairToCoords file rank
30 31
31   - longName = do
32   - x <- choose ('a', 'z')
33   - c <- validAlgebraicSquaresGen
34   - return $ c ++ [x]
  32 + nameTooLong = do
  33 + c <- algebraicSquaresGen
  34 + return $ c ++ "X"
35 35
36 36
37 37 prop_goodAlgebraicSquares :: Property
38   -prop_goodAlgebraicSquares = forAll validAlgebraicSquaresGen $ \s ->
39   - case algebraicToIndex s of
40   - Nothing -> False
41   - _ -> True
  38 +prop_goodAlgebraicSquares = forAll algebraicSquaresGen $ \s ->
  39 + algebraicToIndex s /= Nothing
42 40
43 41 prop_badAlgebraicSquares :: Property
44   -prop_badAlgebraicSquares = forAll invalidAlgebraicSquaresGen $ \s ->
45   - case algebraicToIndex s of
46   - Nothing -> True
47   - _ -> False
  42 +prop_badAlgebraicSquares = forAll badAlgebraicSquaresGen $ \s ->
  43 + algebraicToIndex s == Nothing
  44 +
  45 +prop_indexToAlgebraic :: Property
  46 +prop_indexToAlgebraic = forAll (genIndex westernBoardSize) $ \idx ->
  47 + let s = indexToAlgebraic idx
  48 + (f:r:[]) = fromJust s
  49 + in s /= Nothing &&
  50 + length (fromJust s) == 2 &&
  51 + 'a' <= f && f <= 'h' &&
  52 + '1' <= r && r <= '8'
  53 +
  54 +prop_errorIndexToAlgebraic :: Property
  55 +prop_errorIndexToAlgebraic = forAll (genBadIndex westernBoardSize) $ \idx ->
  56 + indexToAlgebraic idx == Nothing
48 57

0 comments on commit 6508e0a

Please sign in to comment.
Something went wrong with that request. Please try again.