{-# LANGUAGE Safe #-}
{-# LANGUAGE OverloadedLists, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.Gigaparsec.Internal.Token.Text (module Text.Gigaparsec.Internal.Token.Text) where

import Text.Gigaparsec (Parsec, void, (<|>), empty, somel, (<~>), ($>), atomic, some)
import Text.Gigaparsec.Char (char, digit, hexDigit, octDigit, bit, satisfy, trie, string)
import Text.Gigaparsec.Token.Descriptions (
    TextDesc(TextDesc, characterLiteralEnd, graphicCharacter),
    EscapeDesc(EscapeDesc, escBegin, emptyEscape, gapsSupported, mapping, literals,
               decimalEscape, hexadecimalEscape, octalEscape, binaryEscape),
    NumericEscape(NumericSupported, NumericIllegal, numDigits, maxValue, prefix),
    CharPredicate,
    NumberOfDigits(Exactly, AtMost, Unbounded)
  )
import Text.Gigaparsec.Internal.Token.Generic (GenericNumeric(zeroAllowedDecimal, zeroAllowedHexadecimal, zeroAllowedOctal, zeroAllowedBinary))
import Data.Char (isSpace, chr, ord, digitToInt, isAscii, isLatin1, intToDigit)
import Data.Map qualified as Map (insert, map)
import Data.Set (Set)
import Data.Set qualified as Set (toList)
import Data.List.NonEmpty (NonEmpty((:|)), sort)
import Data.List.NonEmpty qualified as NonEmpty (toList)
import Text.Gigaparsec.Registers (Reg, make, unsafeMake, gets, modify, put, get)
import Text.Gigaparsec.Combinator (guardS, choice, manyTill)
import Text.Gigaparsec.Errors.Combinator (filterOut, (<?>), label, explain, mapMaybeSWith)
import Control.Applicative (liftA3)
import Data.Maybe (catMaybes)
import Text.Gigaparsec.Errors.ErrorGen (specializedGen, messages)
import Text.Gigaparsec.Errors.DefaultErrorBuilder (disjunct, toString, from)
import Numeric (showIntAtBase)

-- TODO: is it possible to /actually/ support Text/Bytestring in future?
-- Perhaps something like the Numeric stuff?
type TextParsers :: * -> *
data TextParsers t = TextParsers { forall t. TextParsers t -> Parsec t
unicode :: Parsec t
                                 , forall t. TextParsers t -> Parsec t
ascii :: Parsec t
                                 , forall t. TextParsers t -> Parsec t
latin1 :: Parsec t
                                 }

-- I want the convenient naming, sue me
type StringParsers :: *
type StringParsers = TextParsers String

type CharacterParsers :: *
type CharacterParsers = TextParsers Char

mkCharacterParsers :: TextDesc -> Escape -> CharacterParsers
mkCharacterParsers :: TextDesc -> Escape -> CharacterParsers
mkCharacterParsers TextDesc{Char
CharPredicate
characterLiteralEnd :: TextDesc -> Char
graphicCharacter :: TextDesc -> CharPredicate
characterLiteralEnd :: Char
graphicCharacter :: CharPredicate
..} Escape
escape = TextParsers {Parsec Char
unicode :: Parsec Char
ascii :: Parsec Char
latin1 :: Parsec Char
unicode :: Parsec Char
ascii :: Parsec Char
latin1 :: Parsec Char
..}
  where unicode :: Parsec Char
unicode = Parsec Char -> Parsec Char
forall {a}. Parsec a -> Parsec a
lit Parsec Char
uncheckedUniLetter
        ascii :: Parsec Char
ascii = Parsec Char -> Parsec Char
forall {a}. Parsec a -> Parsec a
lit ((Char -> Maybe String) -> Parsec Char -> Parsec Char
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
filterOut (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\x7f' then String -> Maybe String
forall a. a -> Maybe a
Just String
"non-ascii character" else Maybe String
forall a. Maybe a
Nothing) Parsec Char
uncheckedUniLetter)
        latin1 :: Parsec Char
latin1 = Parsec Char -> Parsec Char
forall {a}. Parsec a -> Parsec a
lit ((Char -> Maybe String) -> Parsec Char -> Parsec Char
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
filterOut (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xff' then String -> Maybe String
forall a. a -> Maybe a
Just String
"non-latin1 character" else Maybe String
forall a. Maybe a
Nothing) Parsec Char
uncheckedUniLetter)

        quote :: Parsec Char
quote = Char -> Parsec Char
char Char
characterLiteralEnd
        lit :: Parsec a -> Parsec a
lit Parsec a
c = Parsec Char
quote Parsec Char -> Parsec a -> Parsec a
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec a
c Parsec a -> Parsec Char -> Parsec a
forall a b. Parsec a -> Parsec b -> Parsec a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Char
quote
        uncheckedUniLetter :: Parsec Char
uncheckedUniLetter = Escape -> Parsec Char
escapeChar Escape
escape Parsec Char -> Parsec Char -> Parsec Char
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Char
graphic

        graphic :: Parsec Char
graphic = Parsec Char
-> ((Char -> Bool) -> Parsec Char) -> CharPredicate -> Parsec Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parsec Char
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty (Char -> Bool) -> Parsec Char
satisfy (Char -> Bool -> CharPredicate -> CharPredicate
letter Char
characterLiteralEnd Bool
False CharPredicate
graphicCharacter) Parsec Char -> Set String -> Parsec Char
forall a. Parsec a -> Set String -> Parsec a
<?> [String
Item (Set String)
"graphic character"]

type StringChar :: *
data StringChar = RawChar
                | EscapeChar {-# UNPACK #-} !Char (Parsec (Maybe Char))

mkEscapeChar :: EscapeDesc -> Escape -> Parsec () -> StringChar
mkEscapeChar :: EscapeDesc -> Escape -> Parsec () -> StringChar
mkEscapeChar !EscapeDesc
desc !Escape
esc !Parsec ()
space = Char -> Parsec (Maybe Char) -> StringChar
EscapeChar (EscapeDesc -> Char
escBegin EscapeDesc
desc) Parsec (Maybe Char)
stringEsc
  where stringEsc :: Parsec (Maybe Char)
stringEsc = Escape -> Parsec ()
escapeBegin Escape
esc Parsec () -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parsec ()
escapeGap Parsec () -> Maybe Char -> Parsec (Maybe Char)
forall a b. Parsec a -> b -> Parsec b
$> Maybe Char
forall a. Maybe a
Nothing Parsec (Maybe Char) -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                        Parsec Char
escapeEmpty Parsec Char -> Maybe Char -> Parsec (Maybe Char)
forall a b. Parsec a -> b -> Parsec b
$> Maybe Char
forall a. Maybe a
Nothing Parsec (Maybe Char) -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                        Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Parsec Char -> Parsec (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Escape -> Parsec Char
escapeCode Escape
esc)
        escapeEmpty :: Parsec Char
escapeEmpty = Parsec Char -> (Char -> Parsec Char) -> Maybe Char -> Parsec Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parsec Char
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty Char -> Parsec Char
char (EscapeDesc -> Maybe Char
emptyEscape EscapeDesc
desc)
        escapeGap :: Parsec ()
escapeGap
          | EscapeDesc -> Bool
gapsSupported EscapeDesc
desc = Parsec () -> Parsec [()]
forall a. Parsec a -> Parsec [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parsec ()
space Parsec () -> Set String -> Parsec ()
forall a. Parsec a -> Set String -> Parsec a
<?> [String
Item (Set String)
"string gap"]) Parsec [()] -> Parsec () -> Parsec ()
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Escape -> Parsec ()
escapeBegin Escape
esc Parsec () -> Set String -> Parsec ()
forall a. Parsec a -> Set String -> Parsec a
<?> [String
Item (Set String)
"end of string gap"])
          | Bool
otherwise = Parsec ()
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty

mkChar :: StringChar -> CharPredicate -> Parsec (Maybe Char)
mkChar :: StringChar -> CharPredicate -> Parsec (Maybe Char)
mkChar StringChar
RawChar = Parsec (Maybe Char)
-> ((Char -> Bool) -> Parsec (Maybe Char))
-> CharPredicate
-> Parsec (Maybe Char)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parsec (Maybe Char)
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty ((Char -> Maybe Char) -> Parsec Char -> Parsec (Maybe Char)
forall a b. (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Maybe Char
forall a. a -> Maybe a
Just (Parsec Char -> Parsec (Maybe Char))
-> ((Char -> Bool) -> Parsec Char)
-> (Char -> Bool)
-> Parsec (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String -> Parsec Char -> Parsec Char
forall a. Set String -> Parsec a -> Parsec a
label [String
Item (Set String)
"string character"] (Parsec Char -> Parsec Char)
-> ((Char -> Bool) -> Parsec Char) -> (Char -> Bool) -> Parsec Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Parsec Char
satisfy)
mkChar (EscapeChar Char
escBegin Parsec (Maybe Char)
stringEsc) =
  ((Char -> Bool) -> Parsec (Maybe Char) -> Parsec (Maybe Char))
-> Parsec (Maybe Char) -> CharPredicate -> Parsec (Maybe Char)
forall a b. (a -> b -> b) -> b -> Maybe a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char -> Bool
p -> Set String -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall a. Set String -> Parsec a -> Parsec a
label [String
Item (Set String)
"string character"] (Parsec (Maybe Char) -> Parsec (Maybe Char))
-> (Parsec (Maybe Char) -> Parsec (Maybe Char))
-> Parsec (Maybe Char)
-> Parsec (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsec (Maybe Char) -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Maybe Char) -> Parsec Char -> Parsec (Maybe Char)
forall a b. (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Maybe Char
forall a. a -> Maybe a
Just ((Char -> Bool) -> Parsec Char
satisfy (\Char
c -> Char -> Bool
p Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
escBegin) Parsec Char -> Set String -> Parsec Char
forall a. Parsec a -> Set String -> Parsec a
<?> [String
Item (Set String)
"graphic character"])))
        Parsec (Maybe Char)
stringEsc

isRawChar :: StringChar -> Bool
isRawChar :: StringChar -> Bool
isRawChar StringChar
RawChar = Bool
True
isRawChar EscapeChar{} = Bool
False

ensureAscii :: Parsec String -> Parsec String
ensureAscii :: Parsec String -> Parsec String
ensureAscii = (String -> Maybe String) -> Parsec String -> Parsec String
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
filterOut ((String -> Maybe String) -> Parsec String -> Parsec String)
-> (String -> Maybe String) -> Parsec String -> Parsec String
forall a b. (a -> b) -> a -> b
$ \String
s ->
  if Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii String
s) then String -> Maybe String
forall a. a -> Maybe a
Just String
"non-ascii characters in string literal, this is not allowed"
  else Maybe String
forall a. Maybe a
Nothing

ensureLatin1 :: Parsec String -> Parsec String
ensureLatin1 :: Parsec String -> Parsec String
ensureLatin1 = (String -> Maybe String) -> Parsec String -> Parsec String
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
filterOut ((String -> Maybe String) -> Parsec String -> Parsec String)
-> (String -> Maybe String) -> Parsec String -> Parsec String
forall a b. (a -> b) -> a -> b
$ \String
s ->
  if Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLatin1 String
s) then String -> Maybe String
forall a. a -> Maybe a
Just String
"non-latin1 characters in string literal, this is not allowed"
  else Maybe String
forall a. Maybe a
Nothing

mkStringParsers :: Set (String, String) -> StringChar -> CharPredicate -> Bool -> StringParsers
mkStringParsers :: Set (String, String)
-> StringChar -> CharPredicate -> Bool -> StringParsers
mkStringParsers !Set (String, String)
ends !StringChar
stringChar !CharPredicate
isGraphic !Bool
allowsAllSpace = TextParsers {Parsec String
unicode :: Parsec String
ascii :: Parsec String
latin1 :: Parsec String
ascii :: Parsec String
latin1 :: Parsec String
unicode :: Parsec String
..}
  where ascii :: Parsec String
ascii = (Parsec String -> Parsec String) -> Parsec String
stringLiteral Parsec String -> Parsec String
ensureAscii
        latin1 :: Parsec String
latin1 = (Parsec String -> Parsec String) -> Parsec String
stringLiteral Parsec String -> Parsec String
ensureLatin1
        unicode :: Parsec String
unicode = (Parsec String -> Parsec String) -> Parsec String
stringLiteral Parsec String -> Parsec String
forall a. a -> a
id

        stringLiteral :: (Parsec String -> Parsec String) -> Parsec String
        stringLiteral :: (Parsec String -> Parsec String) -> Parsec String
stringLiteral Parsec String -> Parsec String
valid = [Parsec String] -> Parsec String
forall a. [Parsec a] -> Parsec a
choice (((String, String) -> Parsec String)
-> [(String, String)] -> [Parsec String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Parsec String)
-> (String, String) -> Parsec String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Parsec String -> Parsec String)
-> String -> String -> Parsec String
makeStringParser Parsec String -> Parsec String
valid)) (Set (String, String) -> [(String, String)]
forall a. Set a -> [a]
Set.toList Set (String, String)
ends))

        makeStringParser :: (Parsec String -> Parsec String) -> String -> String -> Parsec String
        makeStringParser :: (Parsec String -> Parsec String)
-> String -> String -> Parsec String
makeStringParser Parsec String -> Parsec String
valid String
begin end :: String
end@(Char
terminalInit : String
_) =
          let strChar :: Parsec (Maybe Char)
strChar = StringChar -> CharPredicate -> Parsec (Maybe Char)
mkChar StringChar
stringChar (Char -> Bool -> CharPredicate -> CharPredicate
letter Char
terminalInit Bool
allowsAllSpace CharPredicate
isGraphic)
          in (String -> Parsec String
string String
begin Parsec String -> Parsec String -> Parsec String
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (Parsec String -> Parsec String)
-> (Parsec String -> Parsec String)
-> Parsec String
-> Parsec String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String -> Parsec String
valid (Parsec String -> Parsec String) -> Parsec String -> Parsec String
forall a b. (a -> b) -> a -> b
$
               [Maybe Char] -> String
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Char] -> String) -> Parsec [Maybe Char] -> Parsec String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Maybe Char) -> Parsec String -> Parsec [Maybe Char]
forall a end. Parsec a -> Parsec end -> Parsec [a]
manyTill (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Parsec Char -> Parsec (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parsec Char
char Char
terminalInit Parsec (Maybe Char) -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec (Maybe Char)
strChar) (Parsec String -> Parsec String
forall {a}. Parsec a -> Parsec a
atomic (String -> Parsec String
string String
end))
        makeStringParser Parsec String -> Parsec String
_ String
_ [] = String -> Parsec String
forall a. HasCallStack => String -> a
error String
"string terminals cannot be empty"

letter :: Char -> Bool -> CharPredicate -> CharPredicate
letter :: Char -> Bool -> CharPredicate -> CharPredicate
letter !Char
terminalLead !Bool
allowsAllSpace (Just Char -> Bool
g)
  | Bool
allowsAllSpace = (Char -> Bool) -> CharPredicate
forall a. a -> Maybe a
Just ((Char -> Bool) -> CharPredicate)
-> (Char -> Bool) -> CharPredicate
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
terminalLead Bool -> Bool -> Bool
&& (Char -> Bool
g Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c)
  | Bool
otherwise      = (Char -> Bool) -> CharPredicate
forall a. a -> Maybe a
Just ((Char -> Bool) -> CharPredicate)
-> (Char -> Bool) -> CharPredicate
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
terminalLead Bool -> Bool -> Bool
&& Char -> Bool
g Char
c
letter Char
_ Bool
_ CharPredicate
Nothing = CharPredicate
forall a. Maybe a
Nothing

type Escape :: *
data Escape = Escape { Escape -> Parsec Char
escapeCode :: !(Parsec Char)
                     , Escape -> Parsec ()
escapeBegin :: !(Parsec ())
                     , Escape -> Parsec Char
escapeChar :: !(Parsec Char)
                     }

mkEscape :: EscapeDesc -> GenericNumeric -> Escape
mkEscape :: EscapeDesc -> GenericNumeric -> Escape
mkEscape EscapeDesc{Bool
Char
Maybe Char
Set Char
Map String Char
NumericEscape
escBegin :: EscapeDesc -> Char
emptyEscape :: EscapeDesc -> Maybe Char
gapsSupported :: EscapeDesc -> Bool
mapping :: EscapeDesc -> Map String Char
literals :: EscapeDesc -> Set Char
decimalEscape :: EscapeDesc -> NumericEscape
hexadecimalEscape :: EscapeDesc -> NumericEscape
octalEscape :: EscapeDesc -> NumericEscape
binaryEscape :: EscapeDesc -> NumericEscape
escBegin :: Char
literals :: Set Char
mapping :: Map String Char
decimalEscape :: NumericEscape
hexadecimalEscape :: NumericEscape
octalEscape :: NumericEscape
binaryEscape :: NumericEscape
emptyEscape :: Maybe Char
gapsSupported :: Bool
..} GenericNumeric
gen = Escape {Parsec Char
Parsec ()
escapeChar :: Parsec Char
escapeBegin :: Parsec ()
escapeCode :: Parsec Char
escapeBegin :: Parsec ()
escapeCode :: Parsec Char
escapeChar :: Parsec Char
..}
  where
    escapeBegin :: Parsec ()
escapeBegin = Parsec Char -> Parsec ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parsec Char
char Char
escBegin) Parsec () -> Set String -> Parsec ()
forall a. Parsec a -> Set String -> Parsec a
<?> [String
Item (Set String)
"escape sequence"]
    escapeCode :: Parsec Char
escapeCode = String -> Parsec Char -> Parsec Char
forall a. String -> Parsec a -> Parsec a
explain String
"invalid escape sequence" (Parsec Char -> Parsec Char) -> Parsec Char -> Parsec Char
forall a b. (a -> b) -> a -> b
$ Set String -> Parsec Char -> Parsec Char
forall a. Set String -> Parsec a -> Parsec a
label [String
Item (Set String)
"end of escape sequence"] (Parsec Char -> Parsec Char) -> Parsec Char -> Parsec Char
forall a b. (a -> b) -> a -> b
$
      Parsec Char
escMapped Parsec Char -> Parsec Char -> Parsec Char
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Char
numericEscape
    escapeChar :: Parsec Char
escapeChar = Parsec ()
escapeBegin Parsec () -> Parsec Char -> Parsec Char
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Char
escapeCode

    escs :: Map String Char
escs = (Char -> Map String Char -> Map String Char)
-> Map String Char -> Set Char -> Map String Char
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c -> String -> Char -> Map String Char -> Map String Char
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char
Item String
c] Char
c) Map String Char
mapping Set Char
literals
    escMapped :: Parsec Char
escMapped = Map String (Parsec Char) -> Parsec Char
forall a. Map String (Parsec a) -> Parsec a
trie ((Char -> Parsec Char)
-> Map String Char -> Map String (Parsec Char)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Char -> Parsec Char
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map String Char
escs)

    numericEscape :: Parsec Char
numericEscape = Parsec Char
decimalEsc Parsec Char -> Parsec Char -> Parsec Char
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Char
hexadecimalEsc Parsec Char -> Parsec Char -> Parsec Char
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Char
octalEsc Parsec Char -> Parsec Char -> Parsec Char
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Char
binaryEsc

    decimalEsc :: Parsec Char
decimalEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
10 NumericEscape
decimalEscape (GenericNumeric -> Parsec Integer
zeroAllowedDecimal GenericNumeric
gen) Parsec Char
digit
    hexadecimalEsc :: Parsec Char
hexadecimalEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
16 NumericEscape
hexadecimalEscape (GenericNumeric -> Parsec Integer
zeroAllowedHexadecimal GenericNumeric
gen) Parsec Char
hexDigit
    octalEsc :: Parsec Char
octalEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
8 NumericEscape
octalEscape (GenericNumeric -> Parsec Integer
zeroAllowedOctal GenericNumeric
gen) Parsec Char
octDigit
    binaryEsc :: Parsec Char
binaryEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
2 NumericEscape
binaryEscape (GenericNumeric -> Parsec Integer
zeroAllowedBinary GenericNumeric
gen) Parsec Char
bit

    boundedChar :: Parsec Integer -> Char -> Maybe Char -> Int -> Parsec Char
    boundedChar :: Parsec Integer -> Char -> Maybe Char -> Int -> Parsec Char
boundedChar Parsec Integer
p Char
maxValue Maybe Char
prefix Int
radix = (Char -> Parsec Char -> Parsec Char)
-> Parsec Char -> Maybe Char -> Parsec Char
forall a b. (a -> b -> b) -> b -> Maybe a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c Parsec Char
t -> Char -> Parsec Char
char Char
c Parsec Char -> Parsec Char -> Parsec Char
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Char
t) (ErrorGen Integer
-> (Integer -> Maybe Char) -> Parsec Integer -> Parsec Char
forall a b. ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSWith ErrorGen Integer
err Integer -> Maybe Char
f Parsec Integer
p) Maybe Char
prefix
      where f :: Integer -> Maybe Char
f Integer
c
             | Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
maxValue) = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
c))
             | Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
            err :: ErrorGen Integer
err = ErrorGen Integer
forall a. ErrorGen a
specializedGen { messages = messages }
            messages :: Integer -> [String]
            messages :: Integer -> [String]
messages Integer
c
              | Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
maxValue) =
                  [Integer -> (Int -> Char) -> Integer -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit Integer
c
                    (String
" is greater than the maximum character value of "
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> (Int -> Char) -> Integer -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
maxValue)) String
"")]
              | Bool
otherwise = [String
"illegal unicode character: "
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> (Int -> Char) -> Integer -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit Integer
c String
""]


    atMost' :: Int -> Parsec Char -> Reg r Word -> Parsec Integer
    atMost' :: forall r. Int -> Parsec Char -> Reg r Word -> Parsec Integer
atMost' Int
radix Parsec Char
dig Reg r Word
atMostR =
      -- FIXME: surely this is an inefficient mess with the translations?
      (Integer -> Char -> Integer)
-> Integer -> Parsec Char -> Parsec Integer
forall b a. (b -> a -> b) -> b -> Parsec a -> Parsec b
somel (\Integer
n Char
d -> Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
d)) Integer
0
            (Parsec Bool -> Parsec ()
guardS (Reg r Word -> (Word -> Bool) -> Parsec Bool
forall r a b. Reg r a -> (a -> b) -> Parsec b
gets Reg r Word
atMostR (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0)) Parsec () -> Parsec Char -> Parsec Char
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Char
dig Parsec Char -> Parsec () -> Parsec Char
forall a b. Parsec a -> Parsec b -> Parsec a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Reg r Word -> (Word -> Word) -> Parsec ()
forall r a. Reg r a -> (a -> a) -> Parsec ()
modify Reg r Word
atMostR Word -> Word
forall a. Enum a => a -> a
pred)

    atMost :: Word -> Int -> Parsec Char -> Parsec Integer
    atMost :: Word -> Int -> Parsec Char -> Parsec Integer
atMost Word
n Int
radix Parsec Char
dig = Word -> (forall r. Reg r Word -> Parsec Integer) -> Parsec Integer
forall a b. a -> (forall r. Reg r a -> Parsec b) -> Parsec b
make Word
n (Int -> Parsec Char -> Reg r Word -> Parsec Integer
forall r. Int -> Parsec Char -> Reg r Word -> Parsec Integer
atMost' Int
radix Parsec Char
dig)

    exactly :: Word -> Word -> Int -> Parsec Char -> NonEmpty Word -> Parsec Integer
    exactly :: Word
-> Word -> Int -> Parsec Char -> NonEmpty Word -> Parsec Integer
exactly Word
n Word
full Int
radix Parsec Char
dig NonEmpty Word
reqDigits = Word -> (forall r. Reg r Word -> Parsec Integer) -> Parsec Integer
forall a b. a -> (forall r. Reg r a -> Parsec b) -> Parsec b
make Word
n ((forall r. Reg r Word -> Parsec Integer) -> Parsec Integer)
-> (forall r. Reg r Word -> Parsec Integer) -> Parsec Integer
forall a b. (a -> b) -> a -> b
$ \Reg r Word
atMostR ->
      ErrorGen (Integer, Word)
-> ((Integer, Word) -> Maybe Integer)
-> Parsec (Integer, Word)
-> Parsec Integer
forall a b. ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSWith (ErrorGen (Integer, Word)
forall a. ErrorGen a
specializedGen {messages = messages})
                    (\(Integer
num, Word
m) -> if Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
full then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
num else Maybe Integer
forall a. Maybe a
Nothing)
                    (Int -> Parsec Char -> Reg r Word -> Parsec Integer
forall r. Int -> Parsec Char -> Reg r Word -> Parsec Integer
atMost' Int
radix Parsec Char
dig Reg r Word
atMostR Parsec Integer -> Parsec Word -> Parsec (Integer, Word)
forall a b. Parsec a -> Parsec b -> Parsec (a, b)
<~> Reg r Word -> (Word -> Word) -> Parsec Word
forall r a b. Reg r a -> (a -> b) -> Parsec b
gets Reg r Word
atMostR (Word
full Word -> Word -> Word
forall a. Num a => a -> a -> a
-))
      where messages :: (Integer, Word) -> [String]
            messages :: (Integer, Word) -> [String]
messages (Integer
_, Word
got) =
              [StringBuilder -> String
toString (StringBuilder
"numeric escape requires " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
formatted StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
"digits, but only got" StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> StringBuilder
forall a. Show a => a -> StringBuilder
from Word
got)]
            ~(Just StringBuilder
formatted) = Bool -> [String] -> Maybe StringBuilder
disjunct Bool
True ((Word -> String) -> [Word] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word -> String
forall a. Show a => a -> String
show (NonEmpty Word -> [Word]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Word
reqDigits))

    oneOfExactly' :: NonEmpty Word -> Word -> Word -> [Word] -> Int -> Parsec Char -> Reg r Word -> Parsec Integer
    oneOfExactly' :: forall r.
NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Reg r Word
-> Parsec Integer
oneOfExactly' NonEmpty Word
reqDigits Word
digits Word
m [] Int
radix Parsec Char
dig Reg r Word
digitsParsed =
      Word
-> Word -> Int -> Parsec Char -> NonEmpty Word -> Parsec Integer
exactly Word
digits Word
m Int
radix Parsec Char
dig NonEmpty Word
reqDigits Parsec Integer -> Parsec () -> Parsec Integer
forall a b. Parsec a -> Parsec b -> Parsec a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Reg r Word -> Word -> Parsec ()
forall r a. Reg r a -> a -> Parsec ()
put Reg r Word
digitsParsed Word
digits
    oneOfExactly' NonEmpty Word
reqDigits Word
digits Word
m (Word
n:[Word]
ns) Int
radix Parsec Char
dig Reg r Word
digitsParsed =
      let theseDigits :: Parsec Integer
theseDigits = Word
-> Word -> Int -> Parsec Char -> NonEmpty Word -> Parsec Integer
exactly Word
digits Word
m Int
radix Parsec Char
dig NonEmpty Word
reqDigits
          restDigits :: Parsec (Maybe Integer)
restDigits =
                Parsec (Maybe Integer) -> Parsec (Maybe Integer)
forall {a}. Parsec a -> Parsec a
atomic (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> Parsec Integer -> Parsec (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Reg r Word
-> Parsec Integer
forall r.
NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Reg r Word
-> Parsec Integer
oneOfExactly' NonEmpty Word
reqDigits (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
m) Word
n [Word]
ns Int
radix Parsec Char
dig Reg r Word
digitsParsed
                     Parsec (Maybe Integer) -> Parsec () -> Parsec (Maybe Integer)
forall a b. Parsec a -> Parsec b -> Parsec a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Reg r Word -> (Word -> Word) -> Parsec ()
forall r a. Reg r a -> (a -> a) -> Parsec ()
modify Reg r Word
digitsParsed (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
digits))
            Parsec (Maybe Integer)
-> Parsec (Maybe Integer) -> Parsec (Maybe Integer)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Reg r Word -> Word -> Parsec ()
forall r a. Reg r a -> a -> Parsec ()
put Reg r Word
digitsParsed Word
digits Parsec () -> Maybe Integer -> Parsec (Maybe Integer)
forall a b. Parsec a -> b -> Parsec b
$> Maybe Integer
forall a. Maybe a
Nothing
          combine :: Integer -> Maybe Integer -> Word -> Integer
combine !Integer
x Maybe Integer
Nothing !Word
_ = Integer
x
          -- digits is removed here, because it's been added before the get
          combine Integer
x (Just Integer
y) Word
e = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix Integer -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
e Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
digits) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y
      in (Integer -> Maybe Integer -> Word -> Integer)
-> Parsec Integer
-> Parsec (Maybe Integer)
-> Parsec Word
-> Parsec Integer
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Integer -> Maybe Integer -> Word -> Integer
combine Parsec Integer
theseDigits Parsec (Maybe Integer)
restDigits (Reg r Word -> Parsec Word
forall r a. Reg r a -> Parsec a
get Reg r Word
digitsParsed)

    oneOfExactly :: NonEmpty Word -> Int -> Parsec Char -> Parsec Integer
    oneOfExactly :: NonEmpty Word -> Int -> Parsec Char -> Parsec Integer
oneOfExactly NonEmpty Word
ns Int
radix Parsec Char
dig =
      let reqDigits :: NonEmpty Word
reqDigits@(Word
m :| [Word]
ms) = NonEmpty Word -> NonEmpty Word
forall a. Ord a => NonEmpty a -> NonEmpty a
sort NonEmpty Word
ns
      in (forall r. Reg r Word -> Parsec Integer) -> Parsec Integer
forall a b. (forall r. Reg r a -> Parsec b) -> Parsec b
unsafeMake (NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Reg r Word
-> Parsec Integer
forall r.
NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Reg r Word
-> Parsec Integer
oneOfExactly' NonEmpty Word
reqDigits Word
m Word
m [Word]
ms Int
radix Parsec Char
dig)

    fromDesc :: Int -> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
    fromDesc :: Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc !Int
_ NumericEscape
NumericIllegal !Parsec Integer
_ !Parsec Char
_ = Parsec Char
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty
    fromDesc Int
radix NumericSupported{Char
Maybe Char
NumberOfDigits
numDigits :: NumericEscape -> NumberOfDigits
maxValue :: NumericEscape -> Char
prefix :: NumericEscape -> Maybe Char
prefix :: Maybe Char
numDigits :: NumberOfDigits
maxValue :: Char
..} Parsec Integer
integer Parsec Char
dig = case NumberOfDigits
numDigits of
      NumberOfDigits
Unbounded  -> Parsec Integer -> Char -> Maybe Char -> Int -> Parsec Char
boundedChar Parsec Integer
integer Char
maxValue Maybe Char
prefix Int
radix
      AtMost Word
n   -> Parsec Integer -> Char -> Maybe Char -> Int -> Parsec Char
boundedChar (Word -> Int -> Parsec Char -> Parsec Integer
atMost Word
n Int
radix Parsec Char
dig) Char
maxValue Maybe Char
prefix Int
radix
      Exactly NonEmpty Word
ns -> Parsec Integer -> Char -> Maybe Char -> Int -> Parsec Char
boundedChar (NonEmpty Word -> Int -> Parsec Char -> Parsec Integer
oneOfExactly NonEmpty Word
ns Int
radix Parsec Char
dig) Char
maxValue Maybe Char
prefix Int
radix

lexeme :: (forall a. Parsec a -> Parsec a) -> TextParsers t -> TextParsers t
lexeme :: forall t.
(forall {a}. Parsec a -> Parsec a)
-> TextParsers t -> TextParsers t
lexeme forall {a}. Parsec a -> Parsec a
lexe TextParsers{Parsec t
unicode :: forall t. TextParsers t -> Parsec t
ascii :: forall t. TextParsers t -> Parsec t
latin1 :: forall t. TextParsers t -> Parsec t
unicode :: Parsec t
ascii :: Parsec t
latin1 :: Parsec t
..} = TextParsers {
    unicode :: Parsec t
unicode = Parsec t -> Parsec t
forall {a}. Parsec a -> Parsec a
lexe Parsec t
unicode,
    ascii :: Parsec t
ascii = Parsec t -> Parsec t
forall {a}. Parsec a -> Parsec a
lexe Parsec t
ascii,
    latin1 :: Parsec t
latin1 = Parsec t -> Parsec t
forall {a}. Parsec a -> Parsec a
lexe Parsec t
latin1
  }