see http://blog.tmorris.net/scala-exercise-with-types-and-abstraction/

tictactoe.hs

module TicTacToe
( Player
, Position
, Board
, InProgress
, Finished
, GameBoard
, Playable
, Completed
, move
, whoWon
, whoseTurn
) where
import qualified Data.Map as Map

data Player = X | O deriving (Eq, Show, Ord)

data Position = P1 | P2 | P3 | P4 | P5 | P6 | P7 | P8 | P9 deriving (Show, Eq, Ord) 

type Board = Map.Map Position Player

-----------
-- actual game data types
data InProgress = InProgress Board deriving (Show)
data Finished = Finished Board deriving (Show)
-----------

-----------
class GameBoard g  where
    getBoard :: g -> Board
    playerAt :: g -> Position -> Maybe Player
    playerAt board p = Map.lookup p $ getBoard board

instance GameBoard InProgress where
    getBoard (InProgress board) = board

instance GameBoard Finished  where
    getBoard (Finished board) = board

-----------
-- marker type classes. that's probably butt ugly
class (GameBoard g) => Playable g
instance Playable InProgress

class (GameBoard g) => Completed g
instance Completed Finished
-----------

-----------
startGame :: InProgress
startGame = InProgress Map.empty --M.fromList $ zip [P1, P2, P3, P4, P5, P6, P7, P8, P9] $ replicate 9 Nothing


whoseTurn :: (Playable g) => g -> Player
whoseTurn board 
    | os < xs = O
    | otherwise = X
    where os = count O $ getBoard board
          xs = count X $ getBoard board

count :: Player -> Board -> Int
count player board = length $ filter (\o -> o == player) $ Map.elems board


-----------
whoWon :: (Completed g) => g -> Maybe Player
whoWon game = 
    let board  = getBoard game
        (xs, os) = (winPositions board X, winPositions board O)
        result = if length xs /= 0 then Just X
                 else if length os /= 0 then Just O
                      else Nothing
    in result


win :: [[Position]]
win = [[P1, P2, P3], [P4, P5, P6], [P7, P8, P9], [P1, P4, P7], [P2, P5, P8], [P3, P6, P9], [P1, P5, P9], [P3, P5, P7]]

winPositions :: Board -> Player -> [[Maybe Player]]
winPositions board player =  
    let potentialWin = map (\w -> map (\x -> Map.lookup x board) w) win :: [[Maybe Player]]
        ps = filter (\x -> all (== (Just player)) x) potentialWin
    in ps

-----------

move :: (Playable g) => g -> Position -> Either InProgress Finished
move game position =
    let player = whoseTurn game
        board  = getBoard game
        board' = Map.insertWith (\x y -> y) position player board
        (xs, os) = (winPositions board' X, winPositions board' O)
        result = concat $ xs ++ os
    in judgeGame result board'

judgeGame :: [Maybe Player] -> Board -> Either InProgress Finished
judgeGame ps board
    | len == 0 && ((>) 9 $length $ Map.toList board) = Left $ InProgress board
    | otherwise = Right $ Finished board
    where len = length ps


main =
  let em = startGame
      Left(g1) = move em P1 -- X
      Left(g2) = move g1 P4 -- O
      Left(g3) = move g2 P2 -- X
      Left(g4) = move g3 P5 -- O
      Left(g5) = move g4 P6 -- X
      Left(g6) = move g5 P3 -- O
      Left(g7) = move g6 P7 -- X
      Left(g8) = move g7 P8 -- O
      Right(g9) = move g8 P9 -- X
--    move g9 P8 -- fails
  in whoWon g9 -- Nothing, no winner for this game

How can i run this ?