module TTT.Game where

import Data.List
import Data.List.Split
import Data.Maybe

data Piece = X | O
  deriving (Eq)

data Position = Position {px :: Int, py :: Int}
  deriving (Show, Eq)

type Board = [(Maybe Piece, Position)]

data GameState = GameState {board :: Board, whoseTurn :: Piece}

data Result = Win | Lose | Tie
  deriving (Eq)

instance Show Piece where
  show p = showPiece (Just p)

instance Show Result where
  show r
    | r == Win  = "You won! :)"
    | r == Lose = "You lost! :("
    | otherwise = "Tie -.-"

------------------------
-- Display game board --
------------------------

showBoard :: Board -> String
showBoard b = "\nGame board:\n" ++ boardDisplay where
  boardDisplay = simpleBoard ++ hack
  simpleBoard  =
    intercalate divider $
    map (intercalate "|") $
    chunksOf boardDim $
    map (\(p,pos) -> "  " ++ (showPiece p) ++ "  ") b
  hack         = showDivider boardDim "     "
  divider      = showDivider boardDim "_____"
  boardDim     = getBoardDim b

showPiece :: Maybe Piece -> String
showPiece p 
  | p == Just X = "X"
  | p == Just O = "O"
  | otherwise   = "*"

showDivider :: Int -> String -> String
showDivider boardDim spaces = ("\n" ++ divider ++ "\n") where
  divider = 
    intercalate "|" $
    replicate boardDim spaces

showPlayerResult :: Piece -> Result -> String
showPlayerResult p r = "Player '" ++ show p ++ "'' " ++ show r

------------------
-- Constructors --
------------------

initBoard :: Int -> Board
initBoard dim = do
  xs <- take dim [0..] 
  ys <- take dim [0..]
  return $ (Nothing, Position {px=xs, py=ys})

initGameState :: Board -> Piece -> GameState
initGameState b p = 
  GameState {board=b, whoseTurn=p}

----------------
-- Game rules --
----------------

opposite :: Piece -> Piece
opposite p
  | p == X = O
  | p == O = X

whoseTurnNext :: GameState -> Piece
whoseTurnNext s = opposite (whoseTurn s)

isLegalMove :: GameState -> Position -> Piece -> Bool
isLegalMove s nextPos nextPiece = legalPosition && legalMove where
  legalPosition = nextPos `elem` posibleMoves
  legalMove     = nextPiece == (whoseTurn s)
  posibleMoves  = findPositions b isEmpty
  b             = (board s)

hasItTied :: GameState -> Bool
hasItTied s = do
  let b = (board s)
  getBoardSize b == length (findPositions b isFilled)

hasItWon :: GameState -> Position -> Piece -> Bool
hasItWon s (Position x y) p = row || col || diag where
  b = (board s)
  bDim = getBoardDim b
  row  = length (filter (\(piece,pos) -> piece == Just p && (py pos) == y) b) == bDim
  col  = length (filter (\(piece,pos) -> piece == Just p && (px pos) == x) b) == bDim
  diag = diag' m || diag' (reverse m) where
    diag' xs = all (\(piece,pos) -> piece == Just p) $ diagonal xs
    m = matrix bDim b

matrix :: Int -> [a] -> [[a]]
matrix n [] = []
matrix n xs = take n xs : matrix n (drop n xs)

diagonal :: [[a]] -> [a]
diagonal x = zipWith (!!) x [0..]

------------------------
-- Game board queries --
-----------------------

getBoardSize :: Board -> Int
getBoardSize b = length b

getBoardDim :: Board -> Int
getBoardDim b = round ((sqrt :: Double -> Double) (fromIntegral (getBoardSize b)))

indexToPosition :: Board -> Int -> Position
indexToPosition b index = do
  let bDim = getBoardDim b
  Position {px=(index `div` bDim), py=(index `rem` bDim)}

isEmpty :: (Maybe Piece, Position) -> Bool
isEmpty (p, pos) = isNothing p

isFilled :: (Maybe Piece, Position) -> Bool
isFilled (p, pos) = isNothing p == False

findPositions :: Board -> ((Maybe Piece, Position) -> Bool) -> [Position]
findPositions b satisfiable =
  map (\index -> indexToPosition b index) $
  findIndices (satisfiable) b

newBoard :: Board -> Position -> Piece -> Board
newBoard b pos p = do
  --hack
  let (xs,_:ys) = splitAt (fromMaybe 0 (elemIndex (Nothing, pos) b)) b
  xs ++ (Just p, pos):ys

getNextState :: GameState -> Position -> Piece -> Maybe GameState
getNextState s nextPos nextPiece = do
  if isLegalMove s nextPos nextPiece
    then Just GameState {
        board     = newBoard (board s) nextPos nextPiece,
        whoseTurn = whoseTurnNext s }
    else Nothing
