{-
	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/.

	* Similar to 'Cartesian.Vector.Vector', but the position is fixed.
-}

module BishBosh.Component.Move(
-- * Types
-- ** Type-synonyms
	Move(
--		MkMove,
		getSource,
		getDestination
	),
-- * Constants
	tag,
	nPliesPerMove,
-- * Functions
	measureDistance,
	interpolate,
-- ** Constructors
	mkMove,
-- ** Predicates
	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

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

-- | The constant number of plies per move.
nPliesPerMove :: Type.Count.NPlies
nPliesPerMove :: NPlies
nPliesPerMove	= NPlies
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	= 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
	}

-- | Smart constructor.
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
}

-- | Measures the signed distance between the ends of the move.
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

-- | Generates a line of /coordinates/ covering the half open interval @(source, 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

{- |
	* 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
	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side whose move is referenced.
	-> 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
 )