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