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