{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE ViewPatterns        #-}
{-|
Module      : Game.Chess.SAN
Description : Standard Algebraic Notation
Copyright   : (c) Mario Lang, 2021
License     : BSD3
Maintainer  : mlang@blind.guru
Stability   : experimental

Parsers and printers for [Algebraic Notation](https://en.wikipedia.org/wiki/Algebraic_notation_%28chess%29).
-}
module Game.Chess.SAN (
  -- * Conversion
  fromSAN, toSAN, unsafeToSAN
  -- * Parsers
, SANToken, strictSAN, relaxedSAN
  -- * Utilities
, varToSAN
) where

import           Control.Applicative        (Applicative (liftA2))
import           Control.Arrow              ((&&&))
import           Control.Lens               (view)
import           Control.Lens.Iso           (from)
import           Data.Bifunctor             (first)
import qualified Data.ByteString            as Strict (ByteString)
import qualified Data.ByteString.Lazy       as Lazy (ByteString)
import           Data.Char                  (ord)
import           Data.Functor               (($>))
import           Data.List                  (sortOn)
import           Data.List.Extra            (chunksOf)
import           Data.Maybe                 (fromJust)
import           Data.MonoTraversable       (Element, MonoFoldable (otoList))
import           Data.Ord                   (Down (..))
import           Data.Proxy                 (Proxy (..))
import           Data.String                (IsString (fromString))
import qualified Data.Text                  as Strict (Text)
import qualified Data.Text.Lazy             as Lazy (Text)
import           Data.Traversable           (mapAccumL)
import qualified Data.Vector.Unboxed        as Vector
import           Data.Void                  (Void)
import           Data.Word                  (Word8)
import           GHC.Stack                  (HasCallStack)
import           Game.Chess.Internal        (Castle (Kingside, Queenside),
                                             Color (Black, White), PieceType,
                                             Ply, Position (color, moveNumber),
                                             bKscm, bQscm, canCastleKingside,
                                             canCastleQueenside, doPly, inCheck,
                                             isCapture, legalPlies, legalPlies',
                                             pattern Bishop, pattern King,
                                             pattern Knight, pattern Pawn,
                                             pattern Queen, pattern Rook,
                                             pieceAt, plySource, plyTarget,
                                             promoteTo, unpack, unsafeDoPly,
                                             wKscm, wQscm)
import           Game.Chess.Internal.Square
import           Text.Megaparsec            (MonadParsec (token, try), Parsec,
                                             Stream, Token, Tokens,
                                             TraversableStream, VisualStream,
                                             choice, chunk, chunkLength, empty,
                                             errorBundlePretty, option,
                                             optional, parse, (<?>), (<|>))

type Parser s = Parsec Void s

castling :: (Stream s, IsString (Tokens s))
         => Position -> Parser s Ply
castling :: forall s.
(Stream s, IsString (Tokens s)) =>
Position -> Parser s Ply
castling Position
pos
  | Bool
ccks Bool -> Bool -> Bool
&& Bool
ccqs = ParsecT Void s Identity Ply
queenside forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void s Identity Ply
kingside
  | Bool
ccks = ParsecT Void s Identity Ply
kingside
  | Bool
ccqs = ParsecT Void s Identity Ply
queenside
  | Bool
otherwise = forall (f :: * -> *) a. Alternative f => f a
empty
 where
  ccks :: Bool
ccks = Position -> Bool
canCastleKingside Position
pos
  ccqs :: Bool
ccqs = Position -> Bool
canCastleQueenside Position
pos
  kingside :: ParsecT Void s Identity Ply
kingside = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"O-O" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Castle -> Ply
castleMove Castle
Kingside
  queenside :: ParsecT Void s Identity Ply
queenside = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"O-O-O" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Castle -> Ply
castleMove Castle
Queenside
  castleMove :: Castle -> Ply
castleMove Castle
Kingside | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
White = Ply
wKscm
                      | Bool
otherwise          = Ply
bKscm
  castleMove Castle
Queenside | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
White = Ply
wQscm
                       | Bool
otherwise          = Ply
bQscm

data From = F File
          | R Rank
          | RF Square
          deriving (From -> From -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: From -> From -> Bool
$c/= :: From -> From -> Bool
== :: From -> From -> Bool
$c== :: From -> From -> Bool
Eq, Int -> From -> ShowS
[From] -> ShowS
From -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [From] -> ShowS
$cshowList :: [From] -> ShowS
show :: From -> String
$cshow :: From -> String
showsPrec :: Int -> From -> ShowS
$cshowsPrec :: Int -> From -> ShowS
Show)

data SANStatus = Check | Checkmate deriving (SANStatus -> SANStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SANStatus -> SANStatus -> Bool
$c/= :: SANStatus -> SANStatus -> Bool
== :: SANStatus -> SANStatus -> Bool
$c== :: SANStatus -> SANStatus -> Bool
Eq, ReadPrec [SANStatus]
ReadPrec SANStatus
Int -> ReadS SANStatus
ReadS [SANStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SANStatus]
$creadListPrec :: ReadPrec [SANStatus]
readPrec :: ReadPrec SANStatus
$creadPrec :: ReadPrec SANStatus
readList :: ReadS [SANStatus]
$creadList :: ReadS [SANStatus]
readsPrec :: Int -> ReadS SANStatus
$creadsPrec :: Int -> ReadS SANStatus
Read, Int -> SANStatus -> ShowS
[SANStatus] -> ShowS
SANStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SANStatus] -> ShowS
$cshowList :: [SANStatus] -> ShowS
show :: SANStatus -> String
$cshow :: SANStatus -> String
showsPrec :: Int -> SANStatus -> ShowS
$cshowsPrec :: Int -> SANStatus -> ShowS
Show)

class SANToken a where
  sanPieceToken :: a -> Maybe PieceType
  fileToken :: a -> Maybe Int
  rankToken :: a -> Maybe Int
  promotionPieceToken :: a -> Maybe PieceType
  statusToken :: a -> Maybe SANStatus

sanPiece :: (Stream s, SANToken (Token s)) => Parser s PieceType
sanPiece :: forall s. (Stream s, SANToken (Token s)) => Parser s PieceType
sanPiece = forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token forall a. SANToken a => a -> Maybe PieceType
sanPieceToken forall a. Monoid a => a
mempty forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"piece"

fileP :: (Stream s, SANToken (Token s)) => Parser s File
fileP :: forall s. (Stream s, SANToken (Token s)) => Parser s File
fileP = HasCallStack => Int -> File
mkFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token forall a. SANToken a => a -> Maybe Int
fileToken forall a. Monoid a => a
mempty forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"file"
rankP :: (Stream s, SANToken (Token s)) => Parser s Rank
rankP :: forall s. (Stream s, SANToken (Token s)) => Parser s Rank
rankP = HasCallStack => Int -> Rank
mkRank forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token forall a. SANToken a => a -> Maybe Int
rankToken forall a. Monoid a => a
mempty forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"rank"
squareP :: (Stream s, SANToken (Token s)) => Parser s Square
squareP :: forall s. (Stream s, SANToken (Token s)) => Parser s Square
squareP = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' Square (Rank, File)
rankFile)) forall s. (Stream s, SANToken (Token s)) => Parser s File
fileP forall s. (Stream s, SANToken (Token s)) => Parser s Rank
rankP forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"square"

promotionPiece :: (Stream s, SANToken (Token s)) => Parser s PieceType
promotionPiece :: forall s. (Stream s, SANToken (Token s)) => Parser s PieceType
promotionPiece = forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token forall a. SANToken a => a -> Maybe PieceType
promotionPieceToken forall a. Monoid a => a
mempty forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Q, R, B, N"

sanStatus :: (Stream s, SANToken (Token s)) => Parser s SANStatus
sanStatus :: forall s. (Stream s, SANToken (Token s)) => Parser s SANStatus
sanStatus = forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token forall a. SANToken a => a -> Maybe SANStatus
statusToken forall a. Monoid a => a
mempty forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"+, #"

instance SANToken Char where
  sanPieceToken :: Char -> Maybe PieceType
sanPieceToken = \case
    Char
'N' -> forall a. a -> Maybe a
Just PieceType
Knight
    Char
'B' -> forall a. a -> Maybe a
Just PieceType
Bishop
    Char
'R' -> forall a. a -> Maybe a
Just PieceType
Rook
    Char
'Q' -> forall a. a -> Maybe a
Just PieceType
Queen
    Char
'K' -> forall a. a -> Maybe a
Just PieceType
King
    Char
_   -> forall a. Maybe a
Nothing
  fileToken :: Char -> Maybe Int
fileToken Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'h' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'
              | Bool
otherwise  = forall a. Maybe a
Nothing
  rankToken :: Char -> Maybe Int
rankToken Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'8' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1'
              | Bool
otherwise  = forall a. Maybe a
Nothing
  promotionPieceToken :: Char -> Maybe PieceType
promotionPieceToken = \case
    Char
'N' -> forall a. a -> Maybe a
Just PieceType
Knight
    Char
'B' -> forall a. a -> Maybe a
Just PieceType
Bishop
    Char
'R' -> forall a. a -> Maybe a
Just PieceType
Rook
    Char
'Q' -> forall a. a -> Maybe a
Just PieceType
Queen
    Char
_   -> forall a. Maybe a
Nothing
  statusToken :: Char -> Maybe SANStatus
statusToken = \case
    Char
'+' -> forall a. a -> Maybe a
Just SANStatus
Check
    Char
'#' -> forall a. a -> Maybe a
Just SANStatus
Checkmate
    Char
_   -> forall a. Maybe a
Nothing

instance SANToken Word8 where
  sanPieceToken :: Word8 -> Maybe PieceType
sanPieceToken = \case
    Word8
78 -> forall a. a -> Maybe a
Just PieceType
Knight
    Word8
66 -> forall a. a -> Maybe a
Just PieceType
Bishop
    Word8
82 -> forall a. a -> Maybe a
Just PieceType
Rook
    Word8
81 -> forall a. a -> Maybe a
Just PieceType
Queen
    Word8
75 -> forall a. a -> Maybe a
Just PieceType
King
    Word8
_  -> forall a. Maybe a
Nothing
  rankToken :: Word8 -> Maybe Int
rankToken Word8
c | Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
49 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
56 = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
c forall a. Num a => a -> a -> a
- Word8
49
              | Bool
otherwise  = forall a. Maybe a
Nothing
  fileToken :: Word8 -> Maybe Int
fileToken Word8
c | Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
104 = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
c forall a. Num a => a -> a -> a
- Word8
97
              | Bool
otherwise  = forall a. Maybe a
Nothing
  promotionPieceToken :: Word8 -> Maybe PieceType
promotionPieceToken = \case
    Word8
78 -> forall a. a -> Maybe a
Just PieceType
Knight
    Word8
66 -> forall a. a -> Maybe a
Just PieceType
Bishop
    Word8
82 -> forall a. a -> Maybe a
Just PieceType
Rook
    Word8
81 -> forall a. a -> Maybe a
Just PieceType
Queen
    Word8
_  -> forall a. Maybe a
Nothing
  statusToken :: Word8 -> Maybe SANStatus
statusToken = \case
    Word8
43 -> forall a. a -> Maybe a
Just SANStatus
Check
    Word8
35 -> forall a. a -> Maybe a
Just SANStatus
Checkmate
    Word8
_  -> forall a. Maybe a
Nothing

strictSAN :: forall s. (Stream s, SANToken (Token s), IsString (Tokens s))
          => Position -> Parser s Ply
strictSAN :: forall s.
(Stream s, SANToken (Token s), IsString (Tokens s)) =>
Position -> Parser s Ply
strictSAN Position
pos = case Position -> [Ply]
legalPlies Position
pos of
  [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No legal moves in this position"
  [Ply]
ms -> (forall s.
(Stream s, IsString (Tokens s)) =>
Position -> Parser s Ply
castling Position
pos forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Ply] -> Parser s Ply
normal [Ply]
ms) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ply -> Parser s Ply
checkStatus
 where
  normal :: [Ply] -> Parser s Ply
normal [Ply]
ms = do
    PieceType
p <- forall s. (Stream s, SANToken (Token s)) => Parser s PieceType
sanPiece forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure PieceType
Pawn
    case forall a. (a -> Bool) -> [a] -> [a]
filter (PieceType -> Ply -> Bool
pieceFrom PieceType
p) [Ply]
ms of
      [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Position -> Color
color Position
pos) forall a. Semigroup a => a -> a -> a
<> String
" has no " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PieceType
p forall a. Semigroup a => a -> a -> a
<> String
" which could be moved"
      [Ply]
ms' -> PieceType -> [Ply] -> Parser s Ply
target PieceType
p [Ply]
ms'
  pieceFrom :: PieceType -> Ply -> Bool
pieceFrom PieceType
p (Ply -> Square
plySource -> Square
src) = PieceType
p forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> b
snd (forall a. HasCallStack => Maybe a -> a
fromJust (Position -> Square -> Maybe (Color, PieceType)
pieceAt Position
pos Square
src))
  target :: PieceType -> [Ply] -> Parser s Ply
target PieceType
p [Ply]
ms = PieceType -> [Ply] -> Parser s Ply
coords PieceType
p [Ply]
ms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \m :: Ply
m@(Ply -> Square
plyTarget -> Square
to) -> case PieceType
p of
    PieceType
Pawn | Square -> Bool
lastRank Square
to -> Ply -> PieceType -> Ply
promoteTo Ply
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void s Identity PieceType
promotion
    PieceType
_                  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Ply
m
  coords :: PieceType -> [Ply] -> Parser s Ply
coords PieceType
p [Ply]
ms = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk) forall a b. (a -> b) -> a -> b
$
    forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (forall {k} (t :: k). Proxy t
Proxy :: Proxy s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
    (\Ply
m -> (Ply
m, forall s. IsString s => Position -> (PieceType, [Ply]) -> Ply -> s
sanCoords Position
pos (PieceType
p,[Ply]
ms) Ply
m)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ply]
ms
  promotion :: ParsecT Void s Identity PieceType
promotion = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. (Stream s, SANToken (Token s)) => Parser s PieceType
promotionPiece
  lastRank :: Square -> Bool
lastRank (Square -> Rank
rank -> Rank
r) = Rank
r forall a. Eq a => a -> a -> Bool
== Rank
Rank1 Bool -> Bool -> Bool
|| Rank
r forall a. Eq a => a -> a -> Bool
== Rank
Rank8
  checkStatus :: Ply -> Parser s Ply
checkStatus Ply
m
    | Color -> Position -> Bool
inCheck (Position -> Color
color Position
nextPos) Position
nextPos Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Position -> [Ply]
legalPlies Position
nextPos)
    = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"#" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ply
m
    | Color -> Position -> Bool
inCheck (Position -> Color
color Position
nextPos) Position
nextPos
    = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"+" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ply
m
    | Bool
otherwise
    = forall (f :: * -> *) a. Applicative f => a -> f a
pure Ply
m
   where
    nextPos :: Position
nextPos = Position -> Ply -> Position
unsafeDoPly Position
pos Ply
m

relaxedSAN :: (Stream s, SANToken (Token s), IsString (Tokens s))
           => Position -> Parser s Ply
relaxedSAN :: forall s.
(Stream s, SANToken (Token s), IsString (Tokens s)) =>
Position -> Parser s Ply
relaxedSAN Position
pos = (forall s.
(Stream s, IsString (Tokens s)) =>
Position -> Parser s Ply
castling Position
pos forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void s Identity Ply
normal) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall s. (Stream s, SANToken (Token s)) => Parser s SANStatus
sanStatus where
  normal :: ParsecT Void s Identity Ply
normal = do
    PieceType
pc <- forall s. (Stream s, SANToken (Token s)) => Parser s PieceType
sanPiece forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure PieceType
Pawn
    (Maybe From
src, Bool
_, Square
dst) <- forall {b} {c}.
(Maybe File, Maybe Rank, b, c) -> (Maybe From, b, c)
conv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void s Identity (Maybe File, Maybe Rank, Bool, Square)
location
    Maybe PieceType
prm <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"=") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. (Stream s, SANToken (Token s)) => Parser s PieceType
promotionPiece
    case PieceType -> Maybe From -> Square -> Maybe PieceType -> Vector Ply
possible PieceType
pc Maybe From
src Square
dst Maybe PieceType
prm of
      Vector Ply
cand | forall a. Unbox a => Vector a -> Int
Vector.length Vector Ply
cand forall a. Eq a => a -> a -> Bool
== Int
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> Int -> a
Vector.unsafeIndex Vector Ply
cand Int
0
           | forall a. Unbox a => Vector a -> Int
Vector.length Vector Ply
cand forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Illegal move"
      Vector Ply
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Ambiguous move"
  conv :: (Maybe File, Maybe Rank, b, c) -> (Maybe From, b, c)
conv (Maybe File
Nothing, Maybe Rank
Nothing, b
cap, c
to) = (forall a. Maybe a
Nothing, b
cap, c
to)
  conv (Just File
f, Maybe Rank
Nothing, b
cap, c
to) = (forall a. a -> Maybe a
Just (File -> From
F File
f), b
cap, c
to)
  conv (Maybe File
Nothing, Just Rank
r, b
cap, c
to) = (forall a. a -> Maybe a
Just (Rank -> From
R Rank
r), b
cap, c
to)
  conv (Just File
f, Just Rank
r, b
cap, c
to) = (forall a. a -> Maybe a
Just (Square -> From
RF (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' Square (Rank, File)
rankFile) (Rank
r, File
f))), b
cap, c
to)
  location :: ParsecT Void s Identity (Maybe File, Maybe Rank, Bool, Square)
location = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((,forall a. Maybe a
Nothing,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. (Stream s, SANToken (Token s)) => Parser s File
fileP) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void s Identity Bool
capture forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. (Stream s, SANToken (Token s)) => Parser s Square
squareP)
         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((forall a. Maybe a
Nothing,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. (Stream s, SANToken (Token s)) => Parser s Rank
rankP) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void s Identity Bool
capture forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. (Stream s, SANToken (Token s)) => Parser s Square
squareP)
         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. (Stream s, SANToken (Token s)) => Parser s File
fileP) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. (Stream s, SANToken (Token s)) => Parser s Rank
rankP)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void s Identity Bool
capture forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. (Stream s, SANToken (Token s)) => Parser s Square
squareP)
         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>      (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void s Identity Bool
capture forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. (Stream s, SANToken (Token s)) => Parser s Square
squareP
  capture :: ParsecT Void s Identity Bool
capture = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"x" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
  ms :: Vector Ply
ms = Position -> Vector Ply
legalPlies' Position
pos
  possible :: PieceType -> Maybe From -> Square -> Maybe PieceType -> Vector Ply
possible PieceType
pc Maybe From
src Square
dst Maybe PieceType
prm = forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
Vector.filter (Maybe From -> Ply -> Bool
f Maybe From
src) Vector Ply
ms where
    f :: Maybe From -> Ply -> Bool
f (Just (RF Square
sq)) (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src', Square
dst', Maybe PieceType
prm')) =
      Square -> PieceType
pAt Square
src' forall a. Eq a => a -> a -> Bool
== PieceType
pc Bool -> Bool -> Bool
&& Square
src' forall a. Eq a => a -> a -> Bool
== Square
sq Bool -> Bool -> Bool
&& Square
dst' forall a. Eq a => a -> a -> Bool
== Square
dst Bool -> Bool -> Bool
&& Maybe PieceType
prm' forall a. Eq a => a -> a -> Bool
== Maybe PieceType
prm
    f (Just (F File
ff)) (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src', Square
dst', Maybe PieceType
prm')) =
      Square -> PieceType
pAt Square
src' forall a. Eq a => a -> a -> Bool
== PieceType
pc Bool -> Bool -> Bool
&& Square -> File
file Square
src' forall a. Eq a => a -> a -> Bool
== File
ff Bool -> Bool -> Bool
&& Square
dst forall a. Eq a => a -> a -> Bool
== Square
dst' Bool -> Bool -> Bool
&& Maybe PieceType
prm forall a. Eq a => a -> a -> Bool
== Maybe PieceType
prm'
    f (Just (R Rank
fr)) (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src', Square
dst', Maybe PieceType
prm')) =
      Square -> PieceType
pAt Square
src' forall a. Eq a => a -> a -> Bool
== PieceType
pc Bool -> Bool -> Bool
&& Square -> Rank
rank Square
src' forall a. Eq a => a -> a -> Bool
== Rank
fr Bool -> Bool -> Bool
&& Square
dst forall a. Eq a => a -> a -> Bool
== Square
dst' Bool -> Bool -> Bool
&& Maybe PieceType
prm forall a. Eq a => a -> a -> Bool
== Maybe PieceType
prm'
    f Maybe From
Nothing (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src', Square
dst', Maybe PieceType
prm')) =
      Square -> PieceType
pAt Square
src' forall a. Eq a => a -> a -> Bool
== PieceType
pc Bool -> Bool -> Bool
&& Square
dst forall a. Eq a => a -> a -> Bool
== Square
dst' Bool -> Bool -> Bool
&& Maybe PieceType
prm forall a. Eq a => a -> a -> Bool
== Maybe PieceType
prm'
  pAt :: Square -> PieceType
pAt = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Square -> Maybe (Color, PieceType)
pieceAt Position
pos

fromSAN :: (VisualStream s, TraversableStream s, SANToken (Token s), IsString (Tokens s))
        => Position -> s -> Either String Ply
fromSAN :: forall s.
(VisualStream s, TraversableStream s, SANToken (Token s),
 IsString (Tokens s)) =>
Position -> s -> Either String Ply
fromSAN Position
pos = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall s.
(Stream s, SANToken (Token s), IsString (Tokens s)) =>
Position -> Parser s Ply
relaxedSAN Position
pos) String
""

toSAN :: (HasCallStack, IsString s) => Position -> Ply -> s
toSAN :: forall s. (HasCallStack, IsString s) => Position -> Ply -> s
toSAN Position
pos Ply
m
  | Ply
m forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Position -> [Ply]
legalPlies Position
pos = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Position -> Ply -> String
unsafeToSAN Position
pos Ply
m
  | Bool
otherwise               = forall a. HasCallStack => String -> a
error String
"Game.Chess.toSAN: Illegal move"

varToSAN :: (MonoFoldable variation, Element variation ~ Ply, IsString string)
         => Position -> variation -> string
varToSAN :: forall variation string.
(MonoFoldable variation, Element variation ~ Ply,
 IsString string) =>
Position -> variation -> string
varToSAN Position
p = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [Ply] -> String
go Position
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList where
  go :: Position -> [Ply] -> String
go Position
_ [] = String
""
  go Position
pos [Ply]
plies
    | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
Black Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ply]
plies forall a. Eq a => a -> a -> Bool
== Int
1
    = forall a. Show a => a -> String
show (Position -> Int
moveNumber Position
pos) forall a. Semigroup a => a -> a -> a
<> String
"..." forall a. Semigroup a => a -> a -> a
<> forall s. (HasCallStack, IsString s) => Position -> Ply -> s
toSAN Position
pos (forall a. [a] -> a
head [Ply]
plies)
    | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
Black
    = forall a. Show a => a -> String
show (Position -> Int
moveNumber Position
pos) forall a. Semigroup a => a -> a -> a
<> String
"..." forall a. Semigroup a => a -> a -> a
<> forall s. (HasCallStack, IsString s) => Position -> Ply -> s
toSAN Position
pos (forall a. [a] -> a
head [Ply]
plies) forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> Position -> [Ply] -> String
fromWhite (HasCallStack => Position -> Ply -> Position
doPly Position
pos (forall a. [a] -> a
head [Ply]
plies)) (forall a. [a] -> [a]
tail [Ply]
plies)
    | Bool
otherwise
    = Position -> [Ply] -> String
fromWhite Position
pos [Ply]
plies
  fromWhite :: Position -> [Ply] -> String
fromWhite Position
pos = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => a -> [String] -> [String]
f [Position -> Int
moveNumber Position
pos ..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Int -> [a] -> [[a]]
chunksOf Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HasCallStack => Position -> Ply -> Position
doPly forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s. (HasCallStack, IsString s) => Position -> Ply -> s
toSAN)) Position
pos
  f :: a -> [String] -> [String]
f a
n (String
x:[String]
xs) = (forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
"." forall a. Semigroup a => a -> a -> a
<> String
x)forall a. a -> [a] -> [a]
:[String]
xs
  f a
_ []     = []

sanCoords :: IsString s => Position -> (PieceType, [Ply]) -> Ply -> s
sanCoords :: forall s. IsString s => Position -> (PieceType, [Ply]) -> Ply -> s
sanCoords Position
pos (PieceType
pc,[Ply]
lms) m :: Ply
m@(Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src, Square
dst, Maybe PieceType
_)) =
  forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
source forall a. Semigroup a => a -> a -> a
<> String
target
 where
  capture :: Bool
capture = Position -> Ply -> Bool
isCapture Position
pos Ply
m
  source :: String
source
    | PieceType
pc forall a. Eq a => a -> a -> Bool
== PieceType
Pawn Bool -> Bool -> Bool
&& Bool
capture       = [Square -> Char
fileChar Square
src]
    | PieceType
pc forall a. Eq a => a -> a -> Bool
== PieceType
Pawn                  = []
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ply]
ms forall a. Eq a => a -> a -> Bool
== Int
1              = []
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
fEq [Ply]
ms) forall a. Eq a => a -> a -> Bool
== Int
1 = [Square -> Char
fileChar Square
src]
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
rEq [Ply]
ms) forall a. Eq a => a -> a -> Bool
== Int
1 = [Square -> Char
rankChar Square
src]
    | Bool
otherwise                   = forall s. IsString s => Square -> s
toCoord Square
src
  target :: String
target
    | Bool
capture   = String
"x" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => Square -> s
toCoord Square
dst
    | Bool
otherwise = forall s. IsString s => Square -> s
toCoord Square
dst
  ms :: [Ply]
ms = forall a. (a -> Bool) -> [a] -> [a]
filter ((Square
dst forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plyTarget) [Ply]
lms
  fEq :: Ply -> Bool
fEq (Square -> File
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plySource -> File
fl) = File
fl forall a. Eq a => a -> a -> Bool
== File
srcFile
  rEq :: Ply -> Bool
rEq (Square -> Rank
rank forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plySource -> Rank
rnk) = Rank
rnk forall a. Eq a => a -> a -> Bool
== Rank
srcRank
  (Rank
srcRank, File
srcFile) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' Square (Rank, File)
rankFile Square
src

unsafeToSAN :: Position -> Ply -> String
unsafeToSAN :: Position -> Ply -> String
unsafeToSAN Position
pos m :: Ply
m@(Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src, Square
dst, Maybe PieceType
promo)) =
  String
moveStr forall a. Semigroup a => a -> a -> a
<> String
status
 where
  moveStr :: String
moveStr = case PieceType
piece of
    PieceType
Pawn | Bool
capture -> Square -> Char
fileChar Square
src forall a. a -> [a] -> [a]
: String
target forall a. Semigroup a => a -> a -> a
<> String
promotion
         | Bool
otherwise -> String
target forall a. Semigroup a => a -> a -> a
<> String
promotion
    PieceType
King | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
White Bool -> Bool -> Bool
&& Ply
m forall a. Eq a => a -> a -> Bool
== Ply
wKscm -> String
"O-O"
         | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
White Bool -> Bool -> Bool
&& Ply
m forall a. Eq a => a -> a -> Bool
== Ply
wQscm -> String
"O-O-O"
         | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
Black Bool -> Bool -> Bool
&& Ply
m forall a. Eq a => a -> a -> Bool
== Ply
bKscm -> String
"O-O"
         | Position -> Color
color Position
pos forall a. Eq a => a -> a -> Bool
== Color
Black Bool -> Bool -> Bool
&& Ply
m forall a. Eq a => a -> a -> Bool
== Ply
bQscm -> String
"O-O-O"
         | Bool
otherwise -> Char
'K' forall a. a -> [a] -> [a]
: String
target
    PieceType
Knight -> Char
'N' forall a. a -> [a] -> [a]
: String
source forall a. Semigroup a => a -> a -> a
<> String
target
    PieceType
Bishop -> Char
'B' forall a. a -> [a] -> [a]
: String
source forall a. Semigroup a => a -> a -> a
<> String
target
    PieceType
Rook   -> Char
'R' forall a. a -> [a] -> [a]
: String
source forall a. Semigroup a => a -> a -> a
<> String
target
    PieceType
Queen  -> Char
'Q' forall a. a -> [a] -> [a]
: String
source forall a. Semigroup a => a -> a -> a
<> String
target
  piece :: PieceType
piece = forall a b. (a, b) -> b
snd (forall a. HasCallStack => Maybe a -> a
fromJust (Position -> Square -> Maybe (Color, PieceType)
pieceAt Position
pos Square
src))
  capture :: Bool
capture = Position -> Ply -> Bool
isCapture Position
pos Ply
m
  source :: String
source
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ply]
ms forall a. Eq a => a -> a -> Bool
== Int
1              = []
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
fEq [Ply]
ms) forall a. Eq a => a -> a -> Bool
== Int
1 = [Square -> Char
fileChar Square
src]
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
rEq [Ply]
ms) forall a. Eq a => a -> a -> Bool
== Int
1 = [Square -> Char
rankChar Square
src]
    | Bool
otherwise                   = forall s. IsString s => Square -> s
toCoord Square
src
  target :: String
target
    | Bool
capture = String
"x" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => Square -> s
toCoord Square
dst
    | Bool
otherwise = forall s. IsString s => Square -> s
toCoord Square
dst
  promotion :: String
promotion = case Maybe PieceType
promo of
    Just PieceType
Knight -> String
"N"
    Just PieceType
Bishop -> String
"B"
    Just PieceType
Rook   -> String
"R"
    Just PieceType
Queen  -> String
"Q"
    Maybe PieceType
_           -> String
""
  status :: String
status | Color -> Position -> Bool
inCheck (Position -> Color
color Position
nextPos) Position
nextPos Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Position -> [Ply]
legalPlies Position
nextPos) = String
"#"
         | Color -> Position -> Bool
inCheck (Position -> Color
color Position
nextPos) Position
nextPos                              = String
"+"
         | Bool
otherwise                                                    = String
""
  nextPos :: Position
nextPos = Position -> Ply -> Position
unsafeDoPly Position
pos Ply
m
  ms :: [Ply]
ms = forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
movesTo forall a b. (a -> b) -> a -> b
$ Position -> [Ply]
legalPlies Position
pos
  movesTo :: Ply -> Bool
movesTo (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src', Square
dst', Maybe PieceType
_)) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (Position -> Square -> Maybe (Color, PieceType)
pieceAt Position
pos Square
src') forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PieceType
piece Bool -> Bool -> Bool
&& Square
dst' forall a. Eq a => a -> a -> Bool
== Square
dst
  fEq :: Ply -> Bool
fEq (Square -> File
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plySource -> File
thisFile) = File
thisFile forall a. Eq a => a -> a -> Bool
== File
srcFile
  rEq :: Ply -> Bool
rEq (Square -> Rank
rank forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plySource -> Rank
thisRank) = Rank
thisRank forall a. Eq a => a -> a -> Bool
== Rank
srcRank
  (Rank
srcRank, File
srcFile) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' Square (Rank, File)
rankFile Square
src

{-# SPECIALISE relaxedSAN :: Position -> Parser Strict.ByteString Ply #-}
{-# SPECIALISE relaxedSAN :: Position -> Parser Lazy.ByteString Ply #-}
{-# SPECIALISE relaxedSAN :: Position -> Parser Strict.Text Ply #-}
{-# SPECIALISE relaxedSAN :: Position -> Parser Lazy.Text Ply #-}
{-# SPECIALISE relaxedSAN :: Position -> Parser String Ply #-}
{-# SPECIALISE strictSAN :: Position -> Parser Strict.ByteString Ply #-}
{-# SPECIALISE strictSAN :: Position -> Parser Lazy.ByteString Ply #-}
{-# SPECIALISE strictSAN :: Position -> Parser Strict.Text Ply #-}
{-# SPECIALISE strictSAN :: Position -> Parser Lazy.Text Ply #-}
{-# SPECIALISE strictSAN :: Position -> Parser String Ply #-}