{-
	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     = "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   = 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 {
        getSource       :: Cartesian.Coordinates.Coordinates x y,
        getDestination  :: Cartesian.Coordinates.Coordinates x y
} deriving Eq

instance (Ord x, Ord y) => Ord (Move x y) where
        {-# SPECIALISE instance Ord (Move T.X T.Y) #-}
        move@MkMove { getSource = source } `compare` move'@MkMove { getSource = source' }       = case source `compare` source' of
                EQ              -> Data.Ord.comparing getDestination move move'
                ordering        -> ordering

instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Move x y) where
        rnf MkMove {
                getSource       = source,
                getDestination  = destination
        } = Control.DeepSeq.rnf (source, destination)

instance (Show x, Show y) => Show (Move x y) where
        showsPrec _ MkMove {
                getSource       = source,
                getDestination  = destination
        } = shows (source, destination)

instance (
        Enum    x,
        Enum    y,
        Ord     x,
        Ord     y,
        Read    x,
        Read    y
 ) => Read (Move x y) where
        readsPrec _     = map (Control.Arrow.first $ uncurry mkMove) . reads

instance Property.Opposable.Opposable (Move x y) where
        getOpposite (MkMove source destination) = MkMove destination source

instance (Enum x, Enum y) => Property.Orientated.Orientated (Move x y) where
        isDiagonal      = (Property.Orientated.isDiagonal :: Cartesian.Vector.VectorInt -> Bool) . measureDistance
        isParallel      = (Property.Orientated.isParallel :: Cartesian.Vector.VectorInt -> Bool) . measureDistance

instance Enum y => Property.Reflectable.ReflectableOnX (Move x y) where
        reflectOnX MkMove {
                getSource       = source,
                getDestination  = destination
        } = MkMove {
                getSource       = Property.Reflectable.reflectOnX source,
                getDestination  = Property.Reflectable.reflectOnX destination
        }

instance Enum x => Property.Reflectable.ReflectableOnY (Move x y) where
        reflectOnY MkMove {
                getSource       = source,
                getDestination  = destination
        } = MkMove {
                getSource       = Property.Reflectable.reflectOnY source,
                getDestination  = Property.Reflectable.reflectOnY destination
        }

-- | Smart constructor.
mkMove
        :: (Eq x, Eq y)
        => Cartesian.Coordinates.Coordinates x y
        -> Cartesian.Coordinates.Coordinates x y
        -> Move x y
{-# INLINE mkMove #-}
mkMove source destination       = Control.Exception.assert (source /= destination) $ MkMove source 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 MkMove {
        getSource       = source,
        getDestination  = destination
} = Cartesian.Vector.measureDistance source 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@MkMove {
        getSource       = source,
        getDestination  = destination
} = Control.Exception.assert (Property.Orientated.isStraight move) $ Cartesian.Coordinates.interpolate source 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    = Attribute.LogicalColour.listArrayByLogicalColour $ map (
        \logicalColour -> let
                kingsStartingCoordinates        = Cartesian.Coordinates.kingsStartingCoordinates logicalColour
                kingsMove translation           = mkMove kingsStartingCoordinates $ translateX translation kingsStartingCoordinates
        in [
                (
                        Attribute.MoveType.shortCastle,
                        kingsMove (+ 2),
                        uncurry mkMove . (id &&& translateX (subtract 2)) $ if Attribute.LogicalColour.isBlack logicalColour
                                then maxBound
                                else Cartesian.Coordinates.bottomRight
                ), (
                        Attribute.MoveType.longCastle,
                        kingsMove $ subtract 2,
                        uncurry mkMove . (id &&& translateX (+ 3)) $ if Attribute.LogicalColour.isBlack logicalColour
                                then Cartesian.Coordinates.topLeft
                                else minBound
                ) -- Triple.
        ]
 ) Attribute.LogicalColour.range where
        translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y
        translateX translation  = Cartesian.Coordinates.translateX $ toEnum . translation . 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  = Cartesian.Coordinates.isPawnsFirstRank logicalColour (
        getSource move
 ) && Cartesian.Vector.matchesPawnDoubleAdvance logicalColour (
        measureDistance 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 MkMove {
        getSource       = source,
        getDestination  = destination
} = Cartesian.Coordinates.radiusSquared ! destination - Cartesian.Coordinates.radiusSquared ! source