TDD with QuickCheck
I read Nat Pryce's - Exploring Test-Driven Development with QuickCheck about his journey to implement Tic-Tac-Toe using Test-Driven Development, TDD as in Keith Braithwaite exercise.
The first thought that popped into my mind:
TDD makes you think hard about your code, property-based TDD makes you think even harder.
I'll try to do this exercise myself, though I take an easier way: with Haskell.
First Keith's rule is: Write exactly one new test, the smallest test you can that seems to point in the direction of a solution. And this is hard. Nat took quite a big step, thinking already about a winner in a beginning. We don't get even close, in this quite lengthy post.
Going red
Returning back to the Tic-Tac-Toe: What are the types of data and operation we can start from? We write our types first.
data Player = X | O
deriving (Eq, Show, Bounded, Enum)
data Fin3 = I1 | I2 | I3
deriving (Eq, Show, Bounded, Enum)
newtype Position = Position { unPosition :: (Fin3, Fin3) }
deriving (Eq, Show)
data Move = Move { movePosition :: Position, movePlayer :: Player }
deriving (Eq, Show)
newtype Game = Game { unGame :: [Move] }
deriving (Eq, Show)
That feels like a lot of types already, but I can't state any interesting properties about moves, without tying them to the game (giving them order).
Than the operation simplest operation (actually I cheat here, I have already sub-goal in my mind: I want eventually define isValidMove :: Game -> Move -> Bool predicate).
isFreePosition :: Game -> Position -> Bool
isFreePosition g p = undefined
Then what will be our first property? maybe: forall g :: Game, exists p :: Position, isFreePosition g p. This one isn't true for all games. Counter-example is the game with 9 moves. We refine our property to: forall g :: Game, length . unGame g < 9, exists p :: Position, isFreePosition g p. This property is problematic as well. First of all, it's existential. We can turn it around into:
forall g :: Game, length . unGame g == 9, forall p :: Position, isFreePosition g p = False.
This property we can QuickCheck:
import TicTacToe
import Control.Monad
import Test.QuickCheck
instance Arbitrary Player where
arbitrary = arbitraryBoundedEnum
shrink X = []
shrink O = [X]
instance Arbitrary Fin3 where
arbitrary = arbitraryBoundedEnum
shrink I1 = []
shrink I2 = [I1]
shrink I3 = [I1, I2]
instance Arbitrary Position where
arbitrary = Position `liftM` arbitrary
shrink = map Position . shrink . unPosition
instance Arbitrary Move where
arbitrary = liftM2 Move arbitrary arbitrary
shrink (Move pos player) = [Move pos' player | pos' <- shrink pos] ++
[Move pos player' | player' <- shrink player]
instance Arbitrary Game where
arbitrary = Game `liftM` arbitrary
shrink (Game ms) = map Game $ shrink ms
-- To make generation rate better
newtype Game9 = Game9 { unGame9 :: Game }
deriving (Eq, Show)
instance Arbitrary Game9 where
arbitrary = (Game9 . Game) `liftM` replicateM 9 arbitrary
-- Generator property
game9_prop :: Game9 -> Bool
game9_prop = (9==) . length . unGame . unGame9
{-
> quickCheck game9_prop
+++ OK, passed 100 tests.
-}
-- forall g :: Game, length . ungame g >= 9, forall p :: Position, isFreePosition g p = False
game9_no_free_positions_prop :: Game9 -> Position -> Bool
game9_no_free_positions_prop g' p = not $ isFreePosition g p
where g = unGame9 g'
{-
> quickCheck game9_no_free_positions_prop
*** Failed! Exception: 'Prelude.undefined' (after 1 test and 21 shrinks):
-}
As expected QuickCheck found undefined after one test (as isFreePosition is always undefined for now).
Now we try to turn red into green, let's implement isFreePosition properly.
Turning green
isFreePosition :: Game -> Position -> Bool
isFreePosition g p = False
{-
> quickCheck game9_no_free_positions_prop
+++ OK, passed 100 tests.
-}
You can argue this implementation isn't proper, but all tests are green!
New tests, red again
So we need more tests (properties), every position is free in just started game: forall p :: Position, isFreePosition (Game []) p.
empty_game_all_positions_free_prop :: Position -> Bool
empty_game_all_positions_free_prop p = isFreePosition (Game []) p
> quickCheck empty_game_all_positions_free_prop
*** Failed! Falsifiable (after 1 test and 2 shrinks):
Position {unPosition = (I1,I1)}
Turning green II
Again red. Let's fix isFreePosition:
isFreePosition :: Game -> Position -> Bool
isFreePosition g p = p `notElem` map movePosition (unGame g)
{-
> quickCheck empty_game_all_positions_free_prop
+++ OK, passed 100 tests.
> quickCheck game9_no_free_positions_prop
*** Failed! Falsifiable (after 5 tests and 1 shrink):
-}
What's wrong? We can implement shrink for Game9, which hopefully will make counterexample more descriptive:
instance Arbitrary Game9 where
arbitrary = (Game9 . Game) `liftM` replicateM 9 arbitrary
shrink (Game9 (Game ms)) = do ms' <- mapM f ms
guard $ ms' /= ms
return $ Game9 $ Game ms'
where f x = x : shrink x
> quickCheck game9_no_free_positions_prop
*** Failed! Falsifiable (after 7 tests and 16 shrinks):
Game9 {unGame9 = Game {unGame = [Move {movePosition = Position {unPosition = (I1,I1)}, movePlayer = X},Move {movePosition = Position {unPosition = (I1,I1)}, movePlayer = X}...
Position {unPosition = (I2,I1)}
It's easy to see that all moves in the game are same! But that doesn't make sense! And that's our fault.
Turning green, try III.
Our game9_no_free_positions_prop property is bogus. We could restate it into something more precise: forall g :: Game, length . ungame g >= 9, isValidGame g, forall p :: Position, isFreePosition g p = False, where isValidGame is something like:
isValidGame :: Game -> Bool
isValidGame (Game []) = True
isValidGame (Game (m:ms)) = isValidMove g m && isValidGame g
where g = Game ms
isValidMove :: Game -> Move -> Bool
isValidMove g m = isFreePosition g (movePosition m)
But we are red, so we don't touch properties.
isValidGame is an Game invariant we want to hold always. If we hide Game implementation details, and expose only invariant preserving operations, forall g :: Game, isValidGame g will be true (and we can state this property!). Unfortunately we have to change our tests a little bit, as we give things name, like moveCount = length . unGame. That we could do right from beginning.
Next we change TicTacToe modules. The properties doesn't change much. You can find edited files at TicTacToe.hs, TicTacToeTests.hs and and the coverage markup report.
I use assert in addMove functions. Why?
Because I cannot state the pre-condition in types. The situation is similar to division by zero.
% ghc -fhpc TicTacToeTests.hs --make
[1 of 2] Compiling TicTacToe ( TicTacToe.hs, TicTacToe.o )
[2 of 2] Compiling Main ( TicTacToeTests.hs, TicTacToeTests.o )
Linking TicTacToeTests ...
% ./TicTacToeTests
+++ OK, passed 300 tests.
+++ OK, passed 300 tests.
+++ OK, passed 300 tests.
+++ OK, passed 300 tests.
% hpc report TicTacToeTests --exclude=Main --exclude=QC
95% expressions used (40/42)
100% boolean coverage (0/0)
100% guards (0/0)
100% 'if' conditions (0/0)
100% qualifiers (0/0)
100% alternatives used (2/2)
100% local declarations used (1/1)
30% top-level declarations used (13/42)
Looks pretty good already, except there are unused unPosition and movePlayer function. I thought to much up front, we could get here without Player type at all. However natural next step would be to write code that will eventually use movePlayer. Like defining isNextPlayer :: Game -> Player -> Bool predicate and going thru similar steps we already went thru with isFreePosition. I leave that as an exercise for a reader.
Insight
At some point, I got insight, that properties aren't specific to Tic-Tac-Toe game. The only Tic-Tac-Toe specific part is magic constant 9. It is 64 for Reversi, 361 for 19×19 board of Go or Gomoku. So we came up with some general board game properties!
