ttt.cabal

-- Initial ttt.cabal generated by cabal init.  For further documentation, 
-- see http://haskell.org/cabal/users-guide/

name:                ttt
version:             0.1.0.0
-- synopsis:            
-- description:         
license:             GPL-3
-- license-file:        LICENSE
author:              lmdexpr
maintainer:          [email protected]
-- copyright:           
category:            Game
build-type:          Simple
-- extra-source-files:  
cabal-version:       >=1.10

executable ttt
  main-is:             ttt.hs
  -- other-modules:       
  -- other-extensions:    
  build-depends:       base >=4.7 && <4.8,
                       mtl == 2.1.*,
                       random == 1.0.*,
                       safe == 0.3.*
  -- hs-source-dirs:      
  default-language:    Haskell2010

ttt.hs

import Control.Applicative
import Control.Monad.State

import Data.Either
import Data.List
import Data.Maybe

import System.Random

import Safe

data Hand  = O | X deriving(Show, Eq)
type Grid  = Either Int Hand
type Board = [[Grid]]
newtype ShowBoard = SBoard {getBoard :: Board}

instance Show ShowBoard where
    show = unlines . intersperse "---+---+---" 
           . map (intercalate "|" . map showGrid) . getBoard
        where
            showGrid = either (whitespace . show) (whitespace . show)
            whitespace x = " " ++ x ++ " "

main :: IO ()
main = void $ runStateT (game 0) initialBoard
        where
            initialBoard = map (map Left) [[1..3], [4..6], [7..9]]

game :: Int -> StateT Board IO ()
game c = do
    let hand = if c `mod` 2 == 1 then X else O
        io   = [input, ai] !! mod c 2
    result  <- won   <$> get
    liftIO . print . SBoard =<< get
    if isNothing result && c < 9
        then do
            putGrid hand =<< io
            game (c+1)
        else liftIO $ printResult result

canPut :: Int -> Board -> Bool
canPut n = (== Left n) . (!! mod (n-1) 3) . (!! div (n-1) 3)

input :: StateT Board IO Int
input = do
    inp <- liftIO $ putStrLn "\nPlease input number" >> putStr "> " >> readLn
    ok  <- canPut inp <$> get
    if ok
        then return inp
        else input

ai :: StateT Board IO Int
ai = do
    b <- get
    r <- liftIO $ randomRIO (1, 9)
    if canPut r b
        then return r
        else ai

putGrid :: Hand -> Int -> StateT Board IO ()
putGrid h n = get >>= put . replace (Left n) (Right h) >> return ()

replace :: Eq a => a -> a -> [[a]] -> [[a]]
replace n t = map . map $ \ m -> if m == n then t else m

won :: Board -> Maybe Hand
won = headMay . concat . filter eq 
      . map rights . concat . sequence [id, transpose, diagonal]
    where
        eq [a, b, c] = a == b && b == c
        eq _         = False

        diagonal b   = [diagonal' b, diagonal' (reverse b)]
        diagonal' [[ a, _, _],
                   [ _, b, _],
                   [ _, _, c]] = [a, b, c]
        diagonal' _  = []

printResult :: Maybe Hand -> IO ()
printResult m 
    | isJust m  = putStrLn $ msg ++ "Winner is " 
                  ++ show (fromJust m) ++ ".\nSee you.\n"
    | otherwise = putStrLn $ msg ++ "DRAWN.\nSee you.\n"
    where
        msg = "\nEnd of the game!\n"