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