{-
Copyright (C) 2018 Dr. Alistair Ward
This file is part of BishBosh.
BishBosh is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
BishBosh is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with BishBosh. If not, see .
-}
{- |
[@AUTHOR@] Dr. Alistair Ward
[@DESCRIPTION@] Categorises /move/s, & provides ancillary information as required.
-}
module BishBosh.Attribute.MoveType(
-- * Types
-- ** Type-synonyms
-- IsShort,
-- ** Data-types
MoveType(
Castle,
EnPassant
-- Normal
),
-- * Constants
tag,
shortCastle,
longCastle,
enPassant,
-- * Functions
nPiecesMutator,
apply,
-- ** Constructors
mkMaybeNormalMoveType,
mkNormalMoveType,
-- ** Predicates
isCastle,
isEnPassant,
isCapture,
isPromotion,
isQuiet,
isSimple,
isAcyclic,
-- ** Query
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
-- | Used to qualify output.
tag :: String
tag = "moveType"
-- | Self-documentation.
type IsShort = Bool
-- | Constant value required to denote a /short castle/.
shortCastle :: MoveType
shortCastle = Castle True
-- | Constant value required to denote a /long castle/.
longCastle :: MoveType
longCastle = Castle False
-- | Constant.
enPassant :: MoveType
enPassant = EnPassant
-- | The sum-type of distinct types of /move/.
data MoveType
= Castle IsShort -- ^ Castling between the @King@ & one of its @Rook@s.
| EnPassant -- ^ Capture by a @Pawn@ of a @Pawn@ as it advanced two squares.
| Normal {
getMaybeTakenRank :: Maybe Attribute.Rank.Rank,
getMaybePromotionRank :: Maybe Attribute.Rank.Rank
} -- ^ The /rank/ of any opposing /piece/ which was just taken & the /rank/ of any /piece/ to which a @Pawn@ was just promoted.
deriving Eq
instance Show MoveType where
showsPrec _ (Castle isShort) = showString "Castle (short" . Text.ShowList.showsAssociation . shows isShort . showChar ')'
showsPrec _ EnPassant = showString "En-passant"
showsPrec _ Normal {
getMaybeTakenRank = maybeTakenRank,
getMaybePromotionRank = maybePromotionRank
} = Text.ShowList.showsAssociationList' $ Data.Maybe.catMaybes [
fmap ((,) "takenRank" . shows) maybeTakenRank,
fmap ((,) "promotionRank" . shows) maybePromotionRank
]
instance Read MoveType where
readsPrec _ s = case Data.List.Extra.trimStart s of
'C' : 'a' : 's' : 't' : 'l' : 'e' : s1 -> [
(Castle isShort, remainder) |
("(", s2) <- lex s1,
("short", s3) <- lex s2,
("=", s4) <- lex s3,
(isShort, s5) <- reads s4,
(")", remainder) <- lex s5
] -- List-comprehension.
'E' : 'n' : '-' : 'p' : 'a' : 's' : 's' : 'a' : 'n' : 't' : remainder -> [(EnPassant, remainder)]
_ -> [
(normalMoveType, remainder) |
("{", s1) <- lex s,
(maybeTakenRank, s2) <- case [
pair |
("takenRank", s11) <- lex s1,
("=", s12) <- lex s11,
pair <- reads s12
] of
[] -> [(Nothing, s1)] -- Infer that nothing was taken.
parsed -> map (Control.Arrow.first Just) parsed,
s3 <- return $ case lex s2 of
[(",", s21)] -> s21
_ -> s2,
(maybePromotionRank, s4) <- case [
pair |
("promotionRank", s31) <- lex s3,
("=", s32) <- lex s31,
pair <- reads s32
] of
[] -> [(Nothing, s3)] -- Infer that there was no promotion.
parsed -> map (Control.Arrow.first Just) parsed,
("}", remainder) <- lex s4,
normalMoveType <- Data.Maybe.maybeToList $ mkMaybeNormalMoveType maybeTakenRank maybePromotionRank
] -- List-comprehension.
instance Control.DeepSeq.NFData MoveType where
rnf (Castle isShort) = Control.DeepSeq.rnf isShort
rnf EnPassant = ()
rnf Normal {
getMaybeTakenRank = maybeTakenRank,
getMaybePromotionRank = maybePromotionRank
} = Control.DeepSeq.rnf (maybeTakenRank, maybePromotionRank)
instance Data.Default.Default MoveType where
def = Normal {
getMaybeTakenRank = Nothing,
getMaybePromotionRank = Nothing
}
instance Attribute.Rank.Promotable MoveType where
getMaybePromotionRank Normal { getMaybePromotionRank = maybePromotionRank } = maybePromotionRank
getMaybePromotionRank _ = Nothing
instance Property.FixedMembership.FixedMembership MoveType where
members = EnPassant : map Castle Property.FixedMembership.members ++ [
Normal {
getMaybeTakenRank = maybeTakenRank,
getMaybePromotionRank = maybePromotionRank
} |
maybeTakenRank <- Nothing : map Just Attribute.Rank.expendable,
maybePromotionRank <- Nothing : map Just Attribute.Rank.promotionProspects
] -- List-comprehension.
-- | Smart constructor for normal move-types.
mkMaybeNormalMoveType
:: Maybe Attribute.Rank.Rank -- ^ The /rank/ of any opposing /piece/ which was just taken.
-> Maybe Attribute.Rank.Rank -- ^ The /rank/ to which a @Pawn@ was just promoted.
-> Maybe MoveType -- ^ Maybe the required /move-type/.
mkMaybeNormalMoveType maybeTakenRank maybePromotionRank
| maybeTakenRank /= Just Attribute.Rank.King
, Data.Maybe.maybe True {-nothing promoted-} (
`elem` Attribute.Rank.promotionProspects
) maybePromotionRank = Just Normal {
getMaybeTakenRank = maybeTakenRank,
getMaybePromotionRank = maybePromotionRank
}
| otherwise = Nothing
-- | Smart-constructor for normal move-types.
mkNormalMoveType
:: Maybe Attribute.Rank.Rank -- ^ The /rank/ of any opposing /piece/ which is to be taken.
-> Maybe Attribute.Rank.Rank -- ^ The /rank/ to which a @Pawn@ is to be promoted.
-> MoveType
mkNormalMoveType maybeTakenRank maybePromotionRank = Control.Exception.assert (
maybeTakenRank /= Just Attribute.Rank.King && Data.Maybe.maybe True {-nothing promoted-} (
`elem` Attribute.Rank.promotionProspects
) maybePromotionRank
) Normal {
getMaybeTakenRank = maybeTakenRank,
getMaybePromotionRank = maybePromotionRank
}
-- | Predicate.
isCastle :: MoveType -> Bool
isCastle (Castle _) = True
isCastle _ = False
-- | Predicate.
isEnPassant :: MoveType -> Bool
isEnPassant EnPassant = True
isEnPassant _ = False
-- | Whether a piece was captured, including @Pawn@s taken En-passant.
isCapture :: MoveType -> Bool
{-# INLINE isCapture #-}
isCapture Normal { getMaybeTakenRank = Just _ } = True
isCapture moveType = isEnPassant moveType
-- | Whether the /move/ includes @Pawn@-promotion.
isPromotion :: MoveType -> Bool
isPromotion = Data.Maybe.isJust . getMaybePromotedRank
-- | .
isQuiet :: MoveType -> Bool
isQuiet Normal {
getMaybeTakenRank = Nothing,
getMaybePromotionRank = Nothing
} = True
isQuiet moveType = isCastle moveType
-- | The simplest type of move.
isSimple :: MoveType -> Bool
isSimple Normal {
getMaybeTakenRank = Nothing,
getMaybePromotionRank = Nothing
} = True
isSimple _ = False -- Neither Castling nor En-passant qualifies.
{- |
* Whether the /move/ can't be a member of a repeated cycle.
* CAVEAT: one can't infer from a negative result that the move can be repeated, since the mover may have been a @Pawn@.
-}
isAcyclic :: MoveType -> Bool
isAcyclic = not . isSimple -- Neither capture, promotion, castling nor en-passant can be repeated.
-- | Query whether a /piece/ was explicitly taken, excluding @Pawn@s taken En-passant.
getMaybeExplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeExplicitlyTakenRank Normal { getMaybeTakenRank = maybeTakenRank } = maybeTakenRank
getMaybeExplicitlyTakenRank _ = Nothing
-- | Query whether a /piece/ was taken either explicitly, or implicitly during En-passant.
getMaybeImplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeImplicitlyTakenRank EnPassant = Just Attribute.Rank.Pawn
getMaybeImplicitlyTakenRank moveType = getMaybeExplicitlyTakenRank moveType
-- | Query the rank to which a piece was promoted.
getMaybePromotedRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybePromotedRank Normal { getMaybePromotionRank = maybePromotionRank } = maybePromotionRank
getMaybePromotedRank _ = Nothing
-- | Returns the mutator required to adjust the number of pieces after a move.
nPiecesMutator :: Enum nPieces => MoveType -> (nPieces -> nPieces)
{-# INLINE nPiecesMutator #-}
nPiecesMutator moveType
| isCapture moveType = pred
| otherwise = id
-- | Permit the caller to react in an arbitrary way, according to a specific move-type.
apply
:: (
IsShort -> a, -- Castle.
a, -- En-passant
(
Maybe Attribute.Rank.Rank {-captured-},
Maybe Attribute.Rank.Rank {-promotion-}
) -> a
) -- ^ The handlers for each move-type; Castle, En-passant & Normal.
-> MoveType
-> a
apply (onCastle, _, _) (Castle isShort) = onCastle isShort
apply (_, onEnPassant, _) EnPassant = onEnPassant
apply (_, _, onNormal) Normal {
getMaybeTakenRank = maybeTakenRank,
getMaybePromotionRank = maybePromotionRank
} = onNormal (maybeTakenRank, maybePromotionRank)