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 '-'