module BishBosh.Component.Turn(
Turn(
getQualifiedMove,
getRank,
getIsRepeatableMove
),
compareByLVA,
compareByMVVLVA,
mkTurn,
isCapture,
isPawnDoubleAdvance
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Data.Ord
data Turn x y = MkTurn {
getQualifiedMove :: Component.QualifiedMove.QualifiedMove x y,
getRank :: Attribute.Rank.Rank,
getIsRepeatableMove :: Bool
}
instance (Eq x, Eq y) => Eq (Turn x y) where
MkTurn {
getQualifiedMove = qualifiedMove,
getRank = rank
} == MkTurn {
getQualifiedMove = qualifiedMove',
getRank = rank'
} = (qualifiedMove, rank) == (qualifiedMove', rank')
instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Turn x y) where
rnf MkTurn {
getQualifiedMove = qualifiedMove,
getRank = rank,
getIsRepeatableMove = isRepeatableMove
} = Control.DeepSeq.rnf (qualifiedMove, rank, isRepeatableMove)
instance (Show x, Show y) => Show (Turn x y) where
showsPrec _ MkTurn {
getQualifiedMove = qualifiedMove,
getRank = rank
} = shows (
qualifiedMove,
rank
)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Read x,
Read y
) => Read (Turn x y) where
readsPrec _ = map (Control.Arrow.first $ uncurry mkTurn) . reads
instance Enum y => Property.Reflectable.ReflectableOnX (Turn x y) where
reflectOnX turn@MkTurn { getQualifiedMove = qualifiedMove } = turn { getQualifiedMove = Property.Reflectable.reflectOnX qualifiedMove }
mkTurn
:: Component.QualifiedMove.QualifiedMove x y
-> Attribute.Rank.Rank
-> Turn x y
mkTurn qualifiedMove rank = MkTurn {
getQualifiedMove = qualifiedMove,
getRank = rank,
getIsRepeatableMove = rank /= Attribute.Rank.Pawn && not (
Attribute.MoveType.isAcyclic $ Component.QualifiedMove.getMoveType qualifiedMove
)
}
isCapture :: Turn x y -> Bool
isCapture MkTurn { getQualifiedMove = qualifiedMove } = Attribute.MoveType.isCapture $ Component.QualifiedMove.getMoveType qualifiedMove
isPawnDoubleAdvance :: (
Enum x,
Enum y,
Eq y
)
=> Attribute.LogicalColour.LogicalColour
-> Turn x y
-> Bool
isPawnDoubleAdvance logicalColour MkTurn {
getRank = Attribute.Rank.Pawn,
getQualifiedMove = qualifiedMove
} = Component.Move.isPawnDoubleAdvance logicalColour (Component.QualifiedMove.getMove qualifiedMove) && Component.QualifiedMove.getMoveType qualifiedMove == Data.Default.def
isPawnDoubleAdvance _ _ = False
compareByLVA
:: Ord rankValue
=> Attribute.Rank.EvaluateRank rankValue
-> Turn x y
-> Turn x y
-> Ordering
compareByLVA evaluateRank MkTurn { getRank = rankL } MkTurn { getRank = rankR } = Attribute.Rank.compareByLVA evaluateRank rankL rankR
compareByMVVLVA
:: Ord rankValue
=> Attribute.Rank.EvaluateRank rankValue
-> Turn x y
-> Turn x y
-> Ordering
compareByMVVLVA evaluateRank turnL@MkTurn {
getQualifiedMove = qualifiedMoveL
} turnR@MkTurn {
getQualifiedMove = qualifiedMoveR
} = case ($ qualifiedMoveL) &&& ($ qualifiedMoveR) $ Attribute.MoveType.getMaybeImplicitlyTakenRank . Component.QualifiedMove.getMoveType of
(Nothing, Nothing) -> EQ
(Nothing, _) -> GT
(_, Nothing) -> LT
(Just rankL, Just rankR)
| rankL == rankR -> lvaComparison
| otherwise -> case Data.Ord.comparing evaluateRank rankR rankL of
EQ -> lvaComparison
ordering -> ordering
where
lvaComparison = compareByLVA evaluateRank turnL turnR