module BishBosh.Component.Move(
Move(
getSource,
getDestination
),
tag,
nPliesPerMove,
measureDistance,
interpolate,
mkMove,
isPawnDoubleAdvance
) where
import Control.Arrow((&&&))
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
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 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 = MkMove {
Move -> Coordinates
getSource :: Cartesian.Coordinates.Coordinates,
Move -> Coordinates
getDestination :: Cartesian.Coordinates.Coordinates
} deriving Move -> Move -> Bool
(Move -> Move -> Bool) -> (Move -> Move -> Bool) -> Eq Move
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Move -> Move -> Bool
$c/= :: Move -> Move -> Bool
== :: Move -> Move -> Bool
$c== :: Move -> Move -> Bool
Eq
instance Ord Move where
l' :: Move
l'@MkMove { getSource :: Move -> Coordinates
getSource = Coordinates
l } compare :: Move -> Move -> Ordering
`compare` r' :: Move
r'@MkMove { getSource :: Move -> Coordinates
getSource = Coordinates
r } = case Coordinates
l Coordinates -> Coordinates -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Coordinates
r of
Ordering
EQ -> (Move -> Coordinates) -> Move -> Move -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing Move -> Coordinates
getDestination Move
l' Move
r'
Ordering
ordering -> Ordering
ordering
instance Control.DeepSeq.NFData Move where
rnf :: Move -> ()
rnf MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = (Coordinates, Coordinates) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Coordinates
source, Coordinates
destination)
instance Show Move where
showsPrec :: NPlies -> Move -> ShowS
showsPrec NPlies
precedence MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = NPlies -> (Coordinates, Coordinates) -> ShowS
forall a. Show a => NPlies -> a -> ShowS
showsPrec NPlies
precedence (Coordinates
source, Coordinates
destination)
instance Read Move where
readsPrec :: NPlies -> ReadS Move
readsPrec NPlies
precedence = (((Coordinates, Coordinates), String) -> (Move, String))
-> [((Coordinates, Coordinates), String)] -> [(Move, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((Coordinates, Coordinates) -> Move)
-> ((Coordinates, Coordinates), String) -> (Move, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (((Coordinates, Coordinates) -> Move)
-> ((Coordinates, Coordinates), String) -> (Move, String))
-> ((Coordinates, Coordinates) -> Move)
-> ((Coordinates, Coordinates), String)
-> (Move, String)
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Move)
-> (Coordinates, Coordinates) -> Move
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Coordinates -> Move
mkMove) ([((Coordinates, Coordinates), String)] -> [(Move, String)])
-> (String -> [((Coordinates, Coordinates), String)]) -> ReadS Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPlies -> String -> [((Coordinates, Coordinates), String)]
forall a. Read a => NPlies -> ReadS a
readsPrec NPlies
precedence
instance Property.Opposable.Opposable Move where
getOpposite :: Move -> Move
getOpposite MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = MkMove :: Coordinates -> Coordinates -> Move
MkMove {
getSource :: Coordinates
getSource = Coordinates
destination,
getDestination :: Coordinates
getDestination = Coordinates
source
}
instance Property.Orientated.Orientated Move where
isVertical :: Move -> Bool
isVertical MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = Coordinates -> NPlies
Cartesian.Coordinates.getX Coordinates
source NPlies -> NPlies -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates -> NPlies
Cartesian.Coordinates.getX Coordinates
destination
isHorizontal :: Move -> Bool
isHorizontal MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = Coordinates -> NPlies
Cartesian.Coordinates.getY Coordinates
source NPlies -> NPlies -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates -> NPlies
Cartesian.Coordinates.getY Coordinates
destination
isDiagonal :: Move -> Bool
isDiagonal = Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal (Vector -> Bool) -> (Move -> Vector) -> Move -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Vector
measureDistance
instance Property.Reflectable.ReflectableOnX Move where
reflectOnX :: Move -> Move
reflectOnX MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = MkMove :: Coordinates -> Coordinates -> Move
MkMove {
getSource :: Coordinates
getSource = Coordinates -> Coordinates
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Coordinates
source,
getDestination :: Coordinates
getDestination = Coordinates -> Coordinates
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Coordinates
destination
}
instance Property.Reflectable.ReflectableOnY Move where
reflectOnY :: Move -> Move
reflectOnY MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = MkMove :: Coordinates -> Coordinates -> Move
MkMove {
getSource :: Coordinates
getSource = Coordinates -> Coordinates
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY Coordinates
source,
getDestination :: Coordinates
getDestination = Coordinates -> Coordinates
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY Coordinates
destination
}
mkMove
:: Cartesian.Coordinates.Coordinates
-> Cartesian.Coordinates.Coordinates
-> Move
{-# INLINE mkMove #-}
mkMove :: Coordinates -> Coordinates -> Move
mkMove Coordinates
source Coordinates
destination = Bool -> Move -> Move
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates
source Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates
destination) MkMove :: Coordinates -> Coordinates -> Move
MkMove {
getSource :: Coordinates
getSource = Coordinates
source,
getDestination :: Coordinates
getDestination = Coordinates
destination
}
measureDistance :: Move -> Cartesian.Vector.Vector
measureDistance :: Move -> Vector
measureDistance MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
source Coordinates
destination
interpolate :: Move -> Cartesian.Coordinates.QualifiedStraightLine
interpolate :: Move -> QualifiedStraightLine
interpolate move :: Move
move@MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = Bool -> QualifiedStraightLine -> QualifiedStraightLine
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Move -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight Move
move) (QualifiedStraightLine -> QualifiedStraightLine)
-> QualifiedStraightLine -> QualifiedStraightLine
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> QualifiedStraightLine
Cartesian.Coordinates.interpolate Coordinates
source Coordinates
destination
isPawnDoubleAdvance
:: Move
-> Colour.LogicalColour.LogicalColour
-> Bool
isPawnDoubleAdvance :: Move -> LogicalColour -> Bool
isPawnDoubleAdvance move :: Move
move@MkMove { getSource :: Move -> Coordinates
getSource = Coordinates
source } = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (LogicalColour -> (Bool, Bool)) -> LogicalColour -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Coordinates -> LogicalColour -> Bool
Cartesian.Coordinates.isPawnsFirstRank Coordinates
source (LogicalColour -> Bool)
-> (LogicalColour -> Bool) -> LogicalColour -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Vector -> LogicalColour -> Bool
Cartesian.Vector.matchesPawnDoubleAdvance (
Move -> Vector
measureDistance Move
move
)
)