tic-tac-toe.hs

 
import Control.Monad.State
 
data Field = Black | White | Empty deriving(Eq, Show)
type Board = [Field]
data Winner = PlayerBlack | PlayerWhite | NoOneYet deriving(Eq, Show)
 
nth :: Int -> Board -> Field
nth n = head . drop (n-1)
 
qualifyVictory :: Board -> Winner
qualifyVictory board 
    | test Black board = PlayerBlack
    | test White board = PlayerWhite
    | otherwise = NoOneYet
    where test :: Field -> Board -> Bool
          test f b = any (triple f b)
                [
                (1,2,3), (4,5,6), (7,8,9),
                (1,4,7), (2,5,8), (3,6,9),
                (1,5,9), (3,5,7)
                ]
           where triple :: Field -> Board -> (Int,Int,Int) -> Bool
                 triple f b (x,y,z) = all (== f) [nth x b, nth y b, nth z b]
 
 
data Move = Move { n :: Int, f :: Field }
move :: Move -> Board -> Board
move (Move n f) b = take (n-1) b ++ [f] ++ drop n b
 
--emptyBoard :: State Board 
emptyBoard = take 9 $ repeat Empty
 
-- just for fun
clearBoard :: Board -> Board
clearBoard = map (const Empty)
 
moveM :: Move -> State Board ()
moveM m = do
           board <- get
           put $ move m board
           return ()
 
emptyBoardM :: State Board ()
--emptyBoardM = state $ \_ -> ((), emptyBoard)
emptyBoardM = do 
                put emptyBoard
                return ()