{-# LANGUAGE CPP #-}
module BishBosh.Notation.PureCoordinate(
PureCoordinate(
getMove
),
notation,
regexSyntax,
abscissaParser,
ordinateParser,
coordinatesParser,
mkPureCoordinate,
mkPureCoordinate'
) where
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Notation.Notation as Notation.Notation
import qualified BishBosh.Type.Length as Type.Length
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 == 'L'
import qualified Text.ParserCombinators.Poly.Lazy as Poly
# elif USE_POLYPARSE == 'P'
import qualified Text.ParserCombinators.Poly.Plain as Poly
# else
# error "USE_POLYPARSE invalid"
# endif
#else /* Parsec */
import qualified Text.ParserCombinators.Parsec as Parsec
import Text.ParserCombinators.Parsec((<?>))
#endif
notation :: Notation.Notation.Notation
notation :: Notation
notation = CoordinatePairC -> Notation
Notation.Notation.mkNotation (Char
'a', Char
'1')
xOriginOffset :: Type.Length.X
yOriginOffset :: Type.Length.Y
(X
xOriginOffset, X
yOriginOffset) = Notation -> (X, X)
Notation.Notation.getOriginOffset Notation
notation
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
abscissaParser :: Text.Poly.TextParser Type.Length.X
abscissaParser :: TextParser X
abscissaParser = ((X -> X -> X
forall a. Num a => a -> a -> a
+ X
xOriginOffset) (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> X
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 (Notation -> Char -> Bool
Notation.Notation.inXRange Notation
notation) String
"Abscissa"
ordinateParser :: Text.Poly.TextParser Type.Length.Y
ordinateParser :: TextParser X
ordinateParser = ((X -> X -> X
forall a. Num a => a -> a -> a
+ X
yOriginOffset) (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> X
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 (Notation -> Char -> Bool
Notation.Notation.inYRange Notation
notation) String
"Ordinate"
coordinatesParser :: Text.Poly.TextParser Cartesian.Coordinates.Coordinates
coordinatesParser :: TextParser Coordinates
coordinatesParser = do
X
x <- TextParser X
abscissaParser
X
y <- TextParser X
ordinateParser
Coordinates -> TextParser Coordinates
forall (m :: * -> *) a. Monad m => a -> m a
return (Coordinates -> TextParser Coordinates)
-> Coordinates -> TextParser Coordinates
forall a b. (a -> b) -> a -> b
$ X -> X -> Coordinates
Cartesian.Coordinates.mkCoordinates X
x X
y
#else /* Parsec */
abscissaParser :: Parsec.Parser Type.Length.X
abscissaParser = (+ xOriginOffset) . fromIntegral . Data.Char.ord <$> Parsec.satisfy (Notation.Notation.inXRange notation) <?> "Abscissa"
ordinateParser :: Parsec.Parser Type.Length.Y
ordinateParser = (+ yOriginOffset) . fromIntegral . Data.Char.ord <$> Parsec.satisfy (Notation.Notation.inYRange notation) <?> "Ordinate"
coordinatesParser :: Parsec.Parser Cartesian.Coordinates.Coordinates
coordinatesParser = Cartesian.Coordinates.mkCoordinates <$> abscissaParser <*> ordinateParser
#endif
data PureCoordinate = MkPureCoordinate {
PureCoordinate -> Move
getMove :: Component.Move.Move,
PureCoordinate -> Maybe Rank
getMaybePromotionRank :: Maybe Attribute.Rank.Rank
} deriving PureCoordinate -> PureCoordinate -> Bool
(PureCoordinate -> PureCoordinate -> Bool)
-> (PureCoordinate -> PureCoordinate -> Bool) -> Eq PureCoordinate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PureCoordinate -> PureCoordinate -> Bool
$c/= :: PureCoordinate -> PureCoordinate -> Bool
== :: PureCoordinate -> PureCoordinate -> Bool
$c== :: PureCoordinate -> PureCoordinate -> Bool
Eq
mkPureCoordinate
:: Component.Move.Move
-> Maybe Attribute.Rank.Rank
-> PureCoordinate
mkPureCoordinate :: Move -> Maybe Rank -> PureCoordinate
mkPureCoordinate Move
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PureCoordinate)
-> (String -> Exception) -> String -> PureCoordinate
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) -> String -> PureCoordinate
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
rank String
"."
| Bool
otherwise = MkPureCoordinate :: Move -> Maybe Rank -> PureCoordinate
MkPureCoordinate {
getMove :: Move
getMove = Move
move,
getMaybePromotionRank :: Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
}
mkPureCoordinate'
:: Attribute.Rank.Promotable promotable
=> Component.Move.Move
-> promotable
-> PureCoordinate
mkPureCoordinate' :: Move -> promotable -> PureCoordinate
mkPureCoordinate' Move
move = Move -> Maybe Rank -> PureCoordinate
mkPureCoordinate Move
move (Maybe Rank -> PureCoordinate)
-> (promotable -> Maybe Rank) -> promotable -> PureCoordinate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. promotable -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank
instance Show PureCoordinate where
showsPrec :: X -> PureCoordinate -> ShowS
showsPrec X
_ MkPureCoordinate {
getMove :: PureCoordinate -> Move
getMove = Move
move,
getMaybePromotionRank :: PureCoordinate -> Maybe Rank
getMaybePromotionRank = Maybe Rank
maybePromotionRank
} = Notation -> Coordinates -> ShowS
Notation.Notation.showsCoordinates Notation
notation (
Move -> Coordinates
Component.Move.getSource Move
move
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> Coordinates -> ShowS
Notation.Notation.showsCoordinates Notation
notation (
Move -> Coordinates
Component.Move.getDestination Move
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
instance Read PureCoordinate where
readsPrec :: X -> ReadS PureCoordinate
readsPrec X
_ String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
x : Char
y : Char
x' : Char
y' : String
remainder -> [
(Maybe Rank -> PureCoordinate)
-> (Maybe Rank, String) -> (PureCoordinate, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
Move -> Maybe Rank -> PureCoordinate
mkPureCoordinate (Move -> Maybe Rank -> PureCoordinate)
-> Move -> Maybe Rank -> PureCoordinate
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination
) (
case ReadS Rank
forall a. Read a => ReadS a
reads ReadS Rank -> ReadS Rank
forall a b. (a -> b) -> a -> b
$ X -> ShowS
forall a. X -> [a] -> [a]
take X
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)
) |
let mkCoordinatesList :: CoordinatePairC -> [Coordinates]
mkCoordinatesList = Maybe Coordinates -> [Coordinates]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe Coordinates -> [Coordinates])
-> (CoordinatePairC -> Maybe Coordinates)
-> CoordinatePairC
-> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> CoordinatePairC -> Maybe Coordinates
Notation.Notation.mkMaybeCoordinates Notation
notation,
Coordinates
source <- CoordinatePairC -> [Coordinates]
mkCoordinatesList (Char
x, Char
y),
Coordinates
destination <- CoordinatePairC -> [Coordinates]
mkCoordinatesList (Char
x', Char
y'),
Coordinates
source Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates
destination
]
String
_ -> []
instance Attribute.Rank.Promotable PureCoordinate where
getMaybePromotionRank :: PureCoordinate -> Maybe Rank
getMaybePromotionRank = PureCoordinate -> Maybe Rank
getMaybePromotionRank