{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Defines one move (actually just a half move AKA "ply") of a /piece/.
-}

module BishBosh.Component.Move(
-- * Types
-- ** Type-synonyms
	NMoves,
	NPlies,
	Move(
--		MkMove,
		getSource,
		getDestination
	),
-- * Constants
	tag,
	nPliesPerMove,
	castlingMovesByLogicalColour,
-- * Functions
	measureDistance,
	interpolate,
	getDeltaRadiusSquared,
-- ** Constructors
	mkMove,
-- ** Predicates
	isPawnDoubleAdvance
) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType
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.Types				as T
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Ord

-- | Used to qualify XML.
tag :: String
tag :: String
tag	= String
"move"

{- |
	* A number of moves.

	* CAVEAT: this may be a number of plies or /full/ moves (i.e. a ply by @White@ & a ply by @Black@)
-}
type NMoves	= Int

-- | A number of half-moves into a /game/.
type NPlies	= NMoves

-- | The constant number of plies per move.
nPliesPerMove :: NMoves
nPliesPerMove :: NMoves
nPliesPerMove	= NMoves
2

{- |
	* A move of a /piece/.

	* Most modern chess-notations (except Standard Algebraic) start with similar information, but also define ancillary information which is captured in /MoveType/.
-}
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 T.X T.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 :: NMoves -> Move x y -> ShowS
showsPrec NMoves
_ 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) -> ShowS
forall a. Show a => a -> ShowS
shows (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 :: NMoves -> ReadS (Move x y)
readsPrec NMoves
_	= (((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
. String -> [((Coordinates x y, Coordinates x y), String)]
forall a. Read a => ReadS a
reads

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)	= Coordinates x y -> Coordinates x y -> Move x y
forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove Coordinates x y
destination 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
	}

-- | Smart constructor.
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) (Move x y -> Move x y) -> Move x y -> Move x y
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> Move x y
forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove Coordinates x y
source Coordinates x y
destination

-- | Measures the signed distance between the ends of the move.
measureDistance :: (
	Enum	x,
	Enum	y,
	Num	distance,
	Ord	distance
 ) => Move x y -> Cartesian.Vector.Vector distance
{-# SPECIALISE measureDistance :: Move T.X T.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

-- | Generates a line of /coordinates/ covering the half open interval @(source, destination]@.
interpolate :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Move x y -> [Cartesian.Coordinates.Coordinates x y]
{-# SPECIALISE interpolate :: Move T.X T.Y -> [Cartesian.Coordinates.Coordinates T.X T.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

-- | Defines by /logical colour/, the list of (/move-type/, @King@'s move, & @Rook@'s move) for each type of Castle.
castlingMovesByLogicalColour :: (
	Enum	x,
	Enum	y,
	Eq	y,
	Ord	x
 ) => Attribute.LogicalColour.ByLogicalColour [(Attribute.MoveType.MoveType, Move x y, Move x y)]
castlingMovesByLogicalColour :: ByLogicalColour [(MoveType, Move x y, Move x y)]
castlingMovesByLogicalColour	= [[(MoveType, Move x y, Move x y)]]
-> ByLogicalColour [(MoveType, Move x y, Move x y)]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([[(MoveType, Move x y, Move x y)]]
 -> ByLogicalColour [(MoveType, Move x y, Move x y)])
-> [[(MoveType, Move x y, Move x y)]]
-> ByLogicalColour [(MoveType, Move x y, Move x y)]
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> [(MoveType, Move x y, Move x y)])
-> [LogicalColour] -> [[(MoveType, Move x y, Move x y)]]
forall a b. (a -> b) -> [a] -> [b]
map (
	\LogicalColour
logicalColour -> let
		kingsStartingCoordinates :: Coordinates x y
kingsStartingCoordinates	= LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour
		kingsMove :: (NMoves -> NMoves) -> Move x y
kingsMove NMoves -> NMoves
translation		= 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
kingsStartingCoordinates (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX NMoves -> NMoves
translation Coordinates x y
kingsStartingCoordinates
	in [
		(
			MoveType
Attribute.MoveType.shortCastle,
			(NMoves -> NMoves) -> Move x y
kingsMove (NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+ NMoves
2),
			(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) -> Move x y)
-> (Coordinates x y -> (Coordinates x y, Coordinates x y))
-> Coordinates x y
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Coordinates x y
forall a. a -> a
id (Coordinates x y -> Coordinates x y)
-> (Coordinates x y -> Coordinates x y)
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX (NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
subtract NMoves
2)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
				then Coordinates x y
forall a. Bounded a => a
maxBound
				else Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
Cartesian.Coordinates.bottomRight
		), (
			MoveType
Attribute.MoveType.longCastle,
			(NMoves -> NMoves) -> Move x y
kingsMove ((NMoves -> NMoves) -> Move x y) -> (NMoves -> NMoves) -> Move x y
forall a b. (a -> b) -> a -> b
$ NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
subtract NMoves
2,
			(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) -> Move x y)
-> (Coordinates x y -> (Coordinates x y, Coordinates x y))
-> Coordinates x y
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Coordinates x y
forall a. a -> a
id (Coordinates x y -> Coordinates x y)
-> (Coordinates x y -> Coordinates x y)
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX (NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+ NMoves
3)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
				then Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
Cartesian.Coordinates.topLeft
				else Coordinates x y
forall a. Bounded a => a
minBound
		) -- Triple.
	]
 ) [LogicalColour]
Attribute.LogicalColour.range where
	translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y
	translateX :: (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX NMoves -> NMoves
translation	= (x -> x) -> Coordinates x y -> Coordinates x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX ((x -> x) -> Coordinates x y -> Coordinates x y)
-> (x -> x) -> Coordinates x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ NMoves -> x
forall a. Enum a => NMoves -> a
toEnum (NMoves -> x) -> (x -> NMoves) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NMoves -> NMoves
translation (NMoves -> NMoves) -> (x -> NMoves) -> x -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NMoves
forall a. Enum a => a -> NMoves
fromEnum

{- |
	* Whether the specified /move/ is a @Pawn@'s initial double-advance.

	* CAVEAT: failing this test guarantees that the move isn't a @Pawn@'s double-advance,
	but passing only guarantees that it is, if it was a @Pawn@ which moved & that the /move/ is valid.
-}
isPawnDoubleAdvance
	:: (Enum x, Enum y, Eq y)
	=> Attribute.LogicalColour.LogicalColour	-- Defines the side whose move is referenced.
	-> 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
 )

-- | Measure the change in the square of the radius from the centre of the board, resulting from the specified move.
getDeltaRadiusSquared :: (
	Fractional	radiusSquared,
	Integral	x,
	Integral	y
 ) => Move x y -> radiusSquared
{-# SPECIALISE getDeltaRadiusSquared :: Move T.X T.Y -> T.RadiusSquared #-}
getDeltaRadiusSquared :: Move x y -> radiusSquared
getDeltaRadiusSquared 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
} = ByCoordinates x y radiusSquared
forall radiusSquared x y.
(Fractional radiusSquared, Integral x, Integral y) =>
ByCoordinates x y radiusSquared
Cartesian.Coordinates.radiusSquared ByCoordinates x y radiusSquared -> Coordinates x y -> radiusSquared
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates x y
destination radiusSquared -> radiusSquared -> radiusSquared
forall a. Num a => a -> a -> a
- ByCoordinates x y radiusSquared
forall radiusSquared x y.
(Fractional radiusSquared, Integral x, Integral y) =>
ByCoordinates x y radiusSquared
Cartesian.Coordinates.radiusSquared ByCoordinates x y radiusSquared -> Coordinates x y -> radiusSquared
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates x y
source