{-
	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@]	Implements various move-notations <https://en.wikipedia.org/wiki/Chess_notation_Chess-notation>.
-}

module BishBosh.Notation.MoveNotation(
-- * Type-classes
	ShowNotation(..),
	ShowNotationFloat(..),
-- * Types
-- ** Data-types
	MoveNotation(),
-- * Constants
	tag,
	coordinate,
	range,
-- * Functions
	readsQualifiedMove,
	showNotation,
	showsMoveSyntax,
	getOrigin,
	showsNotationFloatToNDecimals,
-- ** Predicates
	isCoordinate
) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
import qualified	BishBosh.Component.EitherQualifiedMove	as Component.EitherQualifiedMove
import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove
import qualified	BishBosh.Component.Turn			as Component.Turn
import qualified	BishBosh.Notation.Coordinate		as Notation.Coordinate
import qualified	BishBosh.Notation.ICCFNumeric		as Notation.ICCFNumeric
import qualified	BishBosh.Notation.Smith			as Notation.Smith
import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Data.Default
import qualified	Numeric
import qualified	Text.XML.HXT.Arrow.Pickle		as HXT
import qualified	Text.XML.HXT.Arrow.Pickle.Schema

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

{- |
	* Identifies the move-notations which can be used.

	* /Standard Algebraic/ isn't included here because conversion to or from a /QualifiedMove/ requires access to the /game/.
-}
data MoveNotation
	= Coordinate	-- ^ As used for communication with /xboard/.
	| ICCFNumeric	-- ^ <https://en.wikipedia.org/wiki/ICCF_numeric_notation>.
	| Smith		-- ^ <https://www.chessprogramming.org/Warren_D._Smith>.
	deriving (MoveNotation -> MoveNotation -> Bool
(MoveNotation -> MoveNotation -> Bool)
-> (MoveNotation -> MoveNotation -> Bool) -> Eq MoveNotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoveNotation -> MoveNotation -> Bool
$c/= :: MoveNotation -> MoveNotation -> Bool
== :: MoveNotation -> MoveNotation -> Bool
$c== :: MoveNotation -> MoveNotation -> Bool
Eq, ReadPrec [MoveNotation]
ReadPrec MoveNotation
Int -> ReadS MoveNotation
ReadS [MoveNotation]
(Int -> ReadS MoveNotation)
-> ReadS [MoveNotation]
-> ReadPrec MoveNotation
-> ReadPrec [MoveNotation]
-> Read MoveNotation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MoveNotation]
$creadListPrec :: ReadPrec [MoveNotation]
readPrec :: ReadPrec MoveNotation
$creadPrec :: ReadPrec MoveNotation
readList :: ReadS [MoveNotation]
$creadList :: ReadS [MoveNotation]
readsPrec :: Int -> ReadS MoveNotation
$creadsPrec :: Int -> ReadS MoveNotation
Read, Int -> MoveNotation -> ShowS
[MoveNotation] -> ShowS
MoveNotation -> String
(Int -> MoveNotation -> ShowS)
-> (MoveNotation -> String)
-> ([MoveNotation] -> ShowS)
-> Show MoveNotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MoveNotation] -> ShowS
$cshowList :: [MoveNotation] -> ShowS
show :: MoveNotation -> String
$cshow :: MoveNotation -> String
showsPrec :: Int -> MoveNotation -> ShowS
$cshowsPrec :: Int -> MoveNotation -> ShowS
Show)

instance Control.DeepSeq.NFData MoveNotation where
	rnf :: MoveNotation -> ()
rnf MoveNotation
_	= ()

instance Data.Default.Default MoveNotation where
	def :: MoveNotation
def	= MoveNotation
Smith

instance HXT.XmlPickler MoveNotation where
	xpickle :: PU MoveNotation
xpickle	= MoveNotation -> PU MoveNotation -> PU MoveNotation
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault MoveNotation
forall a. Default a => a
Data.Default.def (PU MoveNotation -> PU MoveNotation)
-> ([String] -> PU MoveNotation) -> [String] -> PU MoveNotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MoveNotation, MoveNotation -> String)
-> PU String -> PU MoveNotation
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> MoveNotation
forall a. Read a => String -> a
read, MoveNotation -> String
forall a. Show a => a -> String
show) (PU String -> PU MoveNotation)
-> ([String] -> PU String) -> [String] -> PU MoveNotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU MoveNotation) -> [String] -> PU MoveNotation
forall a b. (a -> b) -> a -> b
$ (MoveNotation -> String) -> [MoveNotation] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MoveNotation -> String
forall a. Show a => a -> String
show [MoveNotation]
range	-- CAVEAT: whether it'll be used as an XML-attribute or an XML-element isn't currently known.

-- | Constant.
coordinate :: MoveNotation
coordinate :: MoveNotation
coordinate	= MoveNotation
Coordinate

-- | The constant complete range of values.
range :: [MoveNotation]
range :: [MoveNotation]
range	= [MoveNotation
Coordinate, MoveNotation
ICCFNumeric, MoveNotation
Smith]

-- | Reads a /move/ & /move-type/ from the specified 'MoveNotation'.
readsQualifiedMove :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> MoveNotation
	-> ReadS (Component.EitherQualifiedMove.EitherQualifiedMove x y)
readsQualifiedMove :: MoveNotation -> ReadS (EitherQualifiedMove x y)
readsQualifiedMove MoveNotation
Coordinate	= ((Coordinate x y, String) -> (EitherQualifiedMove x y, String))
-> [(Coordinate x y, String)]
-> [(EitherQualifiedMove x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Coordinate x y -> EitherQualifiedMove x y)
-> (Coordinate x y, String) -> (EitherQualifiedMove x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((Coordinate x y -> EitherQualifiedMove x y)
 -> (Coordinate x y, String) -> (EitherQualifiedMove x y, String))
-> (Coordinate x y -> EitherQualifiedMove x y)
-> (Coordinate x y, String)
-> (EitherQualifiedMove x y, String)
forall a b. (a -> b) -> a -> b
$ (Move x y -> Maybe Rank -> EitherQualifiedMove x y)
-> (Move x y, Maybe Rank) -> EitherQualifiedMove x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move x y -> Maybe Rank -> EitherQualifiedMove x y
forall x y. Move x y -> Maybe Rank -> EitherQualifiedMove x y
Component.EitherQualifiedMove.mkPartiallyQualifiedMove ((Move x y, Maybe Rank) -> EitherQualifiedMove x y)
-> (Coordinate x y -> (Move x y, Maybe Rank))
-> Coordinate x y
-> EitherQualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinate x y -> Move x y
forall x y. Coordinate x y -> Move x y
Notation.Coordinate.getMove (Coordinate x y -> Move x y)
-> (Coordinate x y -> Maybe Rank)
-> Coordinate x y
-> (Move x y, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinate x y -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank)) ([(Coordinate x y, String)] -> [(EitherQualifiedMove x y, String)])
-> (String -> [(Coordinate x y, String)])
-> ReadS (EitherQualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Coordinate x y, String)]
forall a. Read a => ReadS a
reads
readsQualifiedMove MoveNotation
ICCFNumeric	= ((ICCFNumeric x y, String) -> (EitherQualifiedMove x y, String))
-> [(ICCFNumeric x y, String)]
-> [(EitherQualifiedMove x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((ICCFNumeric x y -> EitherQualifiedMove x y)
-> (ICCFNumeric x y, String) -> (EitherQualifiedMove x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((ICCFNumeric x y -> EitherQualifiedMove x y)
 -> (ICCFNumeric x y, String) -> (EitherQualifiedMove x y, String))
-> (ICCFNumeric x y -> EitherQualifiedMove x y)
-> (ICCFNumeric x y, String)
-> (EitherQualifiedMove x y, String)
forall a b. (a -> b) -> a -> b
$ (Move x y -> Maybe Rank -> EitherQualifiedMove x y)
-> (Move x y, Maybe Rank) -> EitherQualifiedMove x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move x y -> Maybe Rank -> EitherQualifiedMove x y
forall x y. Move x y -> Maybe Rank -> EitherQualifiedMove x y
Component.EitherQualifiedMove.mkPartiallyQualifiedMove ((Move x y, Maybe Rank) -> EitherQualifiedMove x y)
-> (ICCFNumeric x y -> (Move x y, Maybe Rank))
-> ICCFNumeric x y
-> EitherQualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ICCFNumeric x y -> Move x y
forall x y. ICCFNumeric x y -> Move x y
Notation.ICCFNumeric.getMove (ICCFNumeric x y -> Move x y)
-> (ICCFNumeric x y -> Maybe Rank)
-> ICCFNumeric x y
-> (Move x y, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ICCFNumeric x y -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank)) ([(ICCFNumeric x y, String)]
 -> [(EitherQualifiedMove x y, String)])
-> (String -> [(ICCFNumeric x y, String)])
-> ReadS (EitherQualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(ICCFNumeric x y, String)]
forall a. Read a => ReadS a
reads
readsQualifiedMove MoveNotation
Smith	= ((Smith x y, String) -> (EitherQualifiedMove x y, String))
-> [(Smith x y, String)] -> [(EitherQualifiedMove x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Smith x y -> EitherQualifiedMove x y)
-> (Smith x y, String) -> (EitherQualifiedMove x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((Smith x y -> EitherQualifiedMove x y)
 -> (Smith x y, String) -> (EitherQualifiedMove x y, String))
-> (Smith x y -> EitherQualifiedMove x y)
-> (Smith x y, String)
-> (EitherQualifiedMove x y, String)
forall a b. (a -> b) -> a -> b
$ (Move x y -> MoveType -> EitherQualifiedMove x y)
-> (Move x y, MoveType) -> EitherQualifiedMove x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move x y -> MoveType -> EitherQualifiedMove x y
forall x y. Move x y -> MoveType -> EitherQualifiedMove x y
Component.EitherQualifiedMove.mkFullyQualifiedMove ((Move x y, MoveType) -> EitherQualifiedMove x y)
-> (Smith x y -> (Move x y, MoveType))
-> Smith x y
-> EitherQualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove x y -> (Move x y, MoveType))
-> (Smith x y -> QualifiedMove x y)
-> Smith x y
-> (Move x y, MoveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Smith x y -> QualifiedMove x y
forall x y. Smith x y -> QualifiedMove x y
Notation.Smith.getQualifiedMove) ([(Smith x y, String)] -> [(EitherQualifiedMove x y, String)])
-> (String -> [(Smith x y, String)])
-> ReadS (EitherQualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Smith x y, String)]
forall a. Read a => ReadS a
reads

-- | Show the syntax required by a specific 'MoveNotation'.
showsMoveSyntax :: MoveNotation -> ShowS
showsMoveSyntax :: MoveNotation -> ShowS
showsMoveSyntax MoveNotation
moveNotation	= Char -> ShowS
showChar Char
'/' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (
	case MoveNotation
moveNotation of
		MoveNotation
Coordinate	-> String
Notation.Coordinate.regexSyntax
		MoveNotation
ICCFNumeric	-> String
Notation.ICCFNumeric.regexSyntax
		MoveNotation
Smith		-> String
Notation.Smith.regexSyntax
 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'/'

-- | Returns the origin of the specified coordinate-system.
getOrigin :: MoveNotation -> (Int, Int)
getOrigin :: MoveNotation -> (Int, Int)
getOrigin MoveNotation
Coordinate	= (Int, Int)
Notation.Coordinate.origin
getOrigin MoveNotation
ICCFNumeric	= (Int, Int)
Notation.ICCFNumeric.origin
getOrigin MoveNotation
Smith		= (Int, Int)
Notation.Smith.origin

-- | Predicate.
isCoordinate :: MoveNotation -> Bool
isCoordinate :: MoveNotation -> Bool
isCoordinate MoveNotation
Coordinate	= Bool
True
isCoordinate MoveNotation
_		= Bool
False

-- | An interface for types which can be rendered in a chess-notation.
class ShowNotation a where
	showsNotation	:: MoveNotation -> a -> ShowS

instance (Enum x, Enum y) => ShowNotation (Component.QualifiedMove.QualifiedMove x y) where
	showsNotation :: MoveNotation -> QualifiedMove x y -> ShowS
showsNotation MoveNotation
moveNotation QualifiedMove x y
qualifiedMove	= case MoveNotation
moveNotation of
		MoveNotation
Coordinate	-> Coordinate x y -> ShowS
forall a. Show a => a -> ShowS
shows (Coordinate x y -> ShowS) -> Coordinate x y -> ShowS
forall a b. (a -> b) -> a -> b
$ Move x y -> MoveType -> Coordinate x y
forall promotable x y.
Promotable promotable =>
Move x y -> promotable -> Coordinate x y
Notation.Coordinate.mkCoordinate' Move x y
move MoveType
moveType
		MoveNotation
ICCFNumeric	-> ICCFNumeric x y -> ShowS
forall a. Show a => a -> ShowS
shows (ICCFNumeric x y -> ShowS) -> ICCFNumeric x y -> ShowS
forall a b. (a -> b) -> a -> b
$ Move x y -> MoveType -> ICCFNumeric x y
forall promotable x y.
Promotable promotable =>
Move x y -> promotable -> ICCFNumeric x y
Notation.ICCFNumeric.mkICCFNumeric' Move x y
move MoveType
moveType
		MoveNotation
Smith		-> Smith x y -> ShowS
forall a. Show a => a -> ShowS
shows (Smith x y -> ShowS) -> Smith x y -> ShowS
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y -> Smith x y
forall x y. QualifiedMove x y -> Smith x y
Notation.Smith.fromQualifiedMove QualifiedMove x y
qualifiedMove
		where
			(Move x y
move, MoveType
moveType)	= QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y
qualifiedMove

instance (Enum x, Enum y) => ShowNotation (Component.Turn.Turn x y) where
	showsNotation :: MoveNotation -> Turn x y -> ShowS
showsNotation MoveNotation
moveNotation	= MoveNotation -> QualifiedMove x y -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
showsNotation MoveNotation
moveNotation (QualifiedMove x y -> ShowS)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove

instance (Enum x, Enum y) => ShowNotation (Cartesian.Coordinates.Coordinates x y) where
	showsNotation :: MoveNotation -> Coordinates x y -> ShowS
showsNotation MoveNotation
Coordinate	= Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
Notation.Coordinate.showsCoordinates
	showsNotation MoveNotation
ICCFNumeric	= Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
Notation.ICCFNumeric.showsCoordinates
	showsNotation MoveNotation
Smith		= Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
Notation.Smith.showsCoordinates

-- | Show an arbitrary datum using the specified notation.
showNotation :: (ShowNotation a) => MoveNotation -> a -> String
showNotation :: MoveNotation -> a -> String
showNotation MoveNotation
moveNotation	= (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String) -> (a -> ShowS) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> a -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
showsNotation MoveNotation
moveNotation

-- | An alternative to 'Property.ShowFloat.ShowFloat', which permits access to a specific move-notation.
class ShowNotationFloat a where
	showsNotationFloat	:: MoveNotation -> (Double -> ShowS) -> a -> ShowS

-- | Render the specified data in the specified notation, & to the specified number of decimal digits.
showsNotationFloatToNDecimals :: ShowNotationFloat a => MoveNotation -> Property.ShowFloat.NDecimalDigits -> a -> ShowS
showsNotationFloatToNDecimals :: MoveNotation -> Int -> a -> ShowS
showsNotationFloatToNDecimals MoveNotation
moveNotation Int
nDecimalDigits	= MoveNotation -> (Double -> ShowS) -> a -> ShowS
forall a.
ShowNotationFloat a =>
MoveNotation -> (Double -> ShowS) -> a -> ShowS
showsNotationFloat MoveNotation
moveNotation (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloat (Maybe Int -> Double -> ShowS) -> Maybe Int -> Double -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
nDecimalDigits)