{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

module BlunderLib.Types where

import Control.DeepSeq
import Data.Char
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Sequence
import GHC.Generics (Generic)
import System.Random

-- The board state at any given time.  This is basically a translation of FEN,
-- except it includes mappings in both directions between positions and units.
data Board = Board
  { squares   :: Squares
  , units     :: Seq (Unit, Position)
  , turn      :: Color
  , castling  :: CastleAbility
  , enpassant :: Maybe Position
  , halfmoves :: Int }
  deriving (Eq)

type GoMode = Bool

data BoardEval = BoardEval (Seq (Imbalance, Color, Points))
               | CheckMate Color
  deriving (Generic, NFData)

type Points = Int

data Imbalance = MinorPiece
               | Pawns
               | Material
               | Space
               | KingSafety
  deriving (Eq, Generic, NFData, Show)

type Squares = M.Map Position (Maybe Unit)

data Color = White | Black
  deriving (Eq, Generic, NFData, Ord, Show)

data File = FA | FB | FC | FD | FE | FF | FG | FH
  deriving (Enum, Eq, Ord)

data Rank = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8
  deriving (Enum, Eq, Ord)

data Position = Pos File Rank
  deriving (Eq, Ord)

data CastleAbility = CastleAbility
  { qsBlack :: Bool
  , ksBlack :: Bool
  , qsWhite :: Bool
  , ksWhite :: Bool }
  deriving (Eq, Show)

data Figure = Bishop | King | Knight | Pawn | Queen | Rook
  deriving (Eq, Ord, Show)

data Unit = U Figure Color
  deriving (Eq, Ord)

data Move = Move Position Position
          | Capture Position Position
          | Promotion Position Position Figure
          | CapturePromotion Position Position Figure
          | Castle CastleKind Position Position
  deriving (Eq, Show)

data CastleKind = BKS | BQS | WKS | WQS
  deriving (Eq, Show)

-- Instances

instance Eq BoardEval where
  e1 == e2 = evalToPoints e1 == evalToPoints e2

sumPoints :: (Imbalance, Color, Points) -> Points -> Points
sumPoints (_,col,pts) cur = toPosNegPoints col pts + cur

toPosNegPoints :: Color -> Points -> Points
toPosNegPoints Black pts = negate pts
toPosNegPoints White pts = pts

instance Ord BoardEval where
  CheckMate col <= _ = True
  _ <= CheckMate col = False
  e1 <= e2 = evalToPoints e1 >= evalToPoints e2

evalToPoints :: BoardEval -> Points
evalToPoints (CheckMate col) = toPosNegPoints col 10000
evalToPoints (BoardEval is) = foldr sumPoints 0 is

instance Show BoardEval where
  show (CheckMate col) = "checkmate for " ++ show col
  show ev = "eval points: " ++ (show $ evalToPoints ev)

instance Show File where
  show f = [toEnum $ fromEnum f + fromEnum 'a']

instance Show Rank where
  show r = [toEnum $ fromEnum r + fromEnum '1']

instance Show Position where
  show (Pos f r) = show f ++ show r

instance Show Unit where
  show (U Bishop Black) = "b"
  show (U Bishop White) = "B"
  show (U King Black) = "k"
  show (U King White) = "K"
  show (U Knight Black) = "n"
  show (U Knight White) = "N"
  show (U Pawn Black) = "p"
  show (U Pawn White) = "P"
  show (U Queen Black) = "q"
  show (U Queen White) = "Q"
  show (U Rook Black) = "r"
  show (U Rook White) = "R"

instance Show Board where
  show Board { squares = sqs } = ppBoard sqs

-- Pretty print ASCII boards, separate from Show instance for different
-- debugging uses

ppBoard :: M.Map Position (Maybe Unit) -> String
ppBoard sqs = ppRank sqs 8

ppRank :: M.Map Position (Maybe Unit) -> Int -> String
ppRank sqs r
  | r >= 1    = toEnum (r + fromEnum '0') : ' ' :
                map (ppLookUnit sqs r) [1..8] ++ "\n" ++ ppRank sqs (pred r)
  | otherwise = "  abcdefgh\n"

ppLookUnit :: M.Map Position (Maybe Unit) -> Int -> Int -> Char
ppLookUnit sqs r f = case fromJust $ M.lookup (toPos' f r) sqs of
  Just u -> ppUnit u
  Nothing -> '.'

ppUnit :: Unit -> Char
ppUnit (U Bishop Black) = '♝'
ppUnit (U Bishop White) = '♗'
ppUnit (U King Black) = '♚'
ppUnit (U King White) = '♔'
ppUnit (U Knight Black) = '♞'
ppUnit (U Knight White) = '♘'
ppUnit (U Pawn Black) = '♟'
ppUnit (U Pawn White) = '♙'
ppUnit (U Queen Black) = '♛'
ppUnit (U Queen White) = '♕'
ppUnit (U Rook Black) = '♜'
ppUnit (U Rook White) = '♖'


toPos :: Char -> Int -> Position
toPos fc ri = let f = toEnum (fromEnum (toLower fc) - fromEnum 'a')
                  r = toEnum (pred ri)
              in Pos f r

toPos' :: Int -> Int -> Position
toPos' fi ri = Pos (toEnum (pred fi)) (toEnum (pred ri))

toPosCI :: Char -> Char -> Position
toPosCI fc rc = let f = toEnum (fromEnum (toLower fc) - fromEnum 'a')
                    r = toEnum (fromEnum rc - fromEnum '1')
                in Pos f r

toFig :: Char -> Figure
toFig 'b' = Bishop
toFig 'B' = Bishop
toFig 'k' = King
toFig 'K' = King
toFig 'n' = Knight
toFig 'N' = Knight
toFig 'p' = Pawn
toFig 'P' = Pawn
toFig 'q' = Queen
toFig 'Q' = Queen
toFig 'r' = Rook
toFig 'R' = Rook
