Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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
View
@@ -4,4 +4,5 @@ html/
*.hi
*.o
*.tix
+Suite
3  src/ChessTools/Board.hs
View
@@ -39,6 +39,7 @@ module ChessTools.Board (
import Data.Array ((!))
import Data.List (groupBy, sort)
+import Data.Maybe (fromJust)
import ChessTools.Board.Internal
@@ -102,7 +103,7 @@ repIndexList s@(BoardSize h v _) = CL $ map head $ groupBy compFirst $ sort l
where l = [(d1 `biMinus` d2, (s1, s2)) |
(d1, s1) <- squares, (d2, s2) <- squares]
compFirst x y = fst x == fst y
- squares = zip (map (squareToIndex s) sqs) sqs
+ squares = zip (map (fromJust . squareToIndex s) sqs) sqs
sqs = [Square (x, y) | x <- [0 .. h - 1], y <- [0 .. v - 1]]
15 src/ChessTools/Board/Internal.hs
View
@@ -24,7 +24,7 @@ data BoardSize = BoardSize {
boardVertBuffer :: Int -- ^ Vertical buffer size for
-- jumping pieces.
}
- deriving (Show, Eq)
+ deriving (Show)
-- | The coordinates of a cell on the board.
--
@@ -80,20 +80,23 @@ newtype CoveringIndexList = CL [(LIndex, (Square, Square))]
-- | Convert a 'Square' to an index into a board array. The index is the same
-- for all board arrays associated with a given 'BoardSize'.
-squareToIndex :: BoardSize -> Square -> BIndex
+squareToIndex :: BoardSize -> Square -> Maybe BIndex
squareToIndex s (Square (x, y))
- | x < 0 || y < 0 || x >= h || y >= v = BI 0
- | otherwise = BI $ (y + vBuf) * rowLength s + leftBuf s + x
+ | x < 0 || y < 0 || x >= h || y >= v = Nothing
+ | otherwise = Just . BI $ (y + vBuf) * rowLength s + leftBuf s + x
where BoardSize h v vBuf = s
-- | Convert a board array index to a 'Square'. This is the inverse of
-- 'squareToIndex'.
-indexToSquare :: BoardSize -> BIndex -> Square
-indexToSquare s (BI idx) = Square (x, y)
+indexToSquare :: BoardSize -> BIndex -> Maybe Square
+indexToSquare s (BI idx)
+ | x < 0 || y < 0 || x >= h || y >= v = Nothing
+ | otherwise = Just $ Square (x, y)
where rl = rowLength s
idx' = idx - rl * boardVertBuffer s
(y, x') = idx' `divMod` rl
x = x' - leftBuf s
+ BoardSize h v _ = s
-- | The length of a single (virtual) row in the board array. This is wider
-- than the board row length due to the buffer space at each end of the row.
27 src/ChessTools/Board/Western.hs
View
@@ -4,6 +4,7 @@
module ChessTools.Board.Western (
algebraicToIndex
, indexToAlgebraic
+ , westernBoardSize
) where
@@ -22,25 +23,21 @@ westernBoardSize = BoardSize 8 8 2
-- | Converts a square name, such as /"e5"/ to an index into a board array.
-- Returns 'Nothing' if the provided string is invalid (too long or not a
-- reference to a legal square).
-algebraicToIndex :: [Char] -> Maybe BIndex
-algebraicToIndex cs
- | length cs /= 2 = Nothing
- | file < 0 || file > 7 = Nothing
- | rank < 0 || rank > 7 = Nothing
- | otherwise = Just . squareToIndex westernBoardSize $ Square (file, rank)
- where f:r:[] = cs
- file = ord f - ord 'a'
+algebraicToIndex :: String -> Maybe BIndex
+algebraicToIndex (f:r:[]) = squareToIndex westernBoardSize $ Square (file, rank)
+ where file = ord f - ord 'a'
rank = ord r - ord '1'
+algebraicToIndex _ = Nothing
+
+
-- | Converts an index into a board array back into an algebraic notation
-- square designation, such as "/e5/".
-
--- FIXME: How to handle errors? How to even detect errors? (I don't want
--- indexToSquare having to go through Maybe all the time, since it will be
--- called all over the place.)
-indexToAlgebraic :: BIndex -> Maybe [Char]
-indexToAlgebraic x = Just $ chr (f + ord 'a') : chr (r + ord '1') : []
- where Square (f, r) = indexToSquare westernBoardSize x
+indexToAlgebraic :: BIndex -> Maybe String
+indexToAlgebraic x = case sq of
+ Just (Square (f, r)) -> Just $ chr (f + ord 'a') : [chr (r + ord '1')]
+ _ -> Nothing
+ where sq = indexToSquare westernBoardSize x
-- | Determine if a move /from/ an index /to/ another index is legal on the
-- given 'Board'.
69 src/ChessTools/Test/Board.hs
View
@@ -2,24 +2,16 @@ module ChessTools.Test.Board
where
import Control.Applicative ((<$>), (<*>))
+import Control.Monad (join, liftM)
import Data.List (group, sort)
+import Data.Maybe (fromJust)
import Test.QuickCheck
import ChessTools.Board
import ChessTools.Board.Internal
+import ChessTools.Test.Utils
--- This could be an Arbitrary instance, but it would be an orphan. We don't
--- want to put the instance in ChessTools.Board.Internal to avoid unnecessary
--- QuickCheck dependencies, so prefer to use a direct Gen function here.
-boardSizeGen :: Gen BoardSize
-boardSizeGen = sized $ \n -> do
- let n' = n + 2
- dx <- choose (2, n')
- dy <- choose (2, n')
- vbuf <- choose (0, 4)
- return $ BoardSize dx dy vbuf
-
-- | For some of the more complex tests (there's at least one function that is
-- O(n^4), for example), it's more feasible to only generate small realistic
-- board sizes. An upper bound of 11 by 11 is arbitrarily used here.
@@ -27,13 +19,17 @@ smallBoardGen :: Gen BoardSize
smallBoardGen = sized $ \n ->
resize (min n 11) boardSizeGen
--- | Square coordinates depend upon the dimensions of the board that contains
--- them. Hence, this generator requires a seeding parameter: the board size.
-genSquare :: BoardSize -> Gen Square
-genSquare bs = do
- sx <- choose (0, boardHorizSize bs - 1)
- sy <- choose (0, boardVertSize bs - 1)
- return $ Square (sx, sy)
+genBadSquare :: BoardSize -> Gen Square
+genBadSquare (BoardSize h v _) = oneof [badX, badY]
+ where badX = do
+ sx <- oneof [choose (-5, -1), choose (h, h + 5)]
+ sy <- choose (-5, v + 5)
+ return $ Square (sx, sy)
+
+ badY = do
+ sx <- choose (-5, h + 5)
+ sy <- oneof [choose (-5, -1), choose (v, v + 5)]
+ return $ Square (sx, sy)
genTwoSquares :: BoardSize -> Gen (Square, Square)
genTwoSquares bs = (,) <$> genSquare bs <*> genSquare bs
@@ -51,6 +47,11 @@ boardAndTwoSquareGen = do
s2 <- genSquare bs
return (bs, s1, s2)
+boardAndBadSquareGen :: Gen (BoardSize, Square)
+boardAndBadSquareGen = do
+ bs <- boardSizeGen
+ sq <- genBadSquare bs
+ return (bs, sq)
-- XXX: It's a little annoying that this is precisely how squareToIndex is
-- implemented, so it's not really verifying the result of that conversion by
@@ -59,9 +60,14 @@ boardAndTwoSquareGen = do
boardAndIndexGen :: Gen (BoardSize, BIndex)
boardAndIndexGen = do
bs <- boardSizeGen
- Square (dx, dy) <- genSquare bs
- return (bs, BI ((dy + boardVertBuffer bs) * rowLength bs + dx + leftBuf bs))
+ idx <- genIndex bs
+ return (bs, idx)
+boardAndBadIndexGen :: Gen (BoardSize, BIndex)
+boardAndBadIndexGen = do
+ bs <- boardSizeGen
+ idx <- genBadIndex bs
+ return (bs, idx)
-- The squareToIndex and indexToSquare functions should be inverses of each
-- other. That is:
@@ -69,11 +75,20 @@ boardAndIndexGen = do
-- square -> index -> square should be the identity
prop_indexToSquareInverse :: Property
prop_indexToSquareInverse = forAll boardAndIndexGen $ \(b, idx) ->
- squareToIndex b (indexToSquare b idx) == idx
+ join (squareToIndex b `liftM` indexToSquare b idx) == Just idx
prop_squareToIndexInverse :: Property
prop_squareToIndexInverse = forAll boardAndSquareGen $ \(b, sq) ->
- indexToSquare b (squareToIndex b sq) == sq
+ join (indexToSquare b `liftM` squareToIndex b sq) == Just sq
+
+-- squareToIndex and indexToSquare should handle bad input appropriately.
+prop_errorSquareToIndex :: Property
+prop_errorSquareToIndex = forAll boardAndBadSquareGen $ \(b, sq) ->
+ squareToIndex b sq == Nothing
+
+prop_errorIndexToSquare :: Property
+prop_errorIndexToSquare = forAll boardAndBadIndexGen $ \(b, idx) ->
+ indexToSquare b idx == Nothing
-- As squares move from lower left ("a1" in western chess) to upper right (h8),
-- the index into the lookup table should increase.
@@ -123,15 +138,17 @@ rTable2 = rankTable repList2
sTable1 = squareTable repList1
sTable2 = squareTable repList2
-fileCheckFunc, rankCheckFunc, squareCheckFunc :: Square -> Square -> Int
+type SquareCmpFunc = Square -> Square -> Int
+
+fileCheckFunc, rankCheckFunc, squareCheckFunc :: SquareCmpFunc
fileCheckFunc (Square s1) (Square s2) = abs $ fst s1 - fst s2
rankCheckFunc (Square s1) (Square s2) = abs $ snd s1 - snd s2
squareCheckFunc sq1 sq2 = max (fileCheckFunc sq1 sq2) (rankCheckFunc sq1 sq2)
-checkLookup :: LookupTable -> (Square -> Square -> Int) -> BoardSize -> Property
+checkLookup :: LookupTable -> SquareCmpFunc -> BoardSize -> Property
checkLookup lt cmp b = forAll (genTwoSquares b) $ \(sq1, sq2) ->
- let idx1 = squareToIndex b sq1
- idx2 = squareToIndex b sq2
+ let idx1 = fromJust $ squareToIndex b sq1
+ idx2 = fromJust $ squareToIndex b sq2
in fetch lt idx1 idx2 == cmp sq1 sq2
prop_checkFileDistance1 :: Property
4 src/ChessTools/Test/Suite.hs
View
@@ -21,6 +21,8 @@ tests = [
testGroup "Board arrays" [
testProperty "index to square" prop_indexToSquareInverse
, testProperty "square to index" prop_squareToIndexInverse
+ , testProperty "bad square to index" prop_errorSquareToIndex
+ , testProperty "bad index to square" prop_errorIndexToSquare
, testProperty "indices increase" prop_indexIncreasesWithSquare
, testProperty "array size" prop_boardArraySize
]
@@ -36,6 +38,8 @@ tests = [
, testGroup "Western notation" [
testProperty "good algebraic squares" prop_goodAlgebraicSquares
, testProperty "bad algebraic squares" prop_badAlgebraicSquares
+ , testProperty "index to algebraic" prop_indexToAlgebraic
+ , testProperty "bad index to algebraic" prop_errorIndexToAlgebraic
]
]
59 src/ChessTools/Test/Utils.hs
View
@@ -0,0 +1,59 @@
+{- Some QuickCheck generators and other utility functions used in a few test
+ - modules.
+ -}
+
+module ChessTools.Test.Utils (
+ boardSizeGen
+ , genIndex
+ , genBadIndex
+ , genSquare
+) where
+
+import Test.QuickCheck
+
+import ChessTools.Board
+import ChessTools.Board.Internal
+
+
+-- This could be an Arbitrary instance, but it would be an orphan. We don't
+-- want to put the instance in ChessTools.Board.Internal to avoid unnecessary
+-- QuickCheck dependencies, so prefer to use a direct Gen function here.
+boardSizeGen :: Gen BoardSize
+boardSizeGen = sized $ \n -> do
+ let n' = n + 2
+ dx <- choose (2, n')
+ dy <- choose (2, n')
+ vbuf <- choose (0, 4)
+ return $ BoardSize dx dy vbuf
+
+genIndex :: BoardSize -> Gen BIndex
+genIndex bs = do
+ Square (dx, dy) <- genSquare bs
+ return $ BI ((dy + boardVertBuffer bs) * rowLength bs + dx + leftBuf bs)
+
+genBadIndex :: BoardSize -> Gen BIndex
+genBadIndex (BoardSize h v vbuf)
+ | vbuf == 0 = leftBuffer
+ | otherwise = oneof [leftBuffer, above, below]
+ where rl = 2 * h - 1
+ leftBuffer = do
+ x <- choose (0, v - 1)
+ y <- choose (0, h `div` 2 - 1)
+ return $ BI ((vbuf + x) * rl + y)
+
+ above = do
+ x <- choose (0, vbuf - 1)
+ y <- choose (0, rl - 1)
+ return $ BI ((vbuf + v + x) * rl + y)
+
+ below = do
+ x <- choose (0, vbuf - 1)
+ y <- choose (0, rl - 1)
+ return $ BI (x * rl + y)
+
+genSquare :: BoardSize -> Gen Square
+genSquare bs = do
+ sx <- choose (0, boardHorizSize bs - 1)
+ sy <- choose (0, boardVertSize bs - 1)
+ return $ Square (sx, sy)
+
47 src/ChessTools/Test/WesternBoard.hs
View
@@ -2,22 +2,23 @@ module ChessTools.Test.WesternBoard
where
import Data.Char (ord, chr)
+import Data.Maybe (fromJust)
import Test.QuickCheck
import ChessTools.Board.Western
+import ChessTools.Test.Utils
-pairToCoords :: Int -> Int -> [Char]
-pairToCoords f r = chr (f + ord 'a') : chr (r + ord '1') : []
+pairToCoords :: Int -> Int -> String
+pairToCoords f r = chr (f + ord 'a') : [chr (r + ord '1')]
-validAlgebraicSquaresGen :: Gen [Char]
-validAlgebraicSquaresGen = do
+algebraicSquaresGen :: Gen String
+algebraicSquaresGen = do
file <- choose (0, 7)
rank <- choose (0, 7)
return $ pairToCoords file rank
-invalidAlgebraicSquaresGen :: Gen [Char]
-invalidAlgebraicSquaresGen =
- oneof [badFile, badRank, longName]
+badAlgebraicSquaresGen :: Gen String
+badAlgebraicSquaresGen = oneof [badFile, badRank, nameTooLong]
where badFile = do
file <- oneof [choose (-10, -1), choose (8, 12)]
rank <- choose (-3, 10)
@@ -28,21 +29,29 @@ invalidAlgebraicSquaresGen =
rank <- oneof [choose (-10, -1), choose (8, 12)]
return $ pairToCoords file rank
- longName = do
- x <- choose ('a', 'z')
- c <- validAlgebraicSquaresGen
- return $ c ++ [x]
+ nameTooLong = do
+ c <- algebraicSquaresGen
+ return $ c ++ "X"
prop_goodAlgebraicSquares :: Property
-prop_goodAlgebraicSquares = forAll validAlgebraicSquaresGen $ \s ->
- case algebraicToIndex s of
- Nothing -> False
- _ -> True
+prop_goodAlgebraicSquares = forAll algebraicSquaresGen $ \s ->
+ algebraicToIndex s /= Nothing
prop_badAlgebraicSquares :: Property
-prop_badAlgebraicSquares = forAll invalidAlgebraicSquaresGen $ \s ->
- case algebraicToIndex s of
- Nothing -> True
- _ -> False
+prop_badAlgebraicSquares = forAll badAlgebraicSquaresGen $ \s ->
+ algebraicToIndex s == Nothing
+
+prop_indexToAlgebraic :: Property
+prop_indexToAlgebraic = forAll (genIndex westernBoardSize) $ \idx ->
+ let s = indexToAlgebraic idx
+ (f:r:[]) = fromJust s
+ in s /= Nothing &&
+ length (fromJust s) == 2 &&
+ 'a' <= f && f <= 'h' &&
+ '1' <= r && r <= '8'
+
+prop_errorIndexToAlgebraic :: Property
+prop_errorIndexToAlgebraic = forAll (genBadIndex westernBoardSize) $ \idx ->
+ indexToAlgebraic idx == Nothing
Please sign in to comment.
Something went wrong with that request. Please try again.