module Models.Position where import AppPrelude import Models.Move (foldlBoard) import Models.Piece import Models.Score import Utils.Board import Data.Bitraversable (bisequence) import Data.List.Split (chunksOf) import Data.Maybe (fromJust) import Test.QuickCheck (Arbitrary (..)) data Position = Position { Position -> [ZKey] previousPositions :: ~[ZKey] , Position -> Ply halfMoveClock :: Ply , Position -> Phase phase :: Phase , Position -> Color color :: Color , Position -> Board player :: Board , Position -> Board enemy :: Board , Position -> Board pawns :: Board , Position -> Board knights :: Board , Position -> Board bishops :: Board , Position -> Board rooks :: Board , Position -> Board queens :: Board , Position -> Board kings :: Board , Position -> Board enPassant :: Board , Position -> Board castling :: Board , Position -> Board attacked :: Board , Position -> Board leapingCheckers :: Board , Position -> Board sliderCheckers :: Board , Position -> Board pinnedPieces :: Board } newtype ZKey = ZKey Word64 deriving (ZKey -> ZKey -> Bool (ZKey -> ZKey -> Bool) -> (ZKey -> ZKey -> Bool) -> Eq ZKey forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: ZKey -> ZKey -> Bool == :: ZKey -> ZKey -> Bool $c/= :: ZKey -> ZKey -> Bool /= :: ZKey -> ZKey -> Bool Eq, Int -> ZKey -> ShowS [ZKey] -> ShowS ZKey -> String (Int -> ZKey -> ShowS) -> (ZKey -> String) -> ([ZKey] -> ShowS) -> Show ZKey forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> ZKey -> ShowS showsPrec :: Int -> ZKey -> ShowS $cshow :: ZKey -> String show :: ZKey -> String $cshowList :: [ZKey] -> ShowS showList :: [ZKey] -> ShowS Show, (forall x. ZKey -> Rep ZKey x) -> (forall x. Rep ZKey x -> ZKey) -> Generic ZKey forall x. Rep ZKey x -> ZKey forall x. ZKey -> Rep ZKey x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall x. ZKey -> Rep ZKey x from :: forall x. ZKey -> Rep ZKey x $cto :: forall x. Rep ZKey x -> ZKey to :: forall x. Rep ZKey x -> ZKey Generic, Eq ZKey Eq ZKey => (ZKey -> ZKey -> Ordering) -> (ZKey -> ZKey -> Bool) -> (ZKey -> ZKey -> Bool) -> (ZKey -> ZKey -> Bool) -> (ZKey -> ZKey -> Bool) -> (ZKey -> ZKey -> ZKey) -> (ZKey -> ZKey -> ZKey) -> Ord ZKey ZKey -> ZKey -> Bool ZKey -> ZKey -> Ordering ZKey -> ZKey -> ZKey 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 :: ZKey -> ZKey -> Ordering compare :: ZKey -> ZKey -> Ordering $c< :: ZKey -> ZKey -> Bool < :: ZKey -> ZKey -> Bool $c<= :: ZKey -> ZKey -> Bool <= :: ZKey -> ZKey -> Bool $c> :: ZKey -> ZKey -> Bool > :: ZKey -> ZKey -> Bool $c>= :: ZKey -> ZKey -> Bool >= :: ZKey -> ZKey -> Bool $cmax :: ZKey -> ZKey -> ZKey max :: ZKey -> ZKey -> ZKey $cmin :: ZKey -> ZKey -> ZKey min :: ZKey -> ZKey -> ZKey Ord, Integer -> ZKey ZKey -> ZKey ZKey -> ZKey -> ZKey (ZKey -> ZKey -> ZKey) -> (ZKey -> ZKey -> ZKey) -> (ZKey -> ZKey -> ZKey) -> (ZKey -> ZKey) -> (ZKey -> ZKey) -> (ZKey -> ZKey) -> (Integer -> ZKey) -> Num ZKey forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a $c+ :: ZKey -> ZKey -> ZKey + :: ZKey -> ZKey -> ZKey $c- :: ZKey -> ZKey -> ZKey - :: ZKey -> ZKey -> ZKey $c* :: ZKey -> ZKey -> ZKey * :: ZKey -> ZKey -> ZKey $cnegate :: ZKey -> ZKey negate :: ZKey -> ZKey $cabs :: ZKey -> ZKey abs :: ZKey -> ZKey $csignum :: ZKey -> ZKey signum :: ZKey -> ZKey $cfromInteger :: Integer -> ZKey fromInteger :: Integer -> ZKey Num, Eq ZKey Eq ZKey => (Int -> ZKey -> Int) -> (ZKey -> Int) -> Hashable ZKey Int -> ZKey -> Int ZKey -> Int forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a $chashWithSalt :: Int -> ZKey -> Int hashWithSalt :: Int -> ZKey -> Int $chash :: ZKey -> Int hash :: ZKey -> Int Hashable, Ptr ZKey -> IO ZKey Ptr ZKey -> Int -> IO ZKey Ptr ZKey -> Int -> ZKey -> IO () Ptr ZKey -> ZKey -> IO () ZKey -> Int (ZKey -> Int) -> (ZKey -> Int) -> (Ptr ZKey -> Int -> IO ZKey) -> (Ptr ZKey -> Int -> ZKey -> IO ()) -> (forall b. Ptr b -> Int -> IO ZKey) -> (forall b. Ptr b -> Int -> ZKey -> IO ()) -> (Ptr ZKey -> IO ZKey) -> (Ptr ZKey -> ZKey -> IO ()) -> Storable ZKey forall b. Ptr b -> Int -> IO ZKey forall b. Ptr b -> Int -> ZKey -> 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 :: ZKey -> Int sizeOf :: ZKey -> Int $calignment :: ZKey -> Int alignment :: ZKey -> Int $cpeekElemOff :: Ptr ZKey -> Int -> IO ZKey peekElemOff :: Ptr ZKey -> Int -> IO ZKey $cpokeElemOff :: Ptr ZKey -> Int -> ZKey -> IO () pokeElemOff :: Ptr ZKey -> Int -> ZKey -> IO () $cpeekByteOff :: forall b. Ptr b -> Int -> IO ZKey peekByteOff :: forall b. Ptr b -> Int -> IO ZKey $cpokeByteOff :: forall b. Ptr b -> Int -> ZKey -> IO () pokeByteOff :: forall b. Ptr b -> Int -> ZKey -> IO () $cpeek :: Ptr ZKey -> IO ZKey peek :: Ptr ZKey -> IO ZKey $cpoke :: Ptr ZKey -> ZKey -> IO () poke :: Ptr ZKey -> ZKey -> IO () Storable, Gen ZKey Gen ZKey -> (ZKey -> [ZKey]) -> Arbitrary ZKey ZKey -> [ZKey] forall a. Gen a -> (a -> [a]) -> Arbitrary a $carbitrary :: Gen ZKey arbitrary :: Gen ZKey $cshrink :: ZKey -> [ZKey] shrink :: ZKey -> [ZKey] Arbitrary) startPosition :: Position startPosition :: Position startPosition = Position emptyPosition { color = White , phase = totalPhase , player = rank_1 .| rank_2 , enemy = rank_7 .| rank_8 , pawns = rank_2 .| rank_7 , rooks = (rank_1 .| rank_8) & (file_A .| file_H) , knights = (rank_1 .| rank_8) & (file_B .| file_G) , bishops = (rank_1 .| rank_8) & (file_C .| file_F) , queens = (rank_1 .| rank_8) & file_D , kings = (rank_1 .| rank_8) & file_E , castling = (rank_1 .| rank_8) & (file_A .| file_E .| file_H) } emptyPosition :: Position emptyPosition :: Position emptyPosition = Position { $sel:previousPositions:Position :: [ZKey] previousPositions = [] , $sel:color:Position :: Color color = Color White , $sel:halfMoveClock:Position :: Ply halfMoveClock = Ply 0 , $sel:phase:Position :: Phase phase = Phase 0 , $sel:player:Position :: Board player = Board 0 , $sel:enemy:Position :: Board enemy = Board 0 , $sel:pawns:Position :: Board pawns = Board 0 , $sel:rooks:Position :: Board rooks = Board 0 , $sel:knights:Position :: Board knights = Board 0 , $sel:bishops:Position :: Board bishops = Board 0 , $sel:queens:Position :: Board queens = Board 0 , $sel:kings:Position :: Board kings = Board 0 , $sel:castling:Position :: Board castling = Board 0 , $sel:attacked:Position :: Board attacked = Board 0 , $sel:enPassant:Position :: Board enPassant = Board 0 , $sel:leapingCheckers:Position :: Board leapingCheckers = Board 0 , $sel:sliderCheckers:Position :: Board sliderCheckers = Board 0 , $sel:pinnedPieces:Position :: Board pinnedPieces = Board 0 } {-# INLINE getZobristKey #-} getZobristKey :: Position -> ZKey getZobristKey :: Position -> ZKey getZobristKey pos :: Position pos@Position {Phase [ZKey] Ply Board Color $sel:previousPositions:Position :: Position -> [ZKey] $sel:halfMoveClock:Position :: Position -> Ply $sel:phase:Position :: Position -> Phase $sel:color:Position :: Position -> Color $sel:player:Position :: Position -> Board $sel:enemy:Position :: Position -> Board $sel:pawns:Position :: Position -> Board $sel:knights:Position :: Position -> Board $sel:bishops:Position :: Position -> Board $sel:rooks:Position :: Position -> Board $sel:queens:Position :: Position -> Board $sel:kings:Position :: Position -> Board $sel:enPassant:Position :: Position -> Board $sel:castling:Position :: Position -> Board $sel:attacked:Position :: Position -> Board $sel:leapingCheckers:Position :: Position -> Board $sel:sliderCheckers:Position :: Position -> Board $sel:pinnedPieces:Position :: Position -> Board previousPositions :: [ZKey] halfMoveClock :: Ply phase :: Phase color :: Color player :: Board enemy :: Board pawns :: Board knights :: Board bishops :: Board rooks :: Board queens :: Board kings :: Board enPassant :: Board castling :: Board attacked :: Board leapingCheckers :: Board sliderCheckers :: Board pinnedPieces :: Board ..} = Board -> ZKey ZKey (Board piecesHash Board -> Board -> Board ^ Board castlingHash Board -> Board -> Board ^ Board enPassantHash Board -> Board -> Board ^ Board sideToMoveHash) where !piecesHash :: Board piecesHash = Board -> (Board -> Board -> Board) -> (Int -> Board) -> Board -> Board forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a foldlBoard Board 0 Board -> Board -> Board (^) Int -> Board getPieceHash (Board player Board -> Board -> Board .| Board enemy) !castlingHash :: Board castlingHash = Vector Board castlingRngVec Vector Board -> Int -> Board forall a. Storable a => Vector a -> Int -> a !! Int idx where idx :: Int idx = Board -> Int forall {b}. Num b => Board -> b inBoard Board file_A Int -> Int -> Int forall a. Num a => a -> a -> a + Int 2 Int -> Int -> Int forall a. Num a => a -> a -> a * Board -> Int forall {b}. Num b => Board -> b inBoard Board file_H Int -> Int -> Int forall a. Num a => a -> a -> a + Int 4 Int -> Int -> Int forall a. Num a => a -> a -> a * Board -> Int forall {b}. Num b => Board -> b inBoard Board rank_1 Int -> Int -> Int forall a. Num a => a -> a -> a + Int 8 Int -> Int -> Int forall a. Num a => a -> a -> a * Board -> Int forall {b}. Num b => Board -> b inBoard Board rank_8 inBoard :: Board -> b inBoard Board x = Board -> b forall a b. (Integral a, Num b) => a -> b fromIntegral (Board -> b) -> Board -> b forall a b. (a -> b) -> a -> b $ Board -> Board forall a. (Ord a, Num a) => a -> a toCondition (Board castling Board -> Board -> Board & Board x) !enPassantHash :: Board enPassantHash = Board -> Board forall a. (Ord a, Num a) => a -> a toCondition Board enPassant Board -> Board -> Board forall a. Num a => a -> a -> a * Vector Board enPassantRngVec Vector Board -> Int -> Board forall a. Storable a => Vector a -> Int -> a !! Int idx where idx :: Int idx = Int -> Int toFile (Board -> Int lsb Board enPassant) !sideToMoveHash :: Board sideToMoveHash = Ply -> Board forall a b. (Integral a, Num b) => a -> b fromIntegral Ply colorN Board -> Board -> Board forall a. Num a => a -> a -> a * Board sideToMoveRng where Color Ply colorN = Color color getPieceHash :: Int -> Board getPieceHash Int n = Vector Board pieceRngVec Vector Board -> Int -> Board forall a. Storable a => Vector a -> Int -> a !! Int idx where idx :: Int idx = Int n Int -> Int -> Int forall a. Num a => a -> a -> a + Int 64 Int -> Int -> Int forall a. Num a => a -> a -> a * (Ply -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Ply piece Int -> Int -> Int forall a. Num a => a -> a -> a + Int 6 Int -> Int -> Int forall a. Num a => a -> a -> a * Ply -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Ply pieceColor) (Piece Ply piece, Color Ply pieceColor) = Maybe (Piece, Color) -> (Piece, Color) forall a. HasCallStack => Maybe a -> a fromJust (Maybe (Piece, Color) -> (Piece, Color)) -> Maybe (Piece, Color) -> (Piece, Color) forall a b. (a -> b) -> a -> b $ Int -> Position -> Maybe (Piece, Color) pieceAt Int n Position pos {-# INLINE pieceAt #-} pieceAt :: Square -> Position -> Maybe (Piece, Color) pieceAt :: Int -> Position -> Maybe (Piece, Color) pieceAt Int n (Position {Phase [ZKey] Ply Board Color $sel:previousPositions:Position :: Position -> [ZKey] $sel:halfMoveClock:Position :: Position -> Ply $sel:phase:Position :: Position -> Phase $sel:color:Position :: Position -> Color $sel:player:Position :: Position -> Board $sel:enemy:Position :: Position -> Board $sel:pawns:Position :: Position -> Board $sel:knights:Position :: Position -> Board $sel:bishops:Position :: Position -> Board $sel:rooks:Position :: Position -> Board $sel:queens:Position :: Position -> Board $sel:kings:Position :: Position -> Board $sel:enPassant:Position :: Position -> Board $sel:castling:Position :: Position -> Board $sel:attacked:Position :: Position -> Board $sel:leapingCheckers:Position :: Position -> Board $sel:sliderCheckers:Position :: Position -> Board $sel:pinnedPieces:Position :: Position -> Board previousPositions :: [ZKey] halfMoveClock :: Ply phase :: Phase color :: Color player :: Board enemy :: Board pawns :: Board knights :: Board bishops :: Board rooks :: Board queens :: Board kings :: Board enPassant :: Board castling :: Board attacked :: Board leapingCheckers :: Board sliderCheckers :: Board pinnedPieces :: Board ..}) = (Maybe Piece, Maybe Color) -> Maybe (Piece, Color) forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bisequence (Maybe Piece piece, Maybe Color color') where piece :: Maybe Piece piece | Board -> Int -> Bool testSquare Board pawns Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Pawn | Board -> Int -> Bool testSquare Board knights Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Knight | Board -> Int -> Bool testSquare Board bishops Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Bishop | Board -> Int -> Bool testSquare Board rooks Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Rook | Board -> Int -> Bool testSquare Board queens Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Queen | Board -> Int -> Bool testSquare Board kings Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece King | Bool otherwise = Maybe Piece forall a. Maybe a Nothing color' :: Maybe Color color' | Board -> Int -> Bool testSquare Board player Int n = Color -> Maybe Color forall a. a -> Maybe a Just Color color | Board -> Int -> Bool testSquare Board enemy Int n = Color -> Maybe Color forall a. a -> Maybe a Just (Color -> Maybe Color) -> Color -> Maybe Color forall a b. (a -> b) -> a -> b $ Color -> Color reverseColor Color color | Bool otherwise = Maybe Color forall a. Maybe a Nothing {-# INLINE maybeCapturedPieceAt #-} maybeCapturedPieceAt :: Square -> Position -> Maybe Piece maybeCapturedPieceAt :: Int -> Position -> Maybe Piece maybeCapturedPieceAt Int n (Position {Phase [ZKey] Ply Board Color $sel:previousPositions:Position :: Position -> [ZKey] $sel:halfMoveClock:Position :: Position -> Ply $sel:phase:Position :: Position -> Phase $sel:color:Position :: Position -> Color $sel:player:Position :: Position -> Board $sel:enemy:Position :: Position -> Board $sel:pawns:Position :: Position -> Board $sel:knights:Position :: Position -> Board $sel:bishops:Position :: Position -> Board $sel:rooks:Position :: Position -> Board $sel:queens:Position :: Position -> Board $sel:kings:Position :: Position -> Board $sel:enPassant:Position :: Position -> Board $sel:castling:Position :: Position -> Board $sel:attacked:Position :: Position -> Board $sel:leapingCheckers:Position :: Position -> Board $sel:sliderCheckers:Position :: Position -> Board $sel:pinnedPieces:Position :: Position -> Board previousPositions :: [ZKey] halfMoveClock :: Ply phase :: Phase color :: Color player :: Board enemy :: Board pawns :: Board knights :: Board bishops :: Board rooks :: Board queens :: Board kings :: Board enPassant :: Board castling :: Board attacked :: Board leapingCheckers :: Board sliderCheckers :: Board pinnedPieces :: Board ..}) | Board -> Int -> Bool testSquare Board pawns Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Pawn | Board -> Int -> Bool testSquare Board knights Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Knight | Board -> Int -> Bool testSquare Board bishops Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Bishop | Board -> Int -> Bool testSquare Board rooks Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Rook | Board -> Int -> Bool testSquare Board queens Int n = Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Queen | Bool otherwise = Maybe Piece forall a. Maybe a Nothing {-# INLINE isPieceAt #-} isPieceAt :: Piece -> Square -> Position -> Bool isPieceAt :: Piece -> Int -> Position -> Bool isPieceAt Piece piece Int n Position {Phase [ZKey] Ply Board Color $sel:previousPositions:Position :: Position -> [ZKey] $sel:halfMoveClock:Position :: Position -> Ply $sel:phase:Position :: Position -> Phase $sel:color:Position :: Position -> Color $sel:player:Position :: Position -> Board $sel:enemy:Position :: Position -> Board $sel:pawns:Position :: Position -> Board $sel:knights:Position :: Position -> Board $sel:bishops:Position :: Position -> Board $sel:rooks:Position :: Position -> Board $sel:queens:Position :: Position -> Board $sel:kings:Position :: Position -> Board $sel:enPassant:Position :: Position -> Board $sel:castling:Position :: Position -> Board $sel:attacked:Position :: Position -> Board $sel:leapingCheckers:Position :: Position -> Board $sel:sliderCheckers:Position :: Position -> Board $sel:pinnedPieces:Position :: Position -> Board previousPositions :: [ZKey] halfMoveClock :: Ply phase :: Phase color :: Color player :: Board enemy :: Board pawns :: Board knights :: Board bishops :: Board rooks :: Board queens :: Board kings :: Board enPassant :: Board castling :: Board attacked :: Board leapingCheckers :: Board sliderCheckers :: Board pinnedPieces :: Board ..} = case Piece piece of Piece Pawn -> Board -> Int -> Bool testSquare Board pawns Int n Piece Knight -> Board -> Int -> Bool testSquare Board knights Int n Piece Bishop -> Board -> Int -> Bool testSquare Board bishops Int n Piece Rook -> Board -> Int -> Bool testSquare Board rooks Int n Piece Queen -> Board -> Int -> Bool testSquare Board queens Int n Piece King -> Board -> Int -> Bool testSquare Board kings Int n {-# INLINE isRepeatedPosition #-} isRepeatedPosition :: ZKey -> Position -> Bool isRepeatedPosition :: ZKey -> Position -> Bool isRepeatedPosition ZKey zKey Position {Phase [ZKey] Ply Board Color $sel:previousPositions:Position :: Position -> [ZKey] $sel:halfMoveClock:Position :: Position -> Ply $sel:phase:Position :: Position -> Phase $sel:color:Position :: Position -> Color $sel:player:Position :: Position -> Board $sel:enemy:Position :: Position -> Board $sel:pawns:Position :: Position -> Board $sel:knights:Position :: Position -> Board $sel:bishops:Position :: Position -> Board $sel:rooks:Position :: Position -> Board $sel:queens:Position :: Position -> Board $sel:kings:Position :: Position -> Board $sel:enPassant:Position :: Position -> Board $sel:castling:Position :: Position -> Board $sel:attacked:Position :: Position -> Board $sel:leapingCheckers:Position :: Position -> Board $sel:sliderCheckers:Position :: Position -> Board $sel:pinnedPieces:Position :: Position -> Board previousPositions :: [ZKey] halfMoveClock :: Ply phase :: Phase color :: Color player :: Board enemy :: Board pawns :: Board knights :: Board bishops :: Board rooks :: Board queens :: Board kings :: Board enPassant :: Board castling :: Board attacked :: Board leapingCheckers :: Board sliderCheckers :: Board pinnedPieces :: Board ..} = ZKey zKey ZKey -> [ZKey] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [ZKey] previousPositions {-# INLINE getPhase #-} getPhase :: Position -> Phase getPhase :: Position -> Phase getPhase Position {Phase [ZKey] Ply Board Color $sel:previousPositions:Position :: Position -> [ZKey] $sel:halfMoveClock:Position :: Position -> Ply $sel:phase:Position :: Position -> Phase $sel:color:Position :: Position -> Color $sel:player:Position :: Position -> Board $sel:enemy:Position :: Position -> Board $sel:pawns:Position :: Position -> Board $sel:knights:Position :: Position -> Board $sel:bishops:Position :: Position -> Board $sel:rooks:Position :: Position -> Board $sel:queens:Position :: Position -> Board $sel:kings:Position :: Position -> Board $sel:enPassant:Position :: Position -> Board $sel:castling:Position :: Position -> Board $sel:attacked:Position :: Position -> Board $sel:leapingCheckers:Position :: Position -> Board $sel:sliderCheckers:Position :: Position -> Board $sel:pinnedPieces:Position :: Position -> Board previousPositions :: [ZKey] halfMoveClock :: Ply phase :: Phase color :: Color player :: Board enemy :: Board pawns :: Board knights :: Board bishops :: Board rooks :: Board queens :: Board kings :: Board enPassant :: Board castling :: Board attacked :: Board leapingCheckers :: Board sliderCheckers :: Board pinnedPieces :: Board ..} = Phase -> Phase -> Phase forall a. Ord a => a -> a -> a min Phase totalPhase (Phase minorPiecePhase Phase -> Phase -> Phase forall a. Num a => a -> a -> a * Int -> Phase forall a b. (Integral a, Num b) => a -> b fromIntegral (Board -> Int popCount (Board knights Board -> Board -> Board .| Board bishops)) Phase -> Phase -> Phase forall a. Num a => a -> a -> a + Phase rookPhase Phase -> Phase -> Phase forall a. Num a => a -> a -> a * Int -> Phase forall a b. (Integral a, Num b) => a -> b fromIntegral (Board -> Int popCount Board rooks) Phase -> Phase -> Phase forall a. Num a => a -> a -> a + Phase queenPhase Phase -> Phase -> Phase forall a. Num a => a -> a -> a * Int -> Phase forall a b. (Integral a, Num b) => a -> b fromIntegral (Board -> Int popCount Board queens)) instance Show Position where show :: Position -> String show Position pos = Color -> String forall a. Show a => a -> String show Position pos.color String -> ShowS forall a. Semigroup a => a -> a -> a <> String " to play: \n\n" String -> ShowS forall a. Semigroup a => a -> a -> a <> String boardStr where boardStr :: Element [String] boardStr = Element [String] -> [String] -> Element [String] forall mono. (MonoFoldable mono, Monoid (Element mono)) => Element mono -> mono -> Element mono intercalate String Element [String] "\n" (Element String -> ShowS forall seq. SemiSequence seq => Element seq -> seq -> seq intersperse Char Element String ' ' ShowS -> [String] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] pieces) pieces :: [String] pieces = [String] -> [String] forall seq. SemiSequence seq => seq -> seq reverse ([String] -> [String]) -> [String] -> [String] forall a b. (a -> b) -> a -> b $ Int -> String -> [String] forall e. Int -> [e] -> [[e]] chunksOf Int 8 do Int n <- Vector Int -> [Element (Vector Int)] forall mono. MonoFoldable mono => mono -> [Element mono] toList Vector Int squares Char -> String forall a. a -> [a] forall (f :: * -> *) a. Applicative f => a -> f a pure (Char -> String) -> Char -> String forall a b. (a -> b) -> a -> b $ Char -> ((Piece, Color) -> Char) -> Maybe (Piece, Color) -> Char forall b a. b -> (a -> b) -> Maybe a -> b maybe Char ' ' (Piece, Color) -> Char pieceToChar (Int -> Position -> Maybe (Piece, Color) pieceAt Int n Position pos)