When I first started with Haskell, I was pleased with the effect that the type system had on the code-test-debug-refactor cycle by keeping the type errors at compile time -- yet not requiring lots of tedious, error-prone boilerplate to support that. I found that code was much more likely to work with minimal debugging. Along with the conciseness of the code, this made for a more engaging and satisfying experience at the "hacking" level. This is more than enough reason to learn Haskell.
But what I wasn't yet seeing was how to take it to the next level and exploit the type system at the design stage. Those two blog posts are great examples of how to use the type system at design time. I coded up a Haskell solution to Morris' exercise, and it was some time well spent. Example code is below the cut, and I think it's a great little package that shows very directly how Haskell's type system adds value.
I'm assuming you've read Tony's blog post. If not, read it now. I'll try to assume no knowledge of Haskell in my explanation here. If you don't need the full explanation, jump down to the code now.
The Design
The fundamental design revolves around three data types, and two typeclasses. The data types are EmptyBoard, Board, and CompleteBoard. They represent tictactoe boards that are empty, that are in the middle of a game, and that are a finished game. The two typeclasses are MoveableBoard and UndoableBoard (Haskell typeclasses are a little like Java interfaces). EmptyBoard and Board are instances of the typeclass MoveableBoard. Board and CompleteBoard are instances of the typeclass UndoableBoard.
An EmptyBoard can be constructed with a call to the constructor. The constructor for Board is not exported; a Board can only be created by calling move on a MoveableBoard. The result of calling move on a MoveableBoard is either a Board or a CompleteBoard. Haskell conveniently provides a type constructor called Either that lets us handle this conveniently. Let's look at the (simplified) type signature for move:
move :: MoveableBoard -> Move -> Either BoardThis says that move takes two arguments, a MoveableBoard and a Move, and returns a value of type Either Board CompleteBoard. This type can hold either a Board value or a CompleteBoard value.
CompleteBoard
We can tweak this to return an error status if an invalid move is submitted (e.g., making the same move twice):
This signature says that the return type is wrapped with a Maybe --- a type that could be Nothing for the error case, or the original Either Board CompleteBoard for a valid move.move :: MoveableBoard -> Move -> Maybe (Either Board
CompleteBoard)
This one function type signature gets right at the heart of the design. From here, it's obvious what the type signatures of most of the other API functions ought to be. whoWonOrDraw takes a single argument that is a CompleteBoard and returns an enumeration of Player1, Player2, Draw. whoseMoveIsIt takes a MoveableBoard and returns either Player1 or Player2. undoMove takes an UndoableBoard and returns an Either Board EmptyBoard. We don't even need to write an API function to determine if the game is over or not; that information is encoded in the return type of move.
I've made some simplifications above. The type signatures for move aren't quite legal Haskell; the enumerations for Player1, Player2, etc. are not right; I didn't explain how Maybe avoids some pitfalls of both exceptions and passing status codes; and so on. But I think I have shown how Haskell's type system allows for a simple, expressive solution to the exercise.
I won't try to explain the code below; it would take a series of posts to explain it to someone who doesn't know Haskell. It's a grand total of 73 lines in original format. Like a lot of Haskell code, it packs a lot into those lines -- and often the type signatures tell you a lot about what the function does.
The Code
module Tictactoe (Player, Position, Move, EmptyBoard,
Board, CompleteBoard, Winner, whoseMoveIsIt,
move, undoMove, whoWonOrDraw, occupiesPosition)
where
import Data.List
data Player = Player1 | Player2 deriving (Show, Eq)
data Position = NW | N | NE | W | C | E | SW | S | SE
deriving (Show, Eq)
data Winner = Draw | Winner Player
type Move = Position
winningPositions = [[NW,N,NE],[W,C,E],[SW,S,SE],
[NW,W,SW],[N,C,S],[NE,E,SE],
[NW,C,SE],[NE,C,SW]] :: [[Move]]
class MoveableBoard a where
move :: a -> Move -> Maybe (Either Board CompleteBoard)
class UndoableBoard a where
undoMove :: a -> Either Board EmptyBoard
data EmptyBoard = EmptyBoard deriving (Show)
instance MoveableBoard EmptyBoard where
move EmptyBoard x = Just $ Left $ BoardCtor [x]
data Board = BoardCtor [Move] deriving (Show)
instance MoveableBoard Board where
move (BoardCtor xs) y
| y `elem` xs = Nothing
| completesBoard xs y = Just $ Right $ CompleteBoardCtor
$ y:xs
| otherwise = Just $ Left $ BoardCtor $ y:xs
instance UndoableBoard Board where
undoMove (BoardCtor [x]) = Right EmptyBoard
undoMove (BoardCtor (x:xs)) = Left $ BoardCtor xs
data CompleteBoard = CompleteBoardCtor [Move] deriving (Show)
instance UndoableBoard CompleteBoard where
undoMove (CompleteBoardCtor (x:xs)) = Left (BoardCtor xs)
whoseMoveIsIt :: Board -> Player
whoseMoveIsIt (BoardCtor xs) = whoseMove' xs
whoseMove' :: [Move] -> Player
whoseMove' xs = if (odd $ length xs) then Player2 else Player1
whoWonOrDraw :: CompleteBoard -> Winner
whoWonOrDraw (CompleteBoardCtor ms)
| winner Player1 ms = Winner Player1
| winner Player2 ms = Winner Player2
| otherwise = Draw
occupiesPosition :: Position -> Board -> Maybe Player
occupiesPosition x (BoardCtor ys) = occupiesPosition' x ys
where occupiesPosition' x [] = Nothing
occupiesPosition' x (y:ys)
| x == y = Just $ whoseMoveIsIt $ BoardCtor ys
| otherwise = occupiesPosition' x ys
completesBoard :: [Move] -> Move -> Bool
completesBoard xs y = length xs == 8 ||
winner Player1 (y:xs) ||
winner Player2 (y:xs)
winner :: Player -> [Move] -> Bool
winner p m = any ((flip subset) (getMoves m p)) winningPositions
subset :: Eq a => [a] -> [a] -> Bool
subset sub set = [] == sub \\ (intersect sub set)
getMoves :: [Move] -> Player -> [Move]
getMoves xs p = getMoves' xs (whoseMove' xs /= p)
where getMoves' [] _ = []
getMoves' (x:xs) True = x : getMoves' xs False
getMoves' (x:xs) False = getMoves' xs True
No comments:
Post a Comment