module BishBosh.Component.Move(
Move(
getSource,
getDestination
),
tag,
nPliesPerMove,
measureDistance,
interpolate,
mkMove,
isPawnDoubleAdvance
) where
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Ord
tag :: String
tag :: String
tag = String
"move"
nPliesPerMove :: Type.Count.NPlies
nPliesPerMove :: NPlies
nPliesPerMove = NPlies
2
data Move x y = MkMove {
Move x y -> Coordinates x y
getSource :: Cartesian.Coordinates.Coordinates x y,
Move x y -> Coordinates x y
getDestination :: Cartesian.Coordinates.Coordinates x y
} deriving Move x y -> Move x y -> Bool
(Move x y -> Move x y -> Bool)
-> (Move x y -> Move x y -> Bool) -> Eq (Move x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y. (Eq x, Eq y) => Move x y -> Move x y -> Bool
/= :: Move x y -> Move x y -> Bool
$c/= :: forall x y. (Eq x, Eq y) => Move x y -> Move x y -> Bool
== :: Move x y -> Move x y -> Bool
$c== :: forall x y. (Eq x, Eq y) => Move x y -> Move x y -> Bool
Eq
instance (Ord x, Ord y) => Ord (Move x y) where
{-# SPECIALISE instance Ord (Move Type.Length.X Type.Length.Y) #-}
move :: Move x y
move@MkMove { getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source } compare :: Move x y -> Move x y -> Ordering
`compare` move' :: Move x y
move'@MkMove { getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source' } = case Coordinates x y
source Coordinates x y -> Coordinates x y -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Coordinates x y
source' of
Ordering
EQ -> (Move x y -> Coordinates x y) -> Move x y -> Move x y -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
getDestination Move x y
move Move x y
move'
Ordering
ordering -> Ordering
ordering
instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Move x y) where
rnf :: Move x y -> ()
rnf MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = (Coordinates x y, Coordinates x y) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Coordinates x y
source, Coordinates x y
destination)
instance (Show x, Show y) => Show (Move x y) where
showsPrec :: NPlies -> Move x y -> ShowS
showsPrec NPlies
precedence MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = NPlies -> (Coordinates x y, Coordinates x y) -> ShowS
forall a. Show a => NPlies -> a -> ShowS
showsPrec NPlies
precedence (Coordinates x y
source, Coordinates x y
destination)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Read x,
Read y
) => Read (Move x y) where
readsPrec :: NPlies -> ReadS (Move x y)
readsPrec NPlies
precedence = (((Coordinates x y, Coordinates x y), String)
-> (Move x y, String))
-> [((Coordinates x y, Coordinates x y), String)]
-> [(Move x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((Coordinates x y, Coordinates x y) -> Move x y)
-> ((Coordinates x y, Coordinates x y), String)
-> (Move x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (((Coordinates x y, Coordinates x y) -> Move x y)
-> ((Coordinates x y, Coordinates x y), String)
-> (Move x y, String))
-> ((Coordinates x y, Coordinates x y) -> Move x y)
-> ((Coordinates x y, Coordinates x y), String)
-> (Move x y, String)
forall a b. (a -> b) -> a -> b
$ (Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
mkMove) ([((Coordinates x y, Coordinates x y), String)]
-> [(Move x y, String)])
-> (String -> [((Coordinates x y, Coordinates x y), String)])
-> ReadS (Move x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPlies -> String -> [((Coordinates x y, Coordinates x y), String)]
forall a. Read a => NPlies -> ReadS a
readsPrec NPlies
precedence
instance Property.Opposable.Opposable (Move x y) where
getOpposite :: Move x y -> Move x y
getOpposite (MkMove Coordinates x y
source Coordinates x y
destination) = MkMove :: forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove {
getSource :: Coordinates x y
getSource = Coordinates x y
destination,
getDestination :: Coordinates x y
getDestination = Coordinates x y
source
}
instance (Enum x, Enum y) => Property.Orientated.Orientated (Move x y) where
isDiagonal :: Move x y -> Bool
isDiagonal = (VectorInt -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal :: Cartesian.Vector.VectorInt -> Bool) (VectorInt -> Bool) -> (Move x y -> VectorInt) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> VectorInt
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
measureDistance
isParallel :: Move x y -> Bool
isParallel = (VectorInt -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel :: Cartesian.Vector.VectorInt -> Bool) (VectorInt -> Bool) -> (Move x y -> VectorInt) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> VectorInt
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
measureDistance
instance Enum y => Property.Reflectable.ReflectableOnX (Move x y) where
reflectOnX :: Move x y -> Move x y
reflectOnX MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = MkMove :: forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove {
getSource :: Coordinates x y
getSource = Coordinates x y -> Coordinates x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Coordinates x y
source,
getDestination :: Coordinates x y
getDestination = Coordinates x y -> Coordinates x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Coordinates x y
destination
}
instance Enum x => Property.Reflectable.ReflectableOnY (Move x y) where
reflectOnY :: Move x y -> Move x y
reflectOnY MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = MkMove :: forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove {
getSource :: Coordinates x y
getSource = Coordinates x y -> Coordinates x y
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY Coordinates x y
source,
getDestination :: Coordinates x y
getDestination = Coordinates x y -> Coordinates x y
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY Coordinates x y
destination
}
mkMove
:: (Eq x, Eq y)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Move x y
{-# INLINE mkMove #-}
mkMove :: Coordinates x y -> Coordinates x y -> Move x y
mkMove Coordinates x y
source Coordinates x y
destination = Bool -> Move x y -> Move x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates x y
source Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
destination) MkMove :: forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove {
getSource :: Coordinates x y
getSource = Coordinates x y
source,
getDestination :: Coordinates x y
getDestination = Coordinates x y
destination
}
measureDistance :: (
Enum x,
Enum y,
Num distance,
Ord distance
) => Move x y -> Cartesian.Vector.Vector distance
{-# SPECIALISE measureDistance :: Move Type.Length.X Type.Length.Y -> Cartesian.Vector.VectorInt #-}
measureDistance :: Move x y -> Vector distance
measureDistance MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = Coordinates x y -> Coordinates x y -> Vector distance
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Coordinates x y -> Coordinates x y -> Vector distance
Cartesian.Vector.measureDistance Coordinates x y
source Coordinates x y
destination
interpolate :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Move x y -> [Cartesian.Coordinates.Coordinates x y]
{-# SPECIALISE interpolate :: Move Type.Length.X Type.Length.Y -> [Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y] #-}
interpolate :: Move x y -> [Coordinates x y]
interpolate move :: Move x y
move@MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = Bool -> [Coordinates x y] -> [Coordinates x y]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Move x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight Move x y
move) ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.interpolate Coordinates x y
source Coordinates x y
destination
isPawnDoubleAdvance
:: (Enum x, Enum y, Eq y)
=> Attribute.LogicalColour.LogicalColour
-> Move x y
-> Bool
isPawnDoubleAdvance :: LogicalColour -> Move x y -> Bool
isPawnDoubleAdvance LogicalColour
logicalColour Move x y
move = LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
logicalColour (
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
getSource Move x y
move
) Bool -> Bool -> Bool
&& LogicalColour -> VectorInt -> Bool
forall distance.
(Eq distance, Num distance) =>
LogicalColour -> Vector distance -> Bool
Cartesian.Vector.matchesPawnDoubleAdvance LogicalColour
logicalColour (
Move x y -> VectorInt
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
measureDistance Move x y
move :: Cartesian.Vector.VectorInt
)