{-
	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 various context-free move-notations <https://en.wikipedia.org/wiki/Chess_notation_Chess-notation>.

	* Also defines some features required of a notation; e.g. that it has an origin, & implements (Read, Show).
-}

module BishBosh.Notation.MoveNotation(
-- * Type-classes
	ShowNotation(..),
	ShowNotationFloat(..),
-- * Types
-- ** Data-types
	MoveNotation(),
-- * Constants
	tag,
	pureCoordinate,
--	range,
-- * Functions
	readsQualifiedMove,
	showNotation,
	showsMoveSyntax,
	getNotation,
	getOrigin,
	showsNotationFloatToNDecimals,
-- ** Predicates
	isPureCoordinate
) 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.ICCFNumeric		as Notation.ICCFNumeric
import qualified	BishBosh.Notation.Notation		as Notation.Notation
import qualified	BishBosh.Notation.PureCoordinate	as Notation.PureCoordinate
import qualified	BishBosh.Notation.Smith			as Notation.Smith
import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Data.Default
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 sum-type of context-free move-notations which can be used.

	* Neither /Standard Algebraic/ nor /Long Algebraic/ notations are included, because conversion to or from a /QualifiedMove/, requires /game/-context.
-}
data MoveNotation
	= ICCFNumeric		-- ^ <https://en.wikipedia.org/wiki/ICCF_numeric_notation>.
	| PureCoordinate	-- ^ As used for communication with /xboard/ & as the basis of Standard Algebraic.
	| 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.

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

instance Property.FixedMembership.FixedMembership MoveNotation where
	members :: [MoveNotation]
members	= [MoveNotation]
range

-- | Constant.
pureCoordinate :: MoveNotation
pureCoordinate :: MoveNotation
pureCoordinate	= MoveNotation
PureCoordinate

-- | Reads a /move/ & /move-type/ from the specified 'MoveNotation'.
readsQualifiedMove :: MoveNotation -> ReadS Component.EitherQualifiedMove.EitherQualifiedMove
readsQualifiedMove :: MoveNotation -> ReadS EitherQualifiedMove
readsQualifiedMove MoveNotation
ICCFNumeric		= ((ICCFNumeric, String) -> (EitherQualifiedMove, String))
-> [(ICCFNumeric, String)] -> [(EitherQualifiedMove, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((ICCFNumeric -> EitherQualifiedMove)
-> (ICCFNumeric, String) -> (EitherQualifiedMove, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((ICCFNumeric -> EitherQualifiedMove)
 -> (ICCFNumeric, String) -> (EitherQualifiedMove, String))
-> (ICCFNumeric -> EitherQualifiedMove)
-> (ICCFNumeric, String)
-> (EitherQualifiedMove, String)
forall a b. (a -> b) -> a -> b
$ (Move -> Maybe Rank -> EitherQualifiedMove)
-> (Move, Maybe Rank) -> EitherQualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> Maybe Rank -> EitherQualifiedMove
Component.EitherQualifiedMove.mkPartiallyQualifiedMove ((Move, Maybe Rank) -> EitherQualifiedMove)
-> (ICCFNumeric -> (Move, Maybe Rank))
-> ICCFNumeric
-> EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ICCFNumeric -> Move
Notation.ICCFNumeric.getMove (ICCFNumeric -> Move)
-> (ICCFNumeric -> Maybe Rank) -> ICCFNumeric -> (Move, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ICCFNumeric -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank)) ([(ICCFNumeric, String)] -> [(EitherQualifiedMove, String)])
-> (String -> [(ICCFNumeric, String)]) -> ReadS EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(ICCFNumeric, String)]
forall a. Read a => ReadS a
reads
readsQualifiedMove MoveNotation
PureCoordinate	= ((PureCoordinate, String) -> (EitherQualifiedMove, String))
-> [(PureCoordinate, String)] -> [(EitherQualifiedMove, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PureCoordinate -> EitherQualifiedMove)
-> (PureCoordinate, String) -> (EitherQualifiedMove, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((PureCoordinate -> EitherQualifiedMove)
 -> (PureCoordinate, String) -> (EitherQualifiedMove, String))
-> (PureCoordinate -> EitherQualifiedMove)
-> (PureCoordinate, String)
-> (EitherQualifiedMove, String)
forall a b. (a -> b) -> a -> b
$ (Move -> Maybe Rank -> EitherQualifiedMove)
-> (Move, Maybe Rank) -> EitherQualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> Maybe Rank -> EitherQualifiedMove
Component.EitherQualifiedMove.mkPartiallyQualifiedMove ((Move, Maybe Rank) -> EitherQualifiedMove)
-> (PureCoordinate -> (Move, Maybe Rank))
-> PureCoordinate
-> EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PureCoordinate -> Move
Notation.PureCoordinate.getMove (PureCoordinate -> Move)
-> (PureCoordinate -> Maybe Rank)
-> PureCoordinate
-> (Move, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PureCoordinate -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank)) ([(PureCoordinate, String)] -> [(EitherQualifiedMove, String)])
-> (String -> [(PureCoordinate, String)])
-> ReadS EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(PureCoordinate, String)]
forall a. Read a => ReadS a
reads
readsQualifiedMove MoveNotation
Smith		= ((Smith, String) -> (EitherQualifiedMove, String))
-> [(Smith, String)] -> [(EitherQualifiedMove, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Smith -> EitherQualifiedMove)
-> (Smith, String) -> (EitherQualifiedMove, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((Smith -> EitherQualifiedMove)
 -> (Smith, String) -> (EitherQualifiedMove, String))
-> (Smith -> EitherQualifiedMove)
-> (Smith, String)
-> (EitherQualifiedMove, String)
forall a b. (a -> b) -> a -> b
$ (Move -> MoveType -> EitherQualifiedMove)
-> (Move, MoveType) -> EitherQualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> MoveType -> EitherQualifiedMove
Component.EitherQualifiedMove.mkFullyQualifiedMove ((Move, MoveType) -> EitherQualifiedMove)
-> (Smith -> (Move, MoveType)) -> Smith -> EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove -> (Move, MoveType))
-> (Smith -> QualifiedMove) -> Smith -> (Move, MoveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Smith -> QualifiedMove
Notation.Smith.getQualifiedMove) ([(Smith, String)] -> [(EitherQualifiedMove, String)])
-> (String -> [(Smith, String)]) -> ReadS EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Smith, 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
ICCFNumeric	-> String
Notation.ICCFNumeric.regexSyntax
		MoveNotation
PureCoordinate	-> String
Notation.PureCoordinate.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 notation-parameters.
getNotation :: MoveNotation -> Notation.Notation.Notation
getNotation :: MoveNotation -> Notation
getNotation MoveNotation
ICCFNumeric		= Notation
Notation.ICCFNumeric.notation
getNotation MoveNotation
PureCoordinate	= Notation
Notation.PureCoordinate.notation
getNotation MoveNotation
Smith		= Notation
Notation.Smith.notation

-- | Returns the origin of the specified coordinate-system.
getOrigin :: MoveNotation -> Notation.Notation.CoordinatePairI
getOrigin :: MoveNotation -> CoordinatePairI
getOrigin	= Notation -> CoordinatePairI
Notation.Notation.getOrigin (Notation -> CoordinatePairI)
-> (MoveNotation -> Notation) -> MoveNotation -> CoordinatePairI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> Notation
getNotation

-- | Predicate.
isPureCoordinate :: MoveNotation -> Bool
isPureCoordinate :: MoveNotation -> Bool
isPureCoordinate MoveNotation
PureCoordinate	= Bool
True
isPureCoordinate MoveNotation
_		= Bool
False

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

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

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

instance ShowNotation Cartesian.Coordinates.Coordinates where
	showsNotation :: MoveNotation -> Coordinates -> ShowS
showsNotation	= Notation -> Coordinates -> ShowS
Notation.Notation.showsCoordinates (Notation -> Coordinates -> ShowS)
-> (MoveNotation -> Notation)
-> MoveNotation
-> Coordinates
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> Notation
getNotation

-- | 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 -> Type.Count.NDecimalDigits -> a -> ShowS
showsNotationFloatToNDecimals :: MoveNotation -> Int -> a -> ShowS
showsNotationFloatToNDecimals MoveNotation
moveNotation	= MoveNotation -> (Double -> ShowS) -> a -> ShowS
forall a.
ShowNotationFloat a =>
MoveNotation -> (Double -> ShowS) -> a -> ShowS
showsNotationFloat MoveNotation
moveNotation ((Double -> ShowS) -> a -> ShowS)
-> (Int -> Double -> ShowS) -> Int -> a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. RealFloat a => Int -> a -> ShowS
Property.ShowFloat.showsFloatToN'