tictactoe.hs

import Control.Applicative
import Control.Monad
import Data.Foldable (traverse_)
import Data.List

data Move = B | X | O deriving (Eq, Show)

-- things that can have moves applied to them
class (Eq a) => Movable a where
  move :: Move -> a -> [a]

-- blanks can have moves applied
instance Movable Move where
  move m B = [B, m]
  move m x = [x]

-- lists of things that can have moves applied can also have moves applied
instance (Movable a) => Movable [a] where
  move m []     = []
  move m (x:xs) = nub $ (:xs) <$> move m x <|> (x:) <$> move m xs

-- get the diagonal of a list
diagonal :: [[a]] -> [a]
diagonal []     = []
diagonal (x:xs) = head x : diagonal (tail <$> xs)

-- is this row either all X's or all O's?
winRow :: [Move] -> Bool
winRow = or . sequence [all (==X), all (==O)]

-- a board wins if:
-- 1. any row is all X or O
-- 2. any column is all X or O
-- 3. any diagonal is all X or O
win :: [[Move]] -> Bool
win = or . sequence [any winRow, any winRow . transpose, winRow . diagonal, winRow . diagonal . reverse]

-- apply a move to the board if it's not won
play :: [[Move]] -> [[[Move]]]
play b | win b     = [b]
       | otherwise = nub $ move X b ++ move O b

-- run a function until the result stops changing
converge :: (Eq a) => (a -> a) -> a -> a
converge f a | a == fa  = a
             | otherwise = converge f fa
  where fa = f a

-- a blank 3x3 board
blankBoard = [[B, B, B], [B, B, B], [B, B, B]]

-- all boards you can reach from a blank board
boards :: [[[Move]]]
boards = converge (nub . foldMap play) [blankBoard]

-- print out boards nicer
printBoard :: [[Move]] -> IO ()
printBoard b = traverse_ printRow b >> putStrLn "-"
  where printRow []     = putStrLn ""
        printRow (B:xs) = putStr " " >> printRow xs
        printRow (x:xs) = putStr (show x) >> printRow xs

-- print out how many boards there are
main :: IO ()
main = print (length boards)