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 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
move :: Move
move@MkMove { getSource :: Move -> Coordinates
getSource = Coordinates
source } compare :: Move -> Move -> Ordering
`compare` move' :: Move
move'@MkMove { getSource :: Move -> Coordinates
getSource = Coordinates
source' } = case Coordinates
source Coordinates -> Coordinates -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Coordinates
source' 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
move Move
move'
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
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
isParallel :: Move -> Bool
isParallel = Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel (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.Coordinates]
interpolate :: Move -> [Coordinates]
interpolate move :: Move
move@MkMove {
getSource :: Move -> Coordinates
getSource = Coordinates
source,
getDestination :: Move -> Coordinates
getDestination = Coordinates
destination
} = Bool -> [Coordinates] -> [Coordinates]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Move -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight Move
move) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> [Coordinates]
Cartesian.Coordinates.interpolate Coordinates
source Coordinates
destination
isPawnDoubleAdvance
:: Attribute.LogicalColour.LogicalColour
-> Move
-> Bool
isPawnDoubleAdvance :: LogicalColour -> Move -> Bool
isPawnDoubleAdvance LogicalColour
logicalColour move :: Move
move@MkMove { getSource :: Move -> Coordinates
getSource = Coordinates
source } = LogicalColour -> Coordinates -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
logicalColour Coordinates
source Bool -> Bool -> Bool
&& LogicalColour -> Vector -> Bool
Cartesian.Vector.matchesPawnDoubleAdvance LogicalColour
logicalColour (
Move -> Vector
measureDistance Move
move
)