Thursday, April 14, 2011

Getting More from the Type System

This blog post from Tony Morris really got me thinking about the advantages of a powerful static type system like Haskell's.  That blog post (along with others such as this one) are great pointers for getting the most mileage from the type system.

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 MoveableBoardBoard 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 Board
This 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.

We can tweak this to return an error status if an invalid move is submitted (e.g., making the same move twice):
move :: MoveableBoard -> Move -> Maybe (Either Board
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.

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)

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