module Evaluation.ScoreBreakdown where

import           AppPrelude

import           Models.Score

import           Bookhound.Utils.Text
import           Foreign.Storable.Generic


data ScoreBreakdown = ScoreBreakdown
  { ScoreBreakdown -> PlayerScoreBreakdown
playerBreakdown     :: PlayerScoreBreakdown
  , ScoreBreakdown -> PlayerScoreBreakdown
enemyBreakdown      :: PlayerScoreBreakdown
  , ScoreBreakdown -> Score
materialTradesScore :: Score
  }

data PlayerScoreBreakdown = PlayerScoreBreakdown
  { PlayerScoreBreakdown -> MaterialBreakdown
materialBreakdown :: MaterialBreakdown
  , PlayerScoreBreakdown -> BonusBreakdown
bonusBreakdown    :: BonusBreakdown
  , PlayerScoreBreakdown -> PenaltyBreakdown
penaltyBreakdown  :: PenaltyBreakdown
  }

data MaterialBreakdown = MaterialBreakdown
  { MaterialBreakdown -> ScorePair
queens  :: ScorePair
  , MaterialBreakdown -> ScorePair
rooks   :: ScorePair
  , MaterialBreakdown -> ScorePair
bishops :: ScorePair
  , MaterialBreakdown -> ScorePair
knights :: ScorePair
  , MaterialBreakdown -> ScorePair
pawns   :: ScorePair
  , MaterialBreakdown -> ScorePair
kings   :: ScorePair
  }

data BonusBreakdown = BonusBreakdown
  { BonusBreakdown -> Score
mobility        :: Score
  , BonusBreakdown -> Score
passedPawns     :: Score
  , BonusBreakdown -> Score
bishopPair      :: Score
  , BonusBreakdown -> Score
knightOutposts  :: Score
  , BonusBreakdown -> Score
rooksOnOpenFile :: Score
  , BonusBreakdown -> Score
kingPawnShield  :: Score
  , BonusBreakdown -> Score
castlingRights  :: Score
  }

data PenaltyBreakdown = PenaltyBreakdown
  { PenaltyBreakdown -> Score
threats       :: Score
  , PenaltyBreakdown -> Score
kingThreats   :: Score
  , PenaltyBreakdown -> Score
isolatedPawns :: Score
  , PenaltyBreakdown -> Score
doubledPawns  :: Score
  }

data ScorePair = ScorePair Score Score
  deriving (forall x. ScorePair -> Rep ScorePair x)
-> (forall x. Rep ScorePair x -> ScorePair) -> Generic ScorePair
forall x. Rep ScorePair x -> ScorePair
forall x. ScorePair -> Rep ScorePair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScorePair -> Rep ScorePair x
from :: forall x. ScorePair -> Rep ScorePair x
$cto :: forall x. Rep ScorePair x -> ScorePair
to :: forall x. Rep ScorePair x -> ScorePair
Generic

instance GStorable ScorePair

class EvalScore a where
  evalScore :: a -> Score


instance EvalScore ScoreBreakdown where
  evalScore :: ScoreBreakdown -> Score
evalScore ScoreBreakdown {Score
PlayerScoreBreakdown
$sel:playerBreakdown:ScoreBreakdown :: ScoreBreakdown -> PlayerScoreBreakdown
$sel:enemyBreakdown:ScoreBreakdown :: ScoreBreakdown -> PlayerScoreBreakdown
$sel:materialTradesScore:ScoreBreakdown :: ScoreBreakdown -> Score
playerBreakdown :: PlayerScoreBreakdown
enemyBreakdown :: PlayerScoreBreakdown
materialTradesScore :: Score
..} =
    PlayerScoreBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore PlayerScoreBreakdown
playerBreakdown Score -> Score -> Score
forall a. Num a => a -> a -> a
- PlayerScoreBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore PlayerScoreBreakdown
enemyBreakdown


instance EvalScore PlayerScoreBreakdown where
  evalScore :: PlayerScoreBreakdown -> Score
evalScore PlayerScoreBreakdown {PenaltyBreakdown
BonusBreakdown
MaterialBreakdown
$sel:materialBreakdown:PlayerScoreBreakdown :: PlayerScoreBreakdown -> MaterialBreakdown
$sel:bonusBreakdown:PlayerScoreBreakdown :: PlayerScoreBreakdown -> BonusBreakdown
$sel:penaltyBreakdown:PlayerScoreBreakdown :: PlayerScoreBreakdown -> PenaltyBreakdown
materialBreakdown :: MaterialBreakdown
bonusBreakdown :: BonusBreakdown
penaltyBreakdown :: PenaltyBreakdown
..} =
      MaterialBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore MaterialBreakdown
materialBreakdown
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ BonusBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore BonusBreakdown
bonusBreakdown
    Score -> Score -> Score
forall a. Num a => a -> a -> a
- PenaltyBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore PenaltyBreakdown
penaltyBreakdown

instance EvalScore MaterialBreakdown where
  evalScore :: MaterialBreakdown -> Score
evalScore MaterialBreakdown {ScorePair
$sel:queens:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:rooks:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:bishops:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:knights:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:pawns:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:kings:MaterialBreakdown :: MaterialBreakdown -> ScorePair
queens :: ScorePair
rooks :: ScorePair
bishops :: ScorePair
knights :: ScorePair
pawns :: ScorePair
kings :: ScorePair
..} =
      ScorePair -> Score
forall a. EvalScore a => a -> Score
evalScore ScorePair
queens  Score -> Score -> Score
forall a. Num a => a -> a -> a
+ ScorePair -> Score
forall a. EvalScore a => a -> Score
evalScore ScorePair
rooks
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ ScorePair -> Score
forall a. EvalScore a => a -> Score
evalScore ScorePair
bishops Score -> Score -> Score
forall a. Num a => a -> a -> a
+ ScorePair -> Score
forall a. EvalScore a => a -> Score
evalScore ScorePair
knights
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ ScorePair -> Score
forall a. EvalScore a => a -> Score
evalScore ScorePair
pawns   Score -> Score -> Score
forall a. Num a => a -> a -> a
+ ScorePair -> Score
forall a. EvalScore a => a -> Score
evalScore ScorePair
kings


instance EvalScore BonusBreakdown where
  evalScore :: BonusBreakdown -> Score
evalScore BonusBreakdown {Score
$sel:mobility:BonusBreakdown :: BonusBreakdown -> Score
$sel:passedPawns:BonusBreakdown :: BonusBreakdown -> Score
$sel:bishopPair:BonusBreakdown :: BonusBreakdown -> Score
$sel:knightOutposts:BonusBreakdown :: BonusBreakdown -> Score
$sel:rooksOnOpenFile:BonusBreakdown :: BonusBreakdown -> Score
$sel:kingPawnShield:BonusBreakdown :: BonusBreakdown -> Score
$sel:castlingRights:BonusBreakdown :: BonusBreakdown -> Score
mobility :: Score
passedPawns :: Score
bishopPair :: Score
knightOutposts :: Score
rooksOnOpenFile :: Score
kingPawnShield :: Score
castlingRights :: Score
..} =
      Score
mobility        Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
passedPawns
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
bishopPair      Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
knightOutposts
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
rooksOnOpenFile Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
kingPawnShield
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
castlingRights


instance EvalScore PenaltyBreakdown where
  evalScore :: PenaltyBreakdown -> Score
evalScore PenaltyBreakdown {Score
$sel:threats:PenaltyBreakdown :: PenaltyBreakdown -> Score
$sel:kingThreats:PenaltyBreakdown :: PenaltyBreakdown -> Score
$sel:isolatedPawns:PenaltyBreakdown :: PenaltyBreakdown -> Score
$sel:doubledPawns:PenaltyBreakdown :: PenaltyBreakdown -> Score
threats :: Score
kingThreats :: Score
isolatedPawns :: Score
doubledPawns :: Score
..} =
      Score
threats       Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
kingThreats
    Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
isolatedPawns Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
doubledPawns

instance EvalScore ScorePair where
  evalScore :: ScorePair -> Score
evalScore (ScorePair Score
x Score
y) = Score
x Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
y


instance Show ScoreBreakdown where
  show :: ScoreBreakdown -> String
show breakdown :: ScoreBreakdown
breakdown@ScoreBreakdown {Score
PlayerScoreBreakdown
$sel:playerBreakdown:ScoreBreakdown :: ScoreBreakdown -> PlayerScoreBreakdown
$sel:enemyBreakdown:ScoreBreakdown :: ScoreBreakdown -> PlayerScoreBreakdown
$sel:materialTradesScore:ScoreBreakdown :: ScoreBreakdown -> Score
playerBreakdown :: PlayerScoreBreakdown
enemyBreakdown :: PlayerScoreBreakdown
materialTradesScore :: Score
..} = [String] -> String
forall seq.
(Element seq ~ String, MonoFoldable seq) =>
seq -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines
    [String
"Player: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indentBreak (PlayerScoreBreakdown -> String
forall a. Show a => a -> String
show PlayerScoreBreakdown
playerBreakdown),
     String
"Enemy:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indentBreak (PlayerScoreBreakdown -> String
forall a. Show a => a -> String
show PlayerScoreBreakdown
enemyBreakdown),
     String
totalScoreLine,
     String
"Total: "  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show (ScoreBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore ScoreBreakdown
breakdown),
     String
totalScoreLine]



instance Show PlayerScoreBreakdown where
  show :: PlayerScoreBreakdown -> String
show breakdown :: PlayerScoreBreakdown
breakdown@PlayerScoreBreakdown {PenaltyBreakdown
BonusBreakdown
MaterialBreakdown
$sel:materialBreakdown:PlayerScoreBreakdown :: PlayerScoreBreakdown -> MaterialBreakdown
$sel:bonusBreakdown:PlayerScoreBreakdown :: PlayerScoreBreakdown -> BonusBreakdown
$sel:penaltyBreakdown:PlayerScoreBreakdown :: PlayerScoreBreakdown -> PenaltyBreakdown
materialBreakdown :: MaterialBreakdown
bonusBreakdown :: BonusBreakdown
penaltyBreakdown :: PenaltyBreakdown
..} = [String] -> String
forall seq.
(Element seq ~ String, MonoFoldable seq) =>
seq -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines
    [String
"Material:       " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indentBreak (MaterialBreakdown -> String
forall a. Show a => a -> String
show MaterialBreakdown
materialBreakdown),
     String
"Bonus Scores:   " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indentBreak (BonusBreakdown -> String
forall a. Show a => a -> String
show BonusBreakdown
bonusBreakdown),
     String
"Penalty Scores: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indentBreak (PenaltyBreakdown -> String
forall a. Show a => a -> String
show PenaltyBreakdown
penaltyBreakdown),
     String
totalScoreLine,
     String
"Player Total: "   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show (PlayerScoreBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore PlayerScoreBreakdown
breakdown),
     String
totalScoreLine]

instance Show MaterialBreakdown where
  show :: MaterialBreakdown -> String
show breakdown :: MaterialBreakdown
breakdown@MaterialBreakdown {ScorePair
$sel:queens:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:rooks:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:bishops:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:knights:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:pawns:MaterialBreakdown :: MaterialBreakdown -> ScorePair
$sel:kings:MaterialBreakdown :: MaterialBreakdown -> ScorePair
queens :: ScorePair
rooks :: ScorePair
bishops :: ScorePair
knights :: ScorePair
pawns :: ScorePair
kings :: ScorePair
..} = [String] -> String
forall seq.
(Element seq ~ String, MonoFoldable seq) =>
seq -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines
    [String
"Queens:  "        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScorePair -> String
forall a. Show a => a -> String
show ScorePair
queens,
     String
"Rooks:   "        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScorePair -> String
forall a. Show a => a -> String
show ScorePair
rooks,
     String
"Bishops: "        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScorePair -> String
forall a. Show a => a -> String
show ScorePair
bishops,
     String
"Knights: "        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScorePair -> String
forall a. Show a => a -> String
show ScorePair
knights,
     String
"Pawns:   "        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScorePair -> String
forall a. Show a => a -> String
show ScorePair
pawns,
     String
"Kings:   "        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScorePair -> String
forall a. Show a => a -> String
show ScorePair
kings,
     String
totalScoreLine,
     String
"Material Total: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show (MaterialBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore MaterialBreakdown
breakdown),
     String
totalScoreLine]


instance Show BonusBreakdown where
  show :: BonusBreakdown -> String
show breakdown :: BonusBreakdown
breakdown@BonusBreakdown {Score
$sel:mobility:BonusBreakdown :: BonusBreakdown -> Score
$sel:passedPawns:BonusBreakdown :: BonusBreakdown -> Score
$sel:bishopPair:BonusBreakdown :: BonusBreakdown -> Score
$sel:knightOutposts:BonusBreakdown :: BonusBreakdown -> Score
$sel:rooksOnOpenFile:BonusBreakdown :: BonusBreakdown -> Score
$sel:kingPawnShield:BonusBreakdown :: BonusBreakdown -> Score
$sel:castlingRights:BonusBreakdown :: BonusBreakdown -> Score
mobility :: Score
passedPawns :: Score
bishopPair :: Score
knightOutposts :: Score
rooksOnOpenFile :: Score
kingPawnShield :: Score
castlingRights :: Score
..} = [String] -> String
forall seq.
(Element seq ~ String, MonoFoldable seq) =>
seq -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines
    [String
"Mobility:            " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
mobility,
     String
"Passed Pawns:        " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
passedPawns,
     String
"Bishop Pair:         " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
bishopPair,
     String
"Knight Outposts:     " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
knightOutposts,
     String
"Rooks On Open Files: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
rooksOnOpenFile,
     String
"King Pawn Shield:    " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
kingPawnShield,
     String
"Castling Rights:     " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
castlingRights,
     String
totalScoreLine,
     String
"Bonus Total: "         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show (BonusBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore BonusBreakdown
breakdown),
     String
totalScoreLine]


instance Show PenaltyBreakdown where
  show :: PenaltyBreakdown -> String
show breakdown :: PenaltyBreakdown
breakdown@PenaltyBreakdown {Score
$sel:threats:PenaltyBreakdown :: PenaltyBreakdown -> Score
$sel:kingThreats:PenaltyBreakdown :: PenaltyBreakdown -> Score
$sel:isolatedPawns:PenaltyBreakdown :: PenaltyBreakdown -> Score
$sel:doubledPawns:PenaltyBreakdown :: PenaltyBreakdown -> Score
threats :: Score
kingThreats :: Score
isolatedPawns :: Score
doubledPawns :: Score
..} = [String] -> String
forall seq.
(Element seq ~ String, MonoFoldable seq) =>
seq -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines
    [String
"Threats:        " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
threats,
     String
"King Threats:   " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
kingThreats,
     String
"Isolated pawns: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
isolatedPawns,
     String
"Doubled pawns:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
doubledPawns,
     String
totalScoreLine,
     String
"Penalty Total: "  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show (PenaltyBreakdown -> Score
forall a. EvalScore a => a -> Score
evalScore PenaltyBreakdown
breakdown),
     String
totalScoreLine]

instance Show ScorePair where
  show :: ScorePair -> String
show (ScorePair Score
x Score
y) = String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
fill Int
4 (Score -> String
forall a. Show a => a -> String
show Score
x) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Score -> String
forall a. Show a => a -> String
show Score
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"


fill :: Int -> String -> String
fill :: Int -> ShowS
fill Int
n String
str = Index String -> Element String -> String
forall seq. IsSequence seq => Index seq -> Element seq -> seq
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall mono. MonoFoldable mono => mono -> Int
length String
str) Char
Element String
' ' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str

indentBreak :: String -> String
indentBreak :: ShowS
indentBreak String
str = String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indent Int
2 String
str

totalScoreLine :: String
totalScoreLine :: String
totalScoreLine = Index String -> Element String -> String
forall seq. IsSequence seq => Index seq -> Element seq -> seq
replicate Int
Index String
20 Char
Element String
'-'