module BishBosh.Attribute.MoveType(
MoveType(
Castle,
EnPassant
),
tag,
shortCastle,
longCastle,
enPassant,
nPiecesMutator,
mkMaybeNormalMoveType,
mkNormalMoveType,
isCastle,
isEnPassant,
isCapture,
isPromotion,
isQuiet,
isSimple,
isAcyclic,
getMaybeExplicitlyTakenRank,
getMaybeImplicitlyTakenRank,
getMaybePromotedRank
) where
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Default
import qualified Data.List.Extra
import qualified Data.Maybe
tag :: String
tag :: String
tag = String
"moveType"
type IsShort = Bool
shortCastle :: MoveType
shortCastle :: MoveType
shortCastle = IsShort -> MoveType
Castle IsShort
True
longCastle :: MoveType
longCastle :: MoveType
longCastle = IsShort -> MoveType
Castle IsShort
False
enPassant :: MoveType
enPassant :: MoveType
enPassant = MoveType
EnPassant
data MoveType
= Castle IsShort
| EnPassant
| Normal {
MoveType -> Maybe Rank
getMaybeTakenRank :: Maybe Attribute.Rank.Rank,
MoveType -> Maybe Rank
getMaybePromotionRank :: Maybe Attribute.Rank.Rank
}
deriving MoveType -> MoveType -> IsShort
(MoveType -> MoveType -> IsShort)
-> (MoveType -> MoveType -> IsShort) -> Eq MoveType
forall a. (a -> a -> IsShort) -> (a -> a -> IsShort) -> Eq a
/= :: MoveType -> MoveType -> IsShort
$c/= :: MoveType -> MoveType -> IsShort
== :: MoveType -> MoveType -> IsShort
$c== :: MoveType -> MoveType -> IsShort
Eq
instance Show MoveType where
showsPrec :: Int -> MoveType -> ShowS
showsPrec Int
_ (Castle IsShort
isShort) = String -> ShowS
showString String
"Castle (short" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsShort -> ShowS
forall a. Show a => a -> ShowS
shows IsShort
isShort ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
showsPrec Int
_ MoveType
EnPassant = String -> ShowS
showString String
"En-passant"
showsPrec Int
_ Normal {
getMaybeTakenRank :: MoveType -> Maybe Rank
getMaybeTakenRank = Maybe Rank
maybeTakenRank,
getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ [Maybe (String, ShowS)] -> [(String, ShowS)]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes [
(Rank -> (String, ShowS)) -> Maybe Rank -> Maybe (String, ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) String
"takenRank" (ShowS -> (String, ShowS))
-> (Rank -> ShowS) -> Rank -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> ShowS
forall a. Show a => a -> ShowS
shows) Maybe Rank
maybeTakenRank,
(Rank -> (String, ShowS)) -> Maybe Rank -> Maybe (String, ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) String
"promotionRank" (ShowS -> (String, ShowS))
-> (Rank -> ShowS) -> Rank -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> ShowS
forall a. Show a => a -> ShowS
shows) Maybe Rank
maybePromotionRank
]
instance Read MoveType where
readsPrec :: Int -> ReadS MoveType
readsPrec Int
_ String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
'C' : Char
'a' : Char
's' : Char
't' : Char
'l' : Char
'e' : String
s1 -> [
(IsShort -> MoveType
Castle IsShort
isShort, String
remainder) |
(String
"(", String
s2) <- ReadS String
lex String
s1,
(String
"short", String
s3) <- ReadS String
lex String
s2,
(String
"=", String
s4) <- ReadS String
lex String
s3,
(IsShort
isShort, String
s5) <- ReadS IsShort
forall a. Read a => ReadS a
reads String
s4,
(String
")", String
remainder) <- ReadS String
lex String
s5
]
Char
'E' : Char
'n' : Char
'-' : Char
'p' : Char
'a' : Char
's' : Char
's' : Char
'a' : Char
'n' : Char
't' : String
remainder -> [(MoveType
EnPassant, String
remainder)]
String
_ -> [
(MoveType
normalMoveType, String
remainder) |
(String
"{", String
s1) <- ReadS String
lex String
s,
(Maybe Rank
maybeTakenRank, String
s2) <- case [
(Rank, String)
pair |
(String
"takenRank", String
s11) <- ReadS String
lex String
s1,
(String
"=", String
s12) <- ReadS String
lex String
s11,
(Rank, String)
pair <- ReadS Rank
forall a. Read a => ReadS a
reads String
s12
] of
[] -> [(Maybe Rank
forall a. Maybe a
Nothing, String
s1)]
[(Rank, String)]
parsed -> ((Rank, String) -> (Maybe Rank, String))
-> [(Rank, String)] -> [(Maybe Rank, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rank -> Maybe Rank) -> (Rank, String) -> (Maybe Rank, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first Rank -> Maybe Rank
forall a. a -> Maybe a
Just) [(Rank, String)]
parsed,
String
s3 <- String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ case ReadS String
lex String
s2 of
[(String
",", String
s21)] -> String
s21
[(String, String)]
_ -> String
s2,
(Maybe Rank
maybePromotionRank, String
s4) <- case [
(Rank, String)
pair |
(String
"promotionRank", String
s31) <- ReadS String
lex String
s3,
(String
"=", String
s32) <- ReadS String
lex String
s31,
(Rank, String)
pair <- ReadS Rank
forall a. Read a => ReadS a
reads String
s32
] of
[] -> [(Maybe Rank
forall a. Maybe a
Nothing, String
s3)]
[(Rank, String)]
parsed -> ((Rank, String) -> (Maybe Rank, String))
-> [(Rank, String)] -> [(Maybe Rank, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rank -> Maybe Rank) -> (Rank, String) -> (Maybe Rank, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first Rank -> Maybe Rank
forall a. a -> Maybe a
Just) [(Rank, String)]
parsed,
(String
"}", String
remainder) <- ReadS String
lex String
s4,
MoveType
normalMoveType <- Maybe MoveType -> [MoveType]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe MoveType -> [MoveType]) -> Maybe MoveType -> [MoveType]
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> Maybe MoveType
mkMaybeNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank
]
instance Control.DeepSeq.NFData MoveType where
rnf :: MoveType -> ()
rnf (Castle IsShort
isShort) = IsShort -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf IsShort
isShort
rnf MoveType
EnPassant = ()
rnf Normal {
getMaybeTakenRank :: MoveType -> Maybe Rank
getMaybeTakenRank = Maybe Rank
maybeTakenRank,
getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
} = (Maybe Rank, Maybe Rank) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Maybe Rank
maybeTakenRank, Maybe Rank
maybePromotionRank)
instance Data.Default.Default MoveType where
def :: MoveType
def = Normal :: Maybe Rank -> Maybe Rank -> MoveType
Normal {
getMaybeTakenRank :: Maybe Rank
getMaybeTakenRank = Maybe Rank
forall a. Maybe a
Nothing,
getMaybePromotionRank :: Maybe Rank
getMaybePromotionRank = Maybe Rank
forall a. Maybe a
Nothing
}
instance Attribute.Rank.Promotable MoveType where
getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank Normal { getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank } = Maybe Rank
maybePromotionRank
getMaybePromotionRank MoveType
_ = Maybe Rank
forall a. Maybe a
Nothing
instance Property.FixedMembership.FixedMembership MoveType where
members :: [MoveType]
members = MoveType
EnPassant MoveType -> [MoveType] -> [MoveType]
forall a. a -> [a] -> [a]
: (IsShort -> MoveType) -> [IsShort] -> [MoveType]
forall a b. (a -> b) -> [a] -> [b]
map IsShort -> MoveType
Castle [IsShort]
forall a. FixedMembership a => [a]
Property.FixedMembership.members [MoveType] -> [MoveType] -> [MoveType]
forall a. [a] -> [a] -> [a]
++ [
Normal :: Maybe Rank -> Maybe Rank -> MoveType
Normal {
getMaybeTakenRank :: Maybe Rank
getMaybeTakenRank = Maybe Rank
maybeTakenRank,
getMaybePromotionRank :: Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
} |
Maybe Rank
maybeTakenRank <- Maybe Rank
forall a. Maybe a
Nothing Maybe Rank -> [Maybe Rank] -> [Maybe Rank]
forall a. a -> [a] -> [a]
: (Rank -> Maybe Rank) -> [Rank] -> [Maybe Rank]
forall a b. (a -> b) -> [a] -> [b]
map Rank -> Maybe Rank
forall a. a -> Maybe a
Just [Rank]
Attribute.Rank.expendable,
Maybe Rank
maybePromotionRank <- Maybe Rank
forall a. Maybe a
Nothing Maybe Rank -> [Maybe Rank] -> [Maybe Rank]
forall a. a -> [a] -> [a]
: (Rank -> Maybe Rank) -> [Rank] -> [Maybe Rank]
forall a b. (a -> b) -> [a] -> [b]
map Rank -> Maybe Rank
forall a. a -> Maybe a
Just [Rank]
Attribute.Rank.promotionProspects
]
mkMaybeNormalMoveType
:: Maybe Attribute.Rank.Rank
-> Maybe Attribute.Rank.Rank
-> Maybe MoveType
mkMaybeNormalMoveType :: Maybe Rank -> Maybe Rank -> Maybe MoveType
mkMaybeNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank
| Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> IsShort
forall a. Eq a => a -> a -> IsShort
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King
, IsShort -> (Rank -> IsShort) -> Maybe Rank -> IsShort
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsShort
True (
Rank -> [Rank] -> IsShort
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsShort
`elem` [Rank]
Attribute.Rank.promotionProspects
) Maybe Rank
maybePromotionRank = MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just Normal :: Maybe Rank -> Maybe Rank -> MoveType
Normal {
getMaybeTakenRank :: Maybe Rank
getMaybeTakenRank = Maybe Rank
maybeTakenRank,
getMaybePromotionRank :: Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
}
| IsShort
otherwise = Maybe MoveType
forall a. Maybe a
Nothing
mkNormalMoveType
:: Maybe Attribute.Rank.Rank
-> Maybe Attribute.Rank.Rank
-> MoveType
mkNormalMoveType :: Maybe Rank -> Maybe Rank -> MoveType
mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank = IsShort -> MoveType -> MoveType
forall a. (?callStack::CallStack) => IsShort -> a -> a
Control.Exception.assert (
Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> IsShort
forall a. Eq a => a -> a -> IsShort
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King IsShort -> IsShort -> IsShort
&& IsShort -> (Rank -> IsShort) -> Maybe Rank -> IsShort
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsShort
True (
Rank -> [Rank] -> IsShort
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsShort
`elem` [Rank]
Attribute.Rank.promotionProspects
) Maybe Rank
maybePromotionRank
) Normal :: Maybe Rank -> Maybe Rank -> MoveType
Normal {
getMaybeTakenRank :: Maybe Rank
getMaybeTakenRank = Maybe Rank
maybeTakenRank,
getMaybePromotionRank :: Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
}
isCastle :: MoveType -> Bool
isCastle :: MoveType -> IsShort
isCastle (Castle IsShort
_) = IsShort
True
isCastle MoveType
_ = IsShort
False
isEnPassant :: MoveType -> Bool
isEnPassant :: MoveType -> IsShort
isEnPassant MoveType
EnPassant = IsShort
True
isEnPassant MoveType
_ = IsShort
False
isCapture :: MoveType -> Bool
{-# INLINE isCapture #-}
isCapture :: MoveType -> IsShort
isCapture Normal { getMaybeTakenRank :: MoveType -> Maybe Rank
getMaybeTakenRank = Just Rank
_ } = IsShort
True
isCapture MoveType
moveType = MoveType -> IsShort
isEnPassant MoveType
moveType
isPromotion :: MoveType -> Bool
isPromotion :: MoveType -> IsShort
isPromotion = Maybe Rank -> IsShort
forall a. Maybe a -> IsShort
Data.Maybe.isJust (Maybe Rank -> IsShort)
-> (MoveType -> Maybe Rank) -> MoveType -> IsShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveType -> Maybe Rank
getMaybePromotedRank
isQuiet :: MoveType -> Bool
isQuiet :: MoveType -> IsShort
isQuiet Normal {
getMaybeTakenRank :: MoveType -> Maybe Rank
getMaybeTakenRank = Maybe Rank
Nothing,
getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank = Maybe Rank
Nothing
} = IsShort
True
isQuiet MoveType
moveType = MoveType -> IsShort
isCastle MoveType
moveType
isSimple :: MoveType -> Bool
isSimple :: MoveType -> IsShort
isSimple Normal {
getMaybeTakenRank :: MoveType -> Maybe Rank
getMaybeTakenRank = Maybe Rank
Nothing,
getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank = Maybe Rank
Nothing
} = IsShort
True
isSimple MoveType
_ = IsShort
False
isAcyclic :: MoveType -> Bool
isAcyclic :: MoveType -> IsShort
isAcyclic = IsShort -> IsShort
not (IsShort -> IsShort)
-> (MoveType -> IsShort) -> MoveType -> IsShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveType -> IsShort
isSimple
getMaybeExplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeExplicitlyTakenRank :: MoveType -> Maybe Rank
getMaybeExplicitlyTakenRank Normal { getMaybeTakenRank :: MoveType -> Maybe Rank
getMaybeTakenRank = Maybe Rank
maybeTakenRank } = Maybe Rank
maybeTakenRank
getMaybeExplicitlyTakenRank MoveType
_ = Maybe Rank
forall a. Maybe a
Nothing
getMaybeImplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeImplicitlyTakenRank :: MoveType -> Maybe Rank
getMaybeImplicitlyTakenRank MoveType
EnPassant = Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.Pawn
getMaybeImplicitlyTakenRank MoveType
moveType = MoveType -> Maybe Rank
getMaybeExplicitlyTakenRank MoveType
moveType
getMaybePromotedRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybePromotedRank :: MoveType -> Maybe Rank
getMaybePromotedRank Normal { getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank } = Maybe Rank
maybePromotionRank
getMaybePromotedRank MoveType
_ = Maybe Rank
forall a. Maybe a
Nothing
nPiecesMutator :: Enum nPieces => MoveType -> (nPieces -> nPieces)
{-# INLINE nPiecesMutator #-}
nPiecesMutator :: MoveType -> nPieces -> nPieces
nPiecesMutator MoveType
moveType
| MoveType -> IsShort
isCapture MoveType
moveType = nPieces -> nPieces
forall a. Enum a => a -> a
pred
| IsShort
otherwise = nPieces -> nPieces
forall a. a -> a
id