{-# LANGUAGE CPP #-}
{-
	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@]

	* <https://www.chessprogramming.org/Algebraic_Chess_Notation#Pure_coordinate_notation>.

	* CAVEAT: <https://en.wikipedia.org/wiki/Chess_notation> defined a variant of this notation.

	* N.B.: used for communication via /CECP/ with /xboard/.

	* N.B.: this minimal notation defines the coordinate-system on which Standard Algebraic is based.
-}

module BishBosh.Notation.PureCoordinate(
-- * Types
-- ** Data-types
	PureCoordinate(
--		MkPureCoordinate,
		getMove
--		getMaybePromotionRank
	),
-- * Constants
--	min',
--	xMin,
--	xMax,
--	yMin,
--	yMax,
--	xOrigin,
--	yOrigin,
	origin,
	regexSyntax,
-- * Functions
	encode,
	showsCoordinates,
	readsCoordinates,
	abscissaParser,
	ordinateParser,
	coordinatesParser,
-- ** Constructors
	mkPureCoordinate,
	mkPureCoordinate'
-- ** Predicates
--	inXRange,
--	inYRange
) where

import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.Rank		as Attribute.Rank
import qualified	BishBosh.Cartesian.Abscissa	as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates
import qualified	BishBosh.Cartesian.Ordinate	as Cartesian.Ordinate
import qualified	BishBosh.Component.Move		as Component.Move
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Types			as T
import qualified	Control.Arrow
import qualified	Control.Exception
import qualified	Data.Char
import qualified	Data.List.Extra
import qualified	Data.Maybe

#ifdef USE_POLYPARSE
import qualified	BishBosh.Text.Poly			as Text.Poly
#if USE_POLYPARSE == 1
import qualified	Text.ParserCombinators.Poly.Lazy	as Poly
#else /* Plain */
import qualified	Text.ParserCombinators.Poly.Plain	as Poly
#endif
#else /* Parsec */
import qualified	Text.ParserCombinators.Parsec		as Parsec
import			Text.ParserCombinators.Parsec((<?>))
#endif

-- | The minimum permissible values for /x/ & /y/ coordinates.
min' :: (Char, Char)
xMin, yMin :: Char
min' :: (Char, Char)
min'@(Char
xMin, Char
yMin)	= (Char
'a', Char
'1')

-- | The origin of the coordinate-system.
origin :: (Int, Int)
xOrigin, yOrigin :: Int
origin :: (Int, Int)
origin@(Int
xOrigin, Int
yOrigin)	= Char -> Int
Data.Char.ord (Char -> Int) -> (Char -> Int) -> (Char, Char) -> (Int, Int)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Char -> Int
Data.Char.ord ((Char, Char) -> (Int, Int)) -> (Char, Char) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Char, Char)
min'

-- | The maximum permissible values for /x/ & /y/ coordinates.
xMax, yMax :: Char
(Char
xMax, Char
yMax)	= Int -> Char
Data.Char.chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Enum a => a -> a
pred {-fence-post-} (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength)
 ) (Int -> Char) -> (Int -> Char) -> (Int, Int) -> (Char, Char)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> Char
Data.Char.chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Enum a => a -> a
pred {-fence-post-} (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Ordinate.yLength)
 ) ((Int, Int) -> (Char, Char)) -> (Int, Int) -> (Char, Char)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
origin

-- | Whether the specified character is a valid abscissa.
inXRange :: Char -> Bool
inXRange :: Char -> Bool
inXRange	= (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Char -> (Bool, Bool)) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
xMin) (Char -> Bool) -> (Char -> Bool) -> Char -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
xMax))

-- | Whether the specified character is a valid ordinate.
inYRange :: Char -> Bool
inYRange :: Char -> Bool
inYRange	= (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Char -> (Bool, Bool)) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
yMin) (Char -> Bool) -> (Char -> Bool) -> Char -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
yMax))

-- | Defines using a regex, the required syntax.
regexSyntax :: String
regexSyntax :: String
regexSyntax	= String -> ShowS
showString String
"([a-h][1-8]){2}[" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (
	(Rank -> String) -> [Rank] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rank -> String
forall a. Show a => a -> String
show [Rank]
Attribute.Rank.promotionProspects
 ) String
"]?"

#ifdef USE_POLYPARSE
-- | Parse an /x/-coordinate.
abscissaParser :: Enum x => Text.Poly.TextParser x
{-# SPECIALISE abscissaParser :: Text.Poly.TextParser T.X #-}
abscissaParser :: TextParser x
abscissaParser	= (
	Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> (Char -> Int) -> Char -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xOrigin)) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Data.Char.ord
 ) (Char -> x) -> Parser Char Char -> TextParser x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Char -> Bool) -> String -> Parser Char Char
forall t. Show t => (t -> Bool) -> String -> Parser t t
Poly.satisfyMsg Char -> Bool
inXRange String
"Abscissa"

-- | Parse a /y/-coordinate.
ordinateParser :: Enum y => Text.Poly.TextParser y
{-# SPECIALISE ordinateParser :: Text.Poly.TextParser T.Y #-}
ordinateParser :: TextParser y
ordinateParser	= (
	Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> (Char -> Int) -> Char -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
Cartesian.Ordinate.yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yOrigin)) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Data.Char.ord
 ) (Char -> y) -> Parser Char Char -> TextParser y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Char -> Bool) -> String -> Parser Char Char
forall t. Show t => (t -> Bool) -> String -> Parser t t
Poly.satisfyMsg Char -> Bool
inYRange String
"Ordinate"

-- | Parse a pair of /coordinates/.
coordinatesParser :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Text.Poly.TextParser (Cartesian.Coordinates.Coordinates x y)
{-# SPECIALISE coordinatesParser :: Text.Poly.TextParser (Cartesian.Coordinates.Coordinates T.X T.Y) #-}
coordinatesParser :: TextParser (Coordinates x y)
coordinatesParser	= do
	x
x	<- TextParser x
forall x. Enum x => TextParser x
abscissaParser
	y
y	<- TextParser y
forall x. Enum x => TextParser x
ordinateParser

	Coordinates x y -> TextParser (Coordinates x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (Coordinates x y -> TextParser (Coordinates x y))
-> Coordinates x y -> TextParser (Coordinates x y)
forall a b. (a -> b) -> a -> b
$ x -> y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Coordinates x y
Cartesian.Coordinates.mkCoordinates x
x y
y
#else
-- | Parse an /x/-coordinate.
abscissaParser :: Enum x => Parsec.Parser x
{-# SPECIALISE abscissaParser :: Parsec.Parser T.X #-}
abscissaParser	= (
	toEnum . (+ (Cartesian.Abscissa.xOrigin - xOrigin)) . Data.Char.ord
 ) <$> Parsec.satisfy inXRange <?> "Abscissa"

-- | Parse a /y/-coordinate.
ordinateParser :: Enum y => Parsec.Parser y
{-# SPECIALISE ordinateParser :: Parsec.Parser T.X #-}
ordinateParser	= (
	toEnum . (+ (Cartesian.Ordinate.yOrigin - yOrigin)) . Data.Char.ord
 ) <$> Parsec.satisfy inYRange <?> "Ordinate"

-- | Parse a pair of /coordinates/.
coordinatesParser :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Parsec.Parser (Cartesian.Coordinates.Coordinates x y)
{-# SPECIALISE coordinatesParser :: Parsec.Parser (Cartesian.Coordinates.Coordinates T.X T.Y) #-}
coordinatesParser	= Cartesian.Coordinates.mkCoordinates <$> abscissaParser <*> ordinateParser
#endif

-- | Defines a /move/, to enable i/o in /PureCoordinate/-notation.
data PureCoordinate x y	= MkPureCoordinate {
	PureCoordinate x y -> Move x y
getMove			:: Component.Move.Move x y,
	PureCoordinate x y -> Maybe Rank
getMaybePromotionRank	:: Maybe Attribute.Rank.Rank
} deriving PureCoordinate x y -> PureCoordinate x y -> Bool
(PureCoordinate x y -> PureCoordinate x y -> Bool)
-> (PureCoordinate x y -> PureCoordinate x y -> Bool)
-> Eq (PureCoordinate x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y.
(Eq x, Eq y) =>
PureCoordinate x y -> PureCoordinate x y -> Bool
/= :: PureCoordinate x y -> PureCoordinate x y -> Bool
$c/= :: forall x y.
(Eq x, Eq y) =>
PureCoordinate x y -> PureCoordinate x y -> Bool
== :: PureCoordinate x y -> PureCoordinate x y -> Bool
$c== :: forall x y.
(Eq x, Eq y) =>
PureCoordinate x y -> PureCoordinate x y -> Bool
Eq

-- | Smart constructor.
mkPureCoordinate :: Component.Move.Move x y -> Maybe Attribute.Rank.Rank -> PureCoordinate x y
mkPureCoordinate :: Move x y -> Maybe Rank -> PureCoordinate x y
mkPureCoordinate Move x y
move Maybe Rank
maybePromotionRank
	| Just Rank
rank	<- Maybe Rank
maybePromotionRank
	, Rank
rank Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rank]
Attribute.Rank.promotionProspects	= Exception -> PureCoordinate x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PureCoordinate x y)
-> (String -> Exception) -> String -> PureCoordinate x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Notation.PureCoordinate.mkPureCoordinate:\tcan't promote to a " (String -> PureCoordinate x y) -> String -> PureCoordinate x y
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
rank String
"."
	| Bool
otherwise						= MkPureCoordinate :: forall x y. Move x y -> Maybe Rank -> PureCoordinate x y
MkPureCoordinate {
		getMove :: Move x y
getMove			= Move x y
move,
		getMaybePromotionRank :: Maybe Rank
getMaybePromotionRank	= Maybe Rank
maybePromotionRank
	}

-- | Smart constructor.
mkPureCoordinate' :: Attribute.Rank.Promotable promotable => Component.Move.Move x y -> promotable -> PureCoordinate x y
mkPureCoordinate' :: Move x y -> promotable -> PureCoordinate x y
mkPureCoordinate' Move x y
move	= Move x y -> Maybe Rank -> PureCoordinate x y
forall x y. Move x y -> Maybe Rank -> PureCoordinate x y
mkPureCoordinate Move x y
move (Maybe Rank -> PureCoordinate x y)
-> (promotable -> Maybe Rank) -> promotable -> PureCoordinate x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. promotable -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank

-- | Encodes the ordinate & abscissa.
encode :: (Enum x, Enum y) => Cartesian.Coordinates.Coordinates x y -> (ShowS, ShowS)
encode :: Coordinates x y -> (ShowS, ShowS)
encode	= Char -> ShowS
showChar (Char -> ShowS)
-> (Coordinates x y -> Char) -> Coordinates x y -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Data.Char.chr (Int -> Char)
-> (Coordinates x y -> Int) -> Coordinates x y -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Cartesian.Abscissa.xOrigin)) (Int -> Int) -> (Coordinates x y -> Int) -> Coordinates x y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Int
forall a. Enum a => a -> Int
fromEnum (x -> Int) -> (Coordinates x y -> x) -> Coordinates x y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX (Coordinates x y -> ShowS)
-> (Coordinates x y -> ShowS) -> Coordinates x y -> (ShowS, ShowS)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Char -> ShowS
showChar (Char -> ShowS)
-> (Coordinates x y -> Char) -> Coordinates x y -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Data.Char.chr (Int -> Char)
-> (Coordinates x y -> Int) -> Coordinates x y -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Cartesian.Ordinate.yOrigin)) (Int -> Int) -> (Coordinates x y -> Int) -> Coordinates x y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> Int
forall a. Enum a => a -> Int
fromEnum (y -> Int) -> (Coordinates x y -> y) -> Coordinates x y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY

-- | Shows the specified /coordinates/.
showsCoordinates :: (Enum x, Enum y) => Cartesian.Coordinates.Coordinates x y -> ShowS
showsCoordinates :: Coordinates x y -> ShowS
showsCoordinates	= (ShowS -> ShowS -> ShowS) -> (ShowS, ShowS) -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((ShowS, ShowS) -> ShowS)
-> (Coordinates x y -> (ShowS, ShowS)) -> Coordinates x y -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> (ShowS, ShowS)
forall x y. (Enum x, Enum y) => Coordinates x y -> (ShowS, ShowS)
encode

-- | Reads coordinates.
readsCoordinates :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => ReadS (Cartesian.Coordinates.Coordinates x y)
readsCoordinates :: ReadS (Coordinates x y)
readsCoordinates String
s	= case ShowS
Data.List.Extra.trimStart String
s of
	Char
x : Char
y : String
remainder	-> (Coordinates x y -> (Coordinates x y, String))
-> [Coordinates x y] -> [(Coordinates x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map (
		(Coordinates x y -> String -> (Coordinates x y, String))
-> String -> Coordinates x y -> (Coordinates x y, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) String
remainder
	 ) ([Coordinates x y] -> [(Coordinates x y, String)])
-> (Maybe (Coordinates x y) -> [Coordinates x y])
-> Maybe (Coordinates x y)
-> [(Coordinates x y, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Coordinates x y) -> [Coordinates x y]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y) -> [(Coordinates x y, String)])
-> Maybe (Coordinates x y) -> [(Coordinates x y, String)]
forall a b. (a -> b) -> a -> b
$ x -> y -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Maybe (Coordinates x y)
Cartesian.Coordinates.mkMaybeCoordinates (
		Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Char -> Int
Data.Char.ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xOrigin)
	 ) (
		Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> Int -> y
forall a b. (a -> b) -> a -> b
$ Char -> Int
Data.Char.ord Char
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
Cartesian.Ordinate.yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yOrigin)
	 )
	String
_			-> []	-- Mo parse.

instance (Enum x, Enum y) => Show (PureCoordinate x y) where
	showsPrec :: Int -> PureCoordinate x y -> ShowS
showsPrec Int
_ MkPureCoordinate {
		getMove :: forall x y. PureCoordinate x y -> Move x y
getMove			= Move x y
move,
		getMaybePromotionRank :: forall x y. PureCoordinate x y -> Maybe Rank
getMaybePromotionRank	= Maybe Rank
maybePromotionRank
	} = Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
showsCoordinates (
		Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
	 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
showsCoordinates (
		Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move
	 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (Rank -> ShowS) -> Maybe Rank -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
forall a. a -> a
id Rank -> ShowS
forall a. Show a => a -> ShowS
shows Maybe Rank
maybePromotionRank

-- N.B. this merely validates the syntax, leaving any semantic errors to 'Model.Game.validate'.
instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Read (PureCoordinate x y) where
	readsPrec :: Int -> ReadS (PureCoordinate x y)
readsPrec Int
_ String
s	= case ShowS
Data.List.Extra.trimStart String
s of
		Char
x : Char
y : Char
x' : Char
y' : String
remainder	-> let
			translate :: Char -> Char -> Maybe (Coordinates x y)
translate Char
x'' Char
y''	= x -> y -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Maybe (Coordinates x y)
Cartesian.Coordinates.mkMaybeCoordinates (
				Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Char -> Int
Data.Char.ord Char
x'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xOrigin)
			 ) (
				Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> Int -> y
forall a b. (a -> b) -> a -> b
$ Char -> Int
Data.Char.ord Char
y'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
Cartesian.Ordinate.yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yOrigin)
			 )
		 in [
			(Maybe Rank -> PureCoordinate x y)
-> (Maybe Rank, String) -> (PureCoordinate x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
				Move x y -> Maybe Rank -> PureCoordinate x y
forall x y. Move x y -> Maybe Rank -> PureCoordinate x y
mkPureCoordinate (Move x y -> Maybe Rank -> PureCoordinate x y)
-> Move x y -> Maybe Rank -> PureCoordinate x y
forall a b. (a -> b) -> a -> b
$ 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
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
			) (
				case ReadS Rank
forall a. Read a => ReadS a
reads ReadS Rank -> ReadS Rank
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
remainder of
					[(Rank
rank, String
"")]	-> if Rank
rank Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rank]
Attribute.Rank.promotionProspects
						then (Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
rank, ShowS
forall a. [a] -> [a]
tail String
remainder)
						else (Maybe Rank
forall a. Maybe a
Nothing, String
remainder)
					[(Rank, String)]
_	-> (Maybe Rank
forall a. Maybe a
Nothing, String
remainder)
			) |
				Coordinates x y
source		<- Maybe (Coordinates x y) -> [Coordinates x y]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y) -> [Coordinates x y])
-> Maybe (Coordinates x y) -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Char -> Char -> Maybe (Coordinates x y)
translate Char
x Char
y,
				Coordinates x y
destination	<- Maybe (Coordinates x y) -> [Coordinates x y]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y) -> [Coordinates x y])
-> Maybe (Coordinates x y) -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Char -> Char -> Maybe (Coordinates x y)
translate Char
x' Char
y',
				Coordinates x y
source Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
destination
		 ] -- List-comprehension.
		String
_					-> []	-- No parse.

instance Attribute.Rank.Promotable (PureCoordinate x y) where
	getMaybePromotionRank :: PureCoordinate x y -> Maybe Rank
getMaybePromotionRank	= PureCoordinate x y -> Maybe Rank
forall x y. PureCoordinate x y -> Maybe Rank
getMaybePromotionRank