module Models.Score where

import           AppPrelude

import           Data.Int        (Int16)
import           Models.Piece
import           Test.QuickCheck (Arbitrary (..), elements)


type Score = Int16
type Phase = Int16
type Depth = Word8
type Ply   = Word8
type Age   = Word8


newtype NodeType = NodeType Word8
  deriving (NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
/= :: NodeType -> NodeType -> Bool
Eq, Eq NodeType
Eq NodeType =>
(NodeType -> NodeType -> Ordering)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType -> NodeType)
-> Ord NodeType
NodeType -> NodeType -> Bool
NodeType -> NodeType -> Ordering
NodeType -> NodeType -> NodeType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeType -> NodeType -> Ordering
compare :: NodeType -> NodeType -> Ordering
$c< :: NodeType -> NodeType -> Bool
< :: NodeType -> NodeType -> Bool
$c<= :: NodeType -> NodeType -> Bool
<= :: NodeType -> NodeType -> Bool
$c> :: NodeType -> NodeType -> Bool
> :: NodeType -> NodeType -> Bool
$c>= :: NodeType -> NodeType -> Bool
>= :: NodeType -> NodeType -> Bool
$cmax :: NodeType -> NodeType -> NodeType
max :: NodeType -> NodeType -> NodeType
$cmin :: NodeType -> NodeType -> NodeType
min :: NodeType -> NodeType -> NodeType
Ord, Integer -> NodeType
NodeType -> NodeType
NodeType -> NodeType -> NodeType
(NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType)
-> (NodeType -> NodeType)
-> (NodeType -> NodeType)
-> (Integer -> NodeType)
-> Num NodeType
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: NodeType -> NodeType -> NodeType
+ :: NodeType -> NodeType -> NodeType
$c- :: NodeType -> NodeType -> NodeType
- :: NodeType -> NodeType -> NodeType
$c* :: NodeType -> NodeType -> NodeType
* :: NodeType -> NodeType -> NodeType
$cnegate :: NodeType -> NodeType
negate :: NodeType -> NodeType
$cabs :: NodeType -> NodeType
abs :: NodeType -> NodeType
$csignum :: NodeType -> NodeType
signum :: NodeType -> NodeType
$cfromInteger :: Integer -> NodeType
fromInteger :: Integer -> NodeType
Num, Ptr NodeType -> IO NodeType
Ptr NodeType -> Int -> IO NodeType
Ptr NodeType -> Int -> NodeType -> IO ()
Ptr NodeType -> NodeType -> IO ()
NodeType -> Int
(NodeType -> Int)
-> (NodeType -> Int)
-> (Ptr NodeType -> Int -> IO NodeType)
-> (Ptr NodeType -> Int -> NodeType -> IO ())
-> (forall b. Ptr b -> Int -> IO NodeType)
-> (forall b. Ptr b -> Int -> NodeType -> IO ())
-> (Ptr NodeType -> IO NodeType)
-> (Ptr NodeType -> NodeType -> IO ())
-> Storable NodeType
forall b. Ptr b -> Int -> IO NodeType
forall b. Ptr b -> Int -> NodeType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: NodeType -> Int
sizeOf :: NodeType -> Int
$calignment :: NodeType -> Int
alignment :: NodeType -> Int
$cpeekElemOff :: Ptr NodeType -> Int -> IO NodeType
peekElemOff :: Ptr NodeType -> Int -> IO NodeType
$cpokeElemOff :: Ptr NodeType -> Int -> NodeType -> IO ()
pokeElemOff :: Ptr NodeType -> Int -> NodeType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO NodeType
peekByteOff :: forall b. Ptr b -> Int -> IO NodeType
$cpokeByteOff :: forall b. Ptr b -> Int -> NodeType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> NodeType -> IO ()
$cpeek :: Ptr NodeType -> IO NodeType
peek :: Ptr NodeType -> IO NodeType
$cpoke :: Ptr NodeType -> NodeType -> IO ()
poke :: Ptr NodeType -> NodeType -> IO ()
Storable, Int -> NodeType -> ShowS
[NodeType] -> ShowS
NodeType -> String
(Int -> NodeType -> ShowS)
-> (NodeType -> String) -> ([NodeType] -> ShowS) -> Show NodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeType -> ShowS
showsPrec :: Int -> NodeType -> ShowS
$cshow :: NodeType -> String
show :: NodeType -> String
$cshowList :: [NodeType] -> ShowS
showList :: [NodeType] -> ShowS
Show)

instance Arbitrary NodeType where
  arbitrary :: Gen NodeType
arbitrary = [NodeType] -> Gen NodeType
forall a. HasCallStack => [a] -> Gen a
elements [NodeType
PV, NodeType
Cut, NodeType
All]


{-# COMPLETE PV, Cut, All #-}
pattern PV, Cut, All :: NodeType
pattern $mPV :: forall {r}. NodeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bPV :: NodeType
PV  = NodeType 0
pattern $mCut :: forall {r}. NodeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bCut :: NodeType
Cut = NodeType 1
pattern $mAll :: forall {r}. NodeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bAll :: NodeType
All = NodeType 2


getNodeType :: Score -> Score -> Score -> NodeType
getNodeType :: Score -> Score -> Score -> NodeType
getNodeType !Score
alpha !Score
beta !Score
score
  | Score
score Score -> Score -> Bool
forall a. Ord a => a -> a -> Bool
>= Score
beta  = NodeType
Cut
  | Score
score Score -> Score -> Bool
forall a. Ord a => a -> a -> Bool
> Score
alpha = NodeType
PV
  | Bool
otherwise     = NodeType
All


pieceToPhase :: Piece -> Phase
pieceToPhase :: Piece -> Score
pieceToPhase = \case
  Piece
Knight -> Score
minorPiecePhase
  Piece
Bishop -> Score
minorPiecePhase
  Piece
Rook   -> Score
rookPhase
  Piece
Queen  -> Score
queenPhase
  Piece
_      -> Score
0


minorPiecePhase :: Phase
minorPiecePhase :: Score
minorPiecePhase = Score
1

rookPhase :: Phase
rookPhase :: Score
rookPhase = Score
2

queenPhase :: Phase
queenPhase :: Score
queenPhase = Score
4


totalPhase :: Phase
totalPhase :: Score
totalPhase =
  Score
minorPiecePhase Score -> Score -> Score
forall a. Num a => a -> a -> a
* Score
8 Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
rookPhase Score -> Score -> Score
forall a. Num a => a -> a -> a
* Score
4 Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
queenPhase Score -> Score -> Score
forall a. Num a => a -> a -> a
* Score
2


minScore :: Score
minScore :: Score
minScore = Score
forall a. Bounded a => a
minBound Score -> Score -> Score
forall a. Num a => a -> a -> a
+ Score
1

maxScore :: Score
maxScore :: Score
maxScore = Score
forall a. Bounded a => a
maxBound Score -> Score -> Score
forall a. Num a => a -> a -> a
- Score
1