module BishBosh.Notation.Smith(
Smith(
getQualifiedMove
),
notation,
regexSyntax,
fromQualifiedMove
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Notation.Notation as Notation.Notation
import qualified BishBosh.Notation.PureCoordinate as Notation.PureCoordinate
import qualified Control.Arrow
import qualified Data.Char
import qualified Data.Default
import qualified Data.List.Extra
import qualified Data.Maybe
notation :: Notation.Notation.Notation
notation :: Notation
notation = Notation
Notation.PureCoordinate.notation
enpassantTag :: Char
enpassantTag :: Char
enpassantTag = Char
'E'
shortCastleTag :: Char
shortCastleTag :: Char
shortCastleTag = Char
'c'
longCastleTag :: Char
longCastleTag :: Char
longCastleTag = Char
'C'
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
. Char -> ShowS
showChar Char
enpassantTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
shortCastleTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
longCastleTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]?[" 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 -> 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
"]?"
newtype Smith = MkSmith {
Smith -> QualifiedMove
getQualifiedMove :: Component.QualifiedMove.QualifiedMove
} deriving Smith -> Smith -> Bool
(Smith -> Smith -> Bool) -> (Smith -> Smith -> Bool) -> Eq Smith
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Smith -> Smith -> Bool
$c/= :: Smith -> Smith -> Bool
== :: Smith -> Smith -> Bool
$c== :: Smith -> Smith -> Bool
Eq
fromQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Smith
fromQualifiedMove :: QualifiedMove -> Smith
fromQualifiedMove = QualifiedMove -> Smith
MkSmith
instance Show Smith where
showsPrec :: Int -> Smith -> ShowS
showsPrec Int
_ MkSmith { getQualifiedMove :: Smith -> QualifiedMove
getQualifiedMove = QualifiedMove
qualifiedMove } = let
(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
in 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
. (
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
shortCastleTag
else Char
longCastleTag
MoveType
Attribute.MoveType.EnPassant -> Char -> ShowS
showChar Char
enpassantTag
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 Read Smith where
readsPrec :: Int -> ReadS Smith
readsPrec Int
_ String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
x : Char
y : Char
x' : Char
y' : String
remainder -> [
(
QualifiedMove -> Smith
fromQualifiedMove (QualifiedMove -> Smith) -> QualifiedMove -> Smith
forall a b. (a -> b) -> a -> b
$ Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination) MoveType
moveType,
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,
(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 where
getMaybePromotionRank :: Smith -> Maybe Rank
getMaybePromotionRank MkSmith { getQualifiedMove :: Smith -> QualifiedMove
getQualifiedMove = QualifiedMove
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 -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove