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
precedence 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
} = Int -> (QualifiedMove x y, Rank) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence (
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
precedence = (((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
. Int -> String -> [((QualifiedMove x y, Rank), String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence
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
:: Attribute.Rank.EvaluateRank
-> Turn x y
-> Turn x y
-> Ordering
compareByLVA :: EvaluateRank -> Turn x y -> Turn x y -> Ordering
compareByLVA EvaluateRank
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 -> Rank -> Rank -> Ordering
Attribute.Rank.compareByLVA EvaluateRank
evaluateRank Rank
rankL Rank
rankR
compareByMVVLVA
:: Attribute.Rank.EvaluateRank
-> Turn x y
-> Turn x y
-> Ordering
compareByMVVLVA :: EvaluateRank -> Turn x y -> Turn x y -> Ordering
compareByMVVLVA EvaluateRank
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 -> Rank -> Rank -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing EvaluateRank
evaluateRank Rank
rankR Rank
rankL of
Ordering
EQ -> Ordering
lvaComparison
Ordering
ordering -> Ordering
ordering
where
lvaComparison :: Ordering
lvaComparison = EvaluateRank -> Turn x y -> Turn x y -> Ordering
forall x y. EvaluateRank -> Turn x y -> Turn x y -> Ordering
compareByLVA EvaluateRank
evaluateRank Turn x y
turnL Turn x y
turnR