module Models.Piece where import AppPrelude import Data.Char (isUpper) import qualified Data.Char as Char import qualified Data.Set as Set import Test.QuickCheck (Arbitrary, elements) import Test.QuickCheck.Arbitrary (Arbitrary (..)) newtype Piece = Piece Word8 deriving (Piece -> Piece -> Bool (Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Piece -> Piece -> Bool == :: Piece -> Piece -> Bool $c/= :: Piece -> Piece -> Bool /= :: Piece -> Piece -> Bool Eq, Eq Piece Eq Piece => (Piece -> Piece -> Ordering) -> (Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> (Piece -> Piece -> Piece) -> (Piece -> Piece -> Piece) -> Ord Piece Piece -> Piece -> Bool Piece -> Piece -> Ordering Piece -> Piece -> Piece 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 :: Piece -> Piece -> Ordering compare :: Piece -> Piece -> Ordering $c< :: Piece -> Piece -> Bool < :: Piece -> Piece -> Bool $c<= :: Piece -> Piece -> Bool <= :: Piece -> Piece -> Bool $c> :: Piece -> Piece -> Bool > :: Piece -> Piece -> Bool $c>= :: Piece -> Piece -> Bool >= :: Piece -> Piece -> Bool $cmax :: Piece -> Piece -> Piece max :: Piece -> Piece -> Piece $cmin :: Piece -> Piece -> Piece min :: Piece -> Piece -> Piece Ord, Int -> Piece Piece -> Int Piece -> [Piece] Piece -> Piece Piece -> Piece -> [Piece] Piece -> Piece -> Piece -> [Piece] (Piece -> Piece) -> (Piece -> Piece) -> (Int -> Piece) -> (Piece -> Int) -> (Piece -> [Piece]) -> (Piece -> Piece -> [Piece]) -> (Piece -> Piece -> [Piece]) -> (Piece -> Piece -> Piece -> [Piece]) -> Enum Piece forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a $csucc :: Piece -> Piece succ :: Piece -> Piece $cpred :: Piece -> Piece pred :: Piece -> Piece $ctoEnum :: Int -> Piece toEnum :: Int -> Piece $cfromEnum :: Piece -> Int fromEnum :: Piece -> Int $cenumFrom :: Piece -> [Piece] enumFrom :: Piece -> [Piece] $cenumFromThen :: Piece -> Piece -> [Piece] enumFromThen :: Piece -> Piece -> [Piece] $cenumFromTo :: Piece -> Piece -> [Piece] enumFromTo :: Piece -> Piece -> [Piece] $cenumFromThenTo :: Piece -> Piece -> Piece -> [Piece] enumFromThenTo :: Piece -> Piece -> Piece -> [Piece] Enum, Piece Piece -> Piece -> Bounded Piece forall a. a -> a -> Bounded a $cminBound :: Piece minBound :: Piece $cmaxBound :: Piece maxBound :: Piece Bounded, Eq Piece Eq Piece => (Int -> Piece -> Int) -> (Piece -> Int) -> Hashable Piece Int -> Piece -> Int Piece -> Int forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a $chashWithSalt :: Int -> Piece -> Int hashWithSalt :: Int -> Piece -> Int $chash :: Piece -> Int hash :: Piece -> Int Hashable, Ptr Piece -> IO Piece Ptr Piece -> Int -> IO Piece Ptr Piece -> Int -> Piece -> IO () Ptr Piece -> Piece -> IO () Piece -> Int (Piece -> Int) -> (Piece -> Int) -> (Ptr Piece -> Int -> IO Piece) -> (Ptr Piece -> Int -> Piece -> IO ()) -> (forall b. Ptr b -> Int -> IO Piece) -> (forall b. Ptr b -> Int -> Piece -> IO ()) -> (Ptr Piece -> IO Piece) -> (Ptr Piece -> Piece -> IO ()) -> Storable Piece forall b. Ptr b -> Int -> IO Piece forall b. Ptr b -> Int -> Piece -> 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 :: Piece -> Int sizeOf :: Piece -> Int $calignment :: Piece -> Int alignment :: Piece -> Int $cpeekElemOff :: Ptr Piece -> Int -> IO Piece peekElemOff :: Ptr Piece -> Int -> IO Piece $cpokeElemOff :: Ptr Piece -> Int -> Piece -> IO () pokeElemOff :: Ptr Piece -> Int -> Piece -> IO () $cpeekByteOff :: forall b. Ptr b -> Int -> IO Piece peekByteOff :: forall b. Ptr b -> Int -> IO Piece $cpokeByteOff :: forall b. Ptr b -> Int -> Piece -> IO () pokeByteOff :: forall b. Ptr b -> Int -> Piece -> IO () $cpeek :: Ptr Piece -> IO Piece peek :: Ptr Piece -> IO Piece $cpoke :: Ptr Piece -> Piece -> IO () poke :: Ptr Piece -> Piece -> IO () Storable) instance Arbitrary Piece where arbitrary :: Gen Piece arbitrary = [Piece] -> Gen Piece forall a. HasCallStack => [a] -> Gen a elements [Piece Pawn, Piece Knight, Piece Bishop, Piece Rook, Piece Queen] newtype Promotion = Promotion Word8 deriving (Promotion -> Promotion -> Bool (Promotion -> Promotion -> Bool) -> (Promotion -> Promotion -> Bool) -> Eq Promotion forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Promotion -> Promotion -> Bool == :: Promotion -> Promotion -> Bool $c/= :: Promotion -> Promotion -> Bool /= :: Promotion -> Promotion -> Bool Eq, Eq Promotion Eq Promotion => (Promotion -> Promotion -> Ordering) -> (Promotion -> Promotion -> Bool) -> (Promotion -> Promotion -> Bool) -> (Promotion -> Promotion -> Bool) -> (Promotion -> Promotion -> Bool) -> (Promotion -> Promotion -> Promotion) -> (Promotion -> Promotion -> Promotion) -> Ord Promotion Promotion -> Promotion -> Bool Promotion -> Promotion -> Ordering Promotion -> Promotion -> Promotion 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 :: Promotion -> Promotion -> Ordering compare :: Promotion -> Promotion -> Ordering $c< :: Promotion -> Promotion -> Bool < :: Promotion -> Promotion -> Bool $c<= :: Promotion -> Promotion -> Bool <= :: Promotion -> Promotion -> Bool $c> :: Promotion -> Promotion -> Bool > :: Promotion -> Promotion -> Bool $c>= :: Promotion -> Promotion -> Bool >= :: Promotion -> Promotion -> Bool $cmax :: Promotion -> Promotion -> Promotion max :: Promotion -> Promotion -> Promotion $cmin :: Promotion -> Promotion -> Promotion min :: Promotion -> Promotion -> Promotion Ord, Int -> Promotion Promotion -> Int Promotion -> [Promotion] Promotion -> Promotion Promotion -> Promotion -> [Promotion] Promotion -> Promotion -> Promotion -> [Promotion] (Promotion -> Promotion) -> (Promotion -> Promotion) -> (Int -> Promotion) -> (Promotion -> Int) -> (Promotion -> [Promotion]) -> (Promotion -> Promotion -> [Promotion]) -> (Promotion -> Promotion -> [Promotion]) -> (Promotion -> Promotion -> Promotion -> [Promotion]) -> Enum Promotion forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a $csucc :: Promotion -> Promotion succ :: Promotion -> Promotion $cpred :: Promotion -> Promotion pred :: Promotion -> Promotion $ctoEnum :: Int -> Promotion toEnum :: Int -> Promotion $cfromEnum :: Promotion -> Int fromEnum :: Promotion -> Int $cenumFrom :: Promotion -> [Promotion] enumFrom :: Promotion -> [Promotion] $cenumFromThen :: Promotion -> Promotion -> [Promotion] enumFromThen :: Promotion -> Promotion -> [Promotion] $cenumFromTo :: Promotion -> Promotion -> [Promotion] enumFromTo :: Promotion -> Promotion -> [Promotion] $cenumFromThenTo :: Promotion -> Promotion -> Promotion -> [Promotion] enumFromThenTo :: Promotion -> Promotion -> Promotion -> [Promotion] Enum, Eq Promotion Eq Promotion => (Int -> Promotion -> Int) -> (Promotion -> Int) -> Hashable Promotion Int -> Promotion -> Int Promotion -> Int forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a $chashWithSalt :: Int -> Promotion -> Int hashWithSalt :: Int -> Promotion -> Int $chash :: Promotion -> Int hash :: Promotion -> Int Hashable, Ptr Promotion -> IO Promotion Ptr Promotion -> Int -> IO Promotion Ptr Promotion -> Int -> Promotion -> IO () Ptr Promotion -> Promotion -> IO () Promotion -> Int (Promotion -> Int) -> (Promotion -> Int) -> (Ptr Promotion -> Int -> IO Promotion) -> (Ptr Promotion -> Int -> Promotion -> IO ()) -> (forall b. Ptr b -> Int -> IO Promotion) -> (forall b. Ptr b -> Int -> Promotion -> IO ()) -> (Ptr Promotion -> IO Promotion) -> (Ptr Promotion -> Promotion -> IO ()) -> Storable Promotion forall b. Ptr b -> Int -> IO Promotion forall b. Ptr b -> Int -> Promotion -> 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 :: Promotion -> Int sizeOf :: Promotion -> Int $calignment :: Promotion -> Int alignment :: Promotion -> Int $cpeekElemOff :: Ptr Promotion -> Int -> IO Promotion peekElemOff :: Ptr Promotion -> Int -> IO Promotion $cpokeElemOff :: Ptr Promotion -> Int -> Promotion -> IO () pokeElemOff :: Ptr Promotion -> Int -> Promotion -> IO () $cpeekByteOff :: forall b. Ptr b -> Int -> IO Promotion peekByteOff :: forall b. Ptr b -> Int -> IO Promotion $cpokeByteOff :: forall b. Ptr b -> Int -> Promotion -> IO () pokeByteOff :: forall b. Ptr b -> Int -> Promotion -> IO () $cpeek :: Ptr Promotion -> IO Promotion peek :: Ptr Promotion -> IO Promotion $cpoke :: Ptr Promotion -> Promotion -> IO () poke :: Ptr Promotion -> Promotion -> IO () Storable) instance Arbitrary Promotion where arbitrary :: Gen Promotion arbitrary = [Promotion] -> Gen Promotion forall a. HasCallStack => [a] -> Gen a elements [Promotion KnightProm, Promotion BishopProm, Promotion RookProm, Promotion QueenProm] newtype Color = Color Word8 deriving (Color -> Color -> Bool (Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Color -> Color -> Bool == :: Color -> Color -> Bool $c/= :: Color -> Color -> Bool /= :: Color -> Color -> Bool Eq, Eq Color Eq Color => (Color -> Color -> Ordering) -> (Color -> Color -> Bool) -> (Color -> Color -> Bool) -> (Color -> Color -> Bool) -> (Color -> Color -> Bool) -> (Color -> Color -> Color) -> (Color -> Color -> Color) -> Ord Color Color -> Color -> Bool Color -> Color -> Ordering Color -> Color -> Color 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 :: Color -> Color -> Ordering compare :: Color -> Color -> Ordering $c< :: Color -> Color -> Bool < :: Color -> Color -> Bool $c<= :: Color -> Color -> Bool <= :: Color -> Color -> Bool $c> :: Color -> Color -> Bool > :: Color -> Color -> Bool $c>= :: Color -> Color -> Bool >= :: Color -> Color -> Bool $cmax :: Color -> Color -> Color max :: Color -> Color -> Color $cmin :: Color -> Color -> Color min :: Color -> Color -> Color Ord, Int -> Color Color -> Int Color -> [Color] Color -> Color Color -> Color -> [Color] Color -> Color -> Color -> [Color] (Color -> Color) -> (Color -> Color) -> (Int -> Color) -> (Color -> Int) -> (Color -> [Color]) -> (Color -> Color -> [Color]) -> (Color -> Color -> [Color]) -> (Color -> Color -> Color -> [Color]) -> Enum Color forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a $csucc :: Color -> Color succ :: Color -> Color $cpred :: Color -> Color pred :: Color -> Color $ctoEnum :: Int -> Color toEnum :: Int -> Color $cfromEnum :: Color -> Int fromEnum :: Color -> Int $cenumFrom :: Color -> [Color] enumFrom :: Color -> [Color] $cenumFromThen :: Color -> Color -> [Color] enumFromThen :: Color -> Color -> [Color] $cenumFromTo :: Color -> Color -> [Color] enumFromTo :: Color -> Color -> [Color] $cenumFromThenTo :: Color -> Color -> Color -> [Color] enumFromThenTo :: Color -> Color -> Color -> [Color] Enum, Integer -> Color Color -> Color Color -> Color -> Color (Color -> Color -> Color) -> (Color -> Color -> Color) -> (Color -> Color -> Color) -> (Color -> Color) -> (Color -> Color) -> (Color -> Color) -> (Integer -> Color) -> Num Color forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a $c+ :: Color -> Color -> Color + :: Color -> Color -> Color $c- :: Color -> Color -> Color - :: Color -> Color -> Color $c* :: Color -> Color -> Color * :: Color -> Color -> Color $cnegate :: Color -> Color negate :: Color -> Color $cabs :: Color -> Color abs :: Color -> Color $csignum :: Color -> Color signum :: Color -> Color $cfromInteger :: Integer -> Color fromInteger :: Integer -> Color Num, Num Color Ord Color (Num Color, Ord Color) => (Color -> Rational) -> Real Color Color -> Rational forall a. (Num a, Ord a) => (a -> Rational) -> Real a $ctoRational :: Color -> Rational toRational :: Color -> Rational Real, Enum Color Real Color (Real Color, Enum Color) => (Color -> Color -> Color) -> (Color -> Color -> Color) -> (Color -> Color -> Color) -> (Color -> Color -> Color) -> (Color -> Color -> (Color, Color)) -> (Color -> Color -> (Color, Color)) -> (Color -> Integer) -> Integral Color Color -> Integer Color -> Color -> (Color, Color) Color -> Color -> Color forall a. (Real a, Enum a) => (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> (a, a)) -> (a -> a -> (a, a)) -> (a -> Integer) -> Integral a $cquot :: Color -> Color -> Color quot :: Color -> Color -> Color $crem :: Color -> Color -> Color rem :: Color -> Color -> Color $cdiv :: Color -> Color -> Color div :: Color -> Color -> Color $cmod :: Color -> Color -> Color mod :: Color -> Color -> Color $cquotRem :: Color -> Color -> (Color, Color) quotRem :: Color -> Color -> (Color, Color) $cdivMod :: Color -> Color -> (Color, Color) divMod :: Color -> Color -> (Color, Color) $ctoInteger :: Color -> Integer toInteger :: Color -> Integer Integral) data CastlingRights = KingSide | QueenSide bestPromotions :: Set Promotion bestPromotions :: Set Promotion bestPromotions = [Promotion] -> Set Promotion forall a. Ord a => [a] -> Set a Set.fromList [Promotion NoProm, Promotion QueenProm] {-# COMPLETE Pawn, Knight, Bishop, Rook, Queen, King #-} pattern Pawn, Knight, Bishop, Rook, Queen, King :: Piece pattern $mPawn :: forall {r}. Piece -> ((# #) -> r) -> ((# #) -> r) -> r $bPawn :: Piece Pawn = Piece 0 pattern $mKnight :: forall {r}. Piece -> ((# #) -> r) -> ((# #) -> r) -> r $bKnight :: Piece Knight = Piece 1 pattern $mBishop :: forall {r}. Piece -> ((# #) -> r) -> ((# #) -> r) -> r $bBishop :: Piece Bishop = Piece 2 pattern $mRook :: forall {r}. Piece -> ((# #) -> r) -> ((# #) -> r) -> r $bRook :: Piece Rook = Piece 3 pattern $mQueen :: forall {r}. Piece -> ((# #) -> r) -> ((# #) -> r) -> r $bQueen :: Piece Queen = Piece 4 pattern $mKing :: forall {r}. Piece -> ((# #) -> r) -> ((# #) -> r) -> r $bKing :: Piece King = Piece 5 {-# COMPLETE NoProm, KnightProm, BishopProm, RookProm, QueenProm #-} pattern NoProm, KnightProm, BishopProm, RookProm, QueenProm :: Promotion pattern $mNoProm :: forall {r}. Promotion -> ((# #) -> r) -> ((# #) -> r) -> r $bNoProm :: Promotion NoProm = Promotion 0 pattern $mKnightProm :: forall {r}. Promotion -> ((# #) -> r) -> ((# #) -> r) -> r $bKnightProm :: Promotion KnightProm = Promotion 1 pattern $mBishopProm :: forall {r}. Promotion -> ((# #) -> r) -> ((# #) -> r) -> r $bBishopProm :: Promotion BishopProm = Promotion 2 pattern $mRookProm :: forall {r}. Promotion -> ((# #) -> r) -> ((# #) -> r) -> r $bRookProm :: Promotion RookProm = Promotion 3 pattern $mQueenProm :: forall {r}. Promotion -> ((# #) -> r) -> ((# #) -> r) -> r $bQueenProm :: Promotion QueenProm = Promotion 4 {-# COMPLETE White, Black #-} pattern White, Black :: Color pattern $mWhite :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r $bWhite :: Color White = Color 0 pattern $mBlack :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r $bBlack :: Color Black = Color 1 getPieceValue :: Piece -> Word8 getPieceValue :: Piece -> Word8 getPieceValue (Piece Word8 n) = Word8 n reverseColor :: Color -> Color reverseColor :: Color -> Color reverseColor (Color Word8 color) = Word8 -> Color Color (Word8 1 Word8 -> Word8 -> Word8 forall a. Num a => a -> a -> a - Word8 color) pieceToChar :: (Piece, Color) -> Char pieceToChar :: (Piece, Color) -> Char pieceToChar (Piece piece, Color color) = case Color color of Color White -> Char -> Char Char.toUpper Char char Color Black -> Char char where char :: Char char = case Piece piece of Piece Pawn -> Char 'p' Piece Knight -> Char 'n' Piece Bishop -> Char 'b' Piece Rook -> Char 'r' Piece Queen -> Char 'q' Piece King -> Char 'k' charToPiece :: Char -> Maybe (Piece, Color) charToPiece :: Char -> Maybe (Piece, Color) charToPiece Char char = (,Color color) (Piece -> (Piece, Color)) -> Maybe Piece -> Maybe (Piece, Color) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe Piece piece where color :: Color color | Char -> Bool isUpper Char char = Color White | Bool otherwise = Color Black piece :: Maybe Piece piece = case Char -> Char Char.toLower Char char of Char 'p' -> Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Pawn Char 'n' -> Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Knight Char 'b' -> Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Bishop Char 'r' -> Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Rook Char 'q' -> Piece -> Maybe Piece forall a. a -> Maybe a Just Piece Queen Char 'k' -> Piece -> Maybe Piece forall a. a -> Maybe a Just Piece King Char _ -> Maybe Piece forall a. Maybe a Nothing charToColor :: Char -> Maybe Color charToColor :: Char -> Maybe Color charToColor Char char = case Char char of Char 'w' -> Color -> Maybe Color forall a. a -> Maybe a Just Color White Char 'b' -> Color -> Maybe Color forall a. a -> Maybe a Just Color Black Char _ -> Maybe Color forall a. Maybe a Nothing charToCastlingRights :: Char -> Maybe (CastlingRights, Color) charToCastlingRights :: Char -> Maybe (CastlingRights, Color) charToCastlingRights Char char = (,Color color) (CastlingRights -> (CastlingRights, Color)) -> Maybe CastlingRights -> Maybe (CastlingRights, Color) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe CastlingRights piece where color :: Color color | Char -> Bool isUpper Char char = Color White | Bool otherwise = Color Black piece :: Maybe CastlingRights piece = case Char -> Char Char.toLower Char char of Char 'k' -> CastlingRights -> Maybe CastlingRights forall a. a -> Maybe a Just CastlingRights KingSide Char 'q' -> CastlingRights -> Maybe CastlingRights forall a. a -> Maybe a Just CastlingRights QueenSide Char _ -> Maybe CastlingRights forall a. Maybe a Nothing instance Show Piece where show :: Piece -> String show = \case Piece Pawn -> String "Pawn" Piece Knight -> String "Knight" Piece Bishop -> String "Bishop" Piece Rook -> String "Rook" Piece Queen -> String "Queen" Piece King -> String "King" instance Show Promotion where show :: Promotion -> String show = \case Promotion NoProm -> String forall a. Monoid a => a mempty Promotion KnightProm -> String "n" Promotion BishopProm -> String "b" Promotion RookProm -> String "r" Promotion QueenProm -> String "q" instance Show Color where show :: Color -> String show = \case Color White -> String "White" Color Black -> String "Black"