module BishBosh.Attribute.MoveType(
MoveType(
Castle,
EnPassant,
Normal
),
tag,
shortCastle,
longCastle,
enPassant,
nPiecesMutator,
mkMaybeNormalMoveType,
mkNormalMoveType,
isCastle,
isEnPassant,
isCapture,
isPromotion,
isQuiet,
isAcyclic,
getMaybeExplicitlyTakenRank,
getMaybeImplicitlyTakenRank
) where
import qualified BishBosh.Attribute.Rank as Attribute.Rank
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 Maybe Rank
maybeTakenRank 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 (Normal Maybe Rank
t Maybe Rank
p) = (Maybe Rank, Maybe Rank) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Maybe Rank
t, Maybe Rank
p)
rnf MoveType
_ = ()
instance Data.Default.Default MoveType where
def :: MoveType
def = Maybe Rank -> Maybe Rank -> MoveType
Normal Maybe Rank
forall a. Maybe a
Nothing Maybe Rank
forall a. Maybe a
Nothing
instance Attribute.Rank.Promotable MoveType where
getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank (Normal Maybe Rank
_ Maybe Rank
maybePromotionRank) = Maybe Rank
maybePromotionRank
getMaybePromotionRank MoveType
_ = Maybe Rank
forall a. Maybe a
Nothing
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 (MoveType -> Maybe MoveType) -> MoveType -> Maybe MoveType
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Normal Maybe Rank
maybeTakenRank 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
) (MoveType -> MoveType) -> MoveType -> MoveType
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Normal Maybe Rank
maybeTakenRank 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
isNormal :: MoveType -> Bool
isNormal :: MoveType -> IsShort
isNormal (Normal Maybe Rank
_ Maybe Rank
_) = IsShort
True
isNormal MoveType
_ = IsShort
False
isCapture :: MoveType -> Bool
{-# INLINE isCapture #-}
isCapture :: MoveType -> IsShort
isCapture (Normal (Just Rank
_) Maybe Rank
_) = IsShort
True
isCapture MoveType
moveType = MoveType -> IsShort
isEnPassant MoveType
moveType
isPromotion :: MoveType -> Bool
isPromotion :: MoveType -> IsShort
isPromotion (Normal Maybe Rank
_ (Just Rank
_)) = IsShort
True
isPromotion MoveType
_ = IsShort
False
isQuiet :: MoveType -> Bool
isQuiet :: MoveType -> IsShort
isQuiet (Normal Maybe Rank
Nothing Maybe Rank
Nothing) = IsShort
True
isQuiet MoveType
moveType = MoveType -> IsShort
isCastle MoveType
moveType
isAcyclic :: MoveType -> Bool
isAcyclic :: MoveType -> IsShort
isAcyclic (Normal Maybe Rank
Nothing Maybe Rank
Nothing) = IsShort
False
isAcyclic MoveType
_ = IsShort
True
getMaybeExplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeExplicitlyTakenRank :: MoveType -> Maybe Rank
getMaybeExplicitlyTakenRank (Normal Maybe Rank
maybeTakenRank Maybe Rank
_) = 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
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