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.

.gitignore

@@ -4,4 +4,5 @@ html/
 *.hi
 *.o
 *.tix
+Suite
 

src/ChessTools/Board.hs

@@ -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]]
 
 

src/ChessTools/Board/Internal.hs

@@ -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.

src/ChessTools/Board/Western.hs

@@ -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'.

src/ChessTools/Test/Board.hs

@@ -2,38 +2,34 @@ 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.
 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,21 +60,35 @@ 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:
 --      index -> square -> index should be the identity
 --      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

src/ChessTools/Test/Suite.hs

@@ -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
             ]
         ]
 

src/ChessTools/Test/Utils.hs

@@ -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)
+

src/ChessTools/Test/WesternBoard.hs

@@ -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