{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances,
    DeriveGeneric #-}
module Tak.Types (
    Board,
    Square,
    Piece,
    Stone(..),
    Colour(..),
    Play(..),
    Dir(..),
    Loc,
    GameState(..),
    Player(..),
    stNextPlayer,
    Finished(..),
    oppositeColour,
    squareIndices
) where

import Prelude hiding (concatMap, elem, foldr)

import Data.Foldable
import Data.Hashable
import Data.Matrix hiding (trace)
import GHC.Generics (Generic)
import Text.ParserCombinators.ReadPrec
import Text.Read

type Board = Matrix Square
type Square = [Piece]
type Piece = (Stone, Colour)
data Stone = Cap | Flat | Standing deriving (Eq, Generic, Read, Show)
instance Hashable Stone
data Colour = Black | White deriving (Eq, Generic)
instance Hashable Colour
data Play = Place Stone Loc | Move Loc Dir [Int] deriving (Eq, Read, Show)
data Dir = PosX | NegX | PosY | NegY deriving (Enum, Eq, Read, Show)
type Loc = (Int, Int)

data Player = Player {
    capsRemaining :: Int,
    stonesRemaing :: Int
} deriving (Generic, Eq, Show)
instance Hashable Player

data GameState = GameState {
    stBoard :: Board,
    stWhite :: Player,
    stBlack :: Player,
    stFinished :: Maybe Finished,
    stPlaysNext :: Colour,
    stNextTurn :: Int
} deriving (Generic, Eq)

instance Show GameState where
    show state = show (stBoard state)
        ++ "White: " ++ show (stWhite state) ++ "\n"
        ++ "Black: " ++ show (stBlack state) ++ "\n"
        ++ "Finished: " ++ show (stFinished state) ++ "\n"
        ++ show (stPlaysNext state) ++ " to play next, in turn "
        ++ show (stNextTurn state)

instance Hashable Board where
    hashWithSalt salt board = foldr (flip hashWithSalt) salt board
        --hashSquareWithSalt salt [] = hashWithSalt salt (0 :: Int)
        --hashSquareWithSalt salt (x : _) = hashWithSalt salt x

instance Hashable GameState where
    hashWithSalt salt state =
        salt `hashWithSalt` (stPlaysNext state) `hashWithSalt` (stBoard state)

stNextPlayer :: GameState -> Player
stNextPlayer state = case stPlaysNext state of
    White -> stWhite state
    Black -> stBlack state

data Finished =
      RoadWin Colour
    | FlatWin Colour Int Int
    | Draw Int Int deriving (Eq, Generic, Show)
instance Hashable Finished

{-data BoardSize = BoardSize {
    boardX :: Int,
    boardY :: Int,
    maxCarry :: Int
}-}

instance Read Board where
    readPrec = do
        rows <- many readRow
        let entries = concatMap (splitRow (length rows)) rows
            entries' = map (dropWhile (== ' ')) entries
            entries'' = map read entries'
        return $ fromList (length rows) (length rows) entries''
        where
            readRow = do
                char '('
                row <- charsNotIn ")"
                char ')'
                char '\n'
                return row
            splitRow count row =
                splitRow' ((length row - 1) `div` count) count [] row 
            splitRow' _ 0 entries _ = entries
            splitRow' splitPoint count entries row = do
                let (entry, rest) = splitAt splitPoint row
                splitRow' splitPoint (count - 1) (entries ++ [entry]) rest

char :: Char -> ReadPrec ()
char expected = do
    c <- get
    if c == expected then return () else pfail

many :: ReadPrec a -> ReadPrec [a]
many parser = (many' []) <++ (return []) where
    many' sofar = do
        a <- parser
        (many' (sofar ++ [a])) <++ (return $ sofar ++ [a])

charsNotIn :: String -> ReadPrec String
charsNotIn chars = charsNotIn' "" where
    charsNotIn' sofar = do
        c <- get
        if c `elem` chars
            then pfail
            else do
                (charsNotIn' $ sofar ++ [c]) <++ return (sofar ++ [c])

instance Show Square where
    show square = concatMap show square

instance Read Square where
    readPrec = readPieces [] <++ return []
        where
            readPieces sofar = readPieces' sofar <++ return sofar
            readPieces' sofar = do
                piece <- readPrec
                readPieces $ sofar ++ [piece]

instance Show Piece where
    show (Flat, colour) = show colour
    show (Standing, colour) = "S" ++ show colour
    show (Cap, colour) = "C" ++ show colour

instance Read Piece where
    readPrec = standing_or_cap <++ flat
        where
            flat = do
                c <- readPrec
                return (Flat, c)
            standing_or_cap = do
                stone <- get
                c <- readPrec
                case stone of
                    'S' -> return (Standing, c)
                    'C' -> return (Cap, c)
                    _ -> pfail

instance Show Colour where
    show Black = "X"
    show White = "O"

instance Read Colour where
    readPrec = do
        c <- get
        case c of
            'X' -> return Black
            'O' -> return White
            _ -> pfail
            
oppositeColour :: Colour -> Colour
oppositeColour Black = White
oppositeColour White = Black

squareIndices :: Matrix a -> [(Int, Int)]
squareIndices board = [(i, j) | i <- [1 .. nrows board], j <- [1 .. ncols board]]