module BishBosh.Notation.Smith(
Smith(
getQualifiedMove
),
origin,
regexSyntax,
showsCoordinates,
fromQualifiedMove
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
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.Component.QualifiedMove as Component.QualifiedMove
import qualified Control.Arrow
import qualified Data.Char
import qualified Data.Default
import qualified Data.List.Extra
import qualified Data.Maybe
xOrigin :: Int
xOrigin :: Int
xOrigin = Char -> Int
Data.Char.ord Char
'a'
yOrigin :: Int
yOrigin :: Int
yOrigin = Char -> Int
Data.Char.ord Char
'1'
origin :: (Int, Int)
origin :: (Int, Int)
origin = (Int
xOrigin, Int
yOrigin)
regexSyntax :: String
regexSyntax :: String
regexSyntax = String -> ShowS
showString String
"([a-h][1-8]){2}[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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.range
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"EcC]?[" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (
ShowS
Data.List.Extra.upper ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Rank -> Char) -> [Rank] -> String
forall a b. (a -> b) -> [a] -> [b]
map (String -> Char
forall a. [a] -> a
head (String -> Char) -> (Rank -> String) -> Rank -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> String
forall a. Show a => a -> String
show) [Rank]
Attribute.Rank.promotionProspects
) String
"]?"
newtype Smith x y = MkSmith {
Smith x y -> QualifiedMove x y
getQualifiedMove :: Component.QualifiedMove.QualifiedMove x y
} deriving Smith x y -> Smith x y -> Bool
(Smith x y -> Smith x y -> Bool)
-> (Smith x y -> Smith x y -> Bool) -> Eq (Smith x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y. (Eq x, Eq y) => Smith x y -> Smith x y -> Bool
/= :: Smith x y -> Smith x y -> Bool
$c/= :: forall x y. (Eq x, Eq y) => Smith x y -> Smith x y -> Bool
== :: Smith x y -> Smith x y -> Bool
$c== :: forall x y. (Eq x, Eq y) => Smith x y -> Smith x y -> Bool
Eq
fromQualifiedMove :: Component.QualifiedMove.QualifiedMove x y -> Smith x y
fromQualifiedMove :: QualifiedMove x y -> Smith x y
fromQualifiedMove = QualifiedMove x y -> Smith x y
forall x y. QualifiedMove x y -> Smith x y
MkSmith
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
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
instance (Enum x, Enum y) => Show (Smith x y) where
showsPrec :: Int -> Smith x y -> ShowS
showsPrec Int
_ MkSmith { getQualifiedMove :: forall x y. Smith x y -> QualifiedMove x y
getQualifiedMove = QualifiedMove x y
qualifiedMove } = let
(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
in 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
. (
case MoveType
moveType of
Attribute.MoveType.Castle Bool
isShort -> Char -> ShowS
showChar (Char -> ShowS) -> Char -> ShowS
forall a b. (a -> b) -> a -> b
$ if Bool
isShort
then Char
'c'
else Char
'C'
MoveType
Attribute.MoveType.EnPassant -> Char -> ShowS
showChar Char
'E'
MoveType
_ -> 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 (
MoveType -> Maybe Rank
Attribute.MoveType.getMaybeExplicitlyTakenRank MoveType
moveType
) 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 (
String -> ShowS
showString (String -> ShowS) -> (Rank -> String) -> Rank -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Data.List.Extra.upper ShowS -> (Rank -> String) -> Rank -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> String
forall a. Show a => a -> String
show
) (
MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank MoveType
moveType
)
)
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Read (Smith x y) where
readsPrec :: Int -> ReadS (Smith 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
fromSmith :: Char -> Char -> Maybe (Coordinates x y)
fromSmith 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 [
(
QualifiedMove x y -> Smith x y
forall x y. QualifiedMove x y -> Smith x y
fromQualifiedMove (QualifiedMove x y -> Smith x y) -> QualifiedMove x y -> Smith x y
forall a b. (a -> b) -> a -> b
$ Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (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) MoveType
moveType,
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)
fromSmith 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)
fromSmith 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,
(MoveType
moveType, String
remainder') <- case String
remainder of
[] -> [(MoveType
forall a. Default a => a
Data.Default.def, String
remainder)]
Char
'c' : String
s1 -> [(MoveType
Attribute.MoveType.shortCastle, String
s1)]
Char
'C' : String
s1 -> [(MoveType
Attribute.MoveType.longCastle, String
s1)]
Char
'E' : String
s1 -> [(MoveType
Attribute.MoveType.enPassant, String
s1)]
Char
c1 : String
s1 -> (
\((Maybe Rank, Maybe Rank)
moveType, String
remainder') -> [(MoveType, String)]
-> (MoveType -> [(MoveType, String)])
-> Maybe MoveType
-> [(MoveType, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] (
(MoveType, String) -> [(MoveType, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((MoveType, String) -> [(MoveType, String)])
-> (MoveType -> (MoveType, String))
-> MoveType
-> [(MoveType, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MoveType -> String -> (MoveType, String))
-> String -> MoveType -> (MoveType, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) String
remainder'
) (Maybe MoveType -> [(MoveType, String)])
-> Maybe MoveType -> [(MoveType, String)]
forall a b. (a -> b) -> a -> b
$ (Maybe Rank -> Maybe Rank -> Maybe MoveType)
-> (Maybe Rank, Maybe Rank) -> Maybe MoveType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Rank -> Maybe Rank -> Maybe MoveType
Attribute.MoveType.mkMaybeNormalMoveType (Maybe Rank, Maybe Rank)
moveType
) (((Maybe Rank, Maybe Rank), String) -> [(MoveType, String)])
-> ((Maybe Rank, Maybe Rank), String) -> [(MoveType, String)]
forall a b. (a -> b) -> a -> b
$ case ReadS Rank
forall a. Read a => ReadS a
reads [Char
c1] of
[(Rank
rank, String
"")]
| Char -> Bool
Data.Char.isUpper Char
c1 -> ((Maybe Rank
forall a. Maybe a
Nothing, Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
rank), String
s1)
| Bool
otherwise -> (Maybe Rank -> (Maybe Rank, Maybe Rank))
-> (Maybe Rank, String) -> ((Maybe Rank, Maybe Rank), String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
(,) (Maybe Rank -> Maybe Rank -> (Maybe Rank, Maybe Rank))
-> Maybe Rank -> Maybe Rank -> (Maybe Rank, Maybe Rank)
forall a b. (a -> b) -> a -> b
$ Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
rank
) ((Maybe Rank, String) -> ((Maybe Rank, Maybe Rank), String))
-> (Maybe Rank, String) -> ((Maybe Rank, Maybe Rank), String)
forall a b. (a -> b) -> a -> b
$ case String
s1 of
Char
c2 : String
s2
| Char -> Bool
Data.Char.isUpper Char
c2 -> case ReadS Rank
forall a. Read a => ReadS a
reads [Char
c2] of
[(Rank
promotionRank, String
"")] -> (Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
promotionRank, String
s2)
[(Rank, String)]
_ -> (Maybe Rank
forall a. Maybe a
Nothing, String
s1)
| Bool
otherwise -> (Maybe Rank
forall a. Maybe a
Nothing, String
s1)
[] -> (Maybe Rank
forall a. Maybe a
Nothing, String
s1)
[(Rank, String)]
_ -> ((Maybe Rank
forall a. Maybe a
Nothing, Maybe Rank
forall a. Maybe a
Nothing), String
remainder)
]
String
_ -> []
instance Attribute.Rank.Promotable (Smith x y) where
getMaybePromotionRank :: Smith x y -> Maybe Rank
getMaybePromotionRank MkSmith { getQualifiedMove :: forall x y. Smith x y -> QualifiedMove x y
getQualifiedMove = QualifiedMove x y
qualifiedMove } = MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank (MoveType -> Maybe Rank) -> MoveType -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove