HTicTacToe-0.1: Grid.hs

{-
    The MIT License
    
    Copyright (c) 2010 Korcan Hussein
    
    Permission is hereby granted, free of charge, to any person obtaining a copy
    of this software and associated documentation files (the "Software"), to deal
    in the Software without restriction, including without limitation the rights
    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
    copies of the Software, and to permit persons to whom the Software is
    furnished to do so, subject to the following conditions:
    
    The above copyright notice and this permission notice shall be included in
    all copies or substantial portions of the Software.
    
    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
    THE SOFTWARE.
-}
module Grid
(
    Cell(..),
    swapCell,
    Winner(..),
    Grid(),
    newGrid,
    toArray,
    cellAt,
    isEmpty,
    isComplete,
    takeTurn,
    whoWon
) where

import Data.List
import Data.Array hiding (indices)

data Cell   = Nought | Cross | Empty
    deriving Eq
--    deriving (Eq, Show)
instance Show Cell where
    show Nought = "O"
    show Cross  = "X"
    show _      = ""

swapCell :: Cell -> Cell
swapCell Nought = Cross
swapCell Cross  = Nought
swapCell Empty = Empty

data Winner = Noughts | Crosses | Draw | Nobody
    deriving Show

type CellArray = Array (Int,Int) Cell
newtype Grid = Grid { cells :: CellArray }

rowSize :: Int
rowSize = 3
--gridSize = rowSize * rowSize

newGrid :: Grid
newGrid = Grid $ listArray ((0,0), (rowSize - 1,rowSize - 1)) $ repeat Empty

toArray :: Grid -> CellArray
toArray (Grid t) = t

cellAt :: Grid -> Int -> Int -> Cell
cellAt (Grid cs) row col = cs ! (row, col)

isEmpty :: Grid -> Int -> Int -> Bool
isEmpty g row col =
    case cellAt g row col of
        Empty -> True
        _ -> False

isComplete :: Grid -> Bool
isComplete g = all (\(r,c) -> not $ isEmpty g r c) [(r,c) | r <- indices, c <- indices]
 where end     = rowSize - 1
       indices = [0..end]

takeTurn :: Grid -> Cell -> Int -> Int -> Grid
takeTurn g Empty _ _ = g
takeTurn g@(Grid cs) c row col =
    if isEmpty g row col then
        Grid $ cs // [((row,col), c)]
    else g

whoWon :: Grid -> (Winner, [(Int,Int)])
whoWon g@(Grid cs) =
    case findWinner Nought of
        Just x -> (Noughts, x)
        _ -> case findWinner Cross of
                Just x -> (Crosses, x)
                _ -> if isDraw g then (Draw, []) else (Nobody, [])
 where end         = rowSize - 1
       indices     = [0..end]
       rows        = [zip (repeat r) indices | r <- indices]
       cols        = [zip indices (repeat c) | c <- indices]
       diagonal    = zip indices indices
       invDiagonal = zip [end,end-1..0] indices
       searchSpace = rows ++ cols ++ [diagonal] ++ [invDiagonal]
       allCells cell = all $ \idx -> cs ! idx == cell 
       findWinner cell  = find (allCells cell) searchSpace
       
       isDraw grid = not $ any (uncurry $ isEmpty grid) [(r,c) | r <- indices, c <- indices]