{-# 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.Token.Errors (
    ErrorConfig(verifiedCharBadCharsUsedInLiteral, verifiedStringBadCharsUsedInLiteral,
                filterCharNonAscii, filterCharNonLatin1,
                labelCharAscii, labelCharAsciiEnd, labelCharLatin1, labelCharLatin1End,
                labelCharUnicodeEnd, labelCharUnicode,
                labelGraphicCharacter, labelStringCharacter,
                filterStringNonAscii, filterStringNonLatin1,
                labelEscapeEnd, labelEscapeSequence, filterEscapeCharNumericSequenceIllegal,
                filterEscapeCharRequiresExactDigits, labelEscapeNumericEnd, labelEscapeNumeric,
                labelStringEscapeGap, labelStringEscapeGapEnd, labelStringEscapeEmpty,
                labelStringAscii, labelStringAsciiEnd, labelStringLatin1, labelStringLatin1End,
                labelStringUnicode, labelStringUnicodeEnd),
    NotConfigurable (notConfigured)
  )
import Text.Gigaparsec.Internal.Token.Errors (
    checkBadChar, filterS, annotate, mapMaybeS, mapMaybeS',
    LabelWithExplainConfig, LabelConfig
  )
import Text.Gigaparsec.Internal.Token.Generic (
    GenericNumeric(zeroAllowedDecimal, zeroAllowedHexadecimal, zeroAllowedOctal, zeroAllowedBinary)
  )
import Data.Char (isSpace, chr, ord, digitToInt, isAscii, isLatin1)
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 Text.Gigaparsec.State (Ref, make, unsafeMake, gets, update, set, get)
import Text.Gigaparsec.Combinator (guardS, choice, manyTill)
import Control.Applicative (liftA3)
import Data.Maybe (catMaybes)

-- 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 -> ErrorConfig -> CharacterParsers
mkCharacterParsers :: TextDesc -> Escape -> ErrorConfig -> CharacterParsers
mkCharacterParsers TextDesc{Char
CharPredicate
characterLiteralEnd :: TextDesc -> Char
graphicCharacter :: TextDesc -> CharPredicate
characterLiteralEnd :: Char
graphicCharacter :: CharPredicate
..} Escape
escape !ErrorConfig
err = 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 = LabelWithExplainConfig -> LabelConfig -> Parsec Char -> Parsec Char
forall {config} {config} {a}.
(Annotate config, Annotate config) =>
config -> config -> Parsec a -> Parsec a
lit (ErrorConfig -> LabelWithExplainConfig
labelCharUnicode ErrorConfig
err) (ErrorConfig -> LabelConfig
labelCharUnicodeEnd ErrorConfig
err) Parsec Char
uncheckedUniLetter
        ascii :: Parsec Char
ascii = LabelWithExplainConfig -> LabelConfig -> Parsec Char -> Parsec Char
forall {config} {config} {a}.
(Annotate config, Annotate config) =>
config -> config -> Parsec a -> Parsec a
lit (ErrorConfig -> LabelWithExplainConfig
labelCharAscii ErrorConfig
err) (ErrorConfig -> LabelConfig
labelCharAsciiEnd ErrorConfig
err) (VanillaFilterConfig Char
-> (Char -> Bool) -> Parsec Char -> Parsec Char
forall a.
VanillaFilterConfig a -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a.
Filter config =>
config a -> (a -> Bool) -> Parsec a -> Parsec a
filterS (ErrorConfig -> VanillaFilterConfig Char
filterCharNonAscii ErrorConfig
err) (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\x7f') Parsec Char
uncheckedUniLetter)
        latin1 :: Parsec Char
latin1 = LabelWithExplainConfig -> LabelConfig -> Parsec Char -> Parsec Char
forall {config} {config} {a}.
(Annotate config, Annotate config) =>
config -> config -> Parsec a -> Parsec a
lit (ErrorConfig -> LabelWithExplainConfig
labelCharLatin1 ErrorConfig
err) (ErrorConfig -> LabelConfig
labelCharLatin1End ErrorConfig
err) (VanillaFilterConfig Char
-> (Char -> Bool) -> Parsec Char -> Parsec Char
forall a.
VanillaFilterConfig a -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a.
Filter config =>
config a -> (a -> Bool) -> Parsec a -> Parsec a
filterS (ErrorConfig -> VanillaFilterConfig Char
filterCharNonLatin1 ErrorConfig
err) (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xff') Parsec Char
uncheckedUniLetter)

        quote :: Parsec Char
quote = Char -> Parsec Char
char Char
characterLiteralEnd
        lit :: config -> config -> Parsec a -> Parsec a
lit config
label config
endLabel Parsec a
c = config -> Parsec Char -> Parsec Char
forall a. config -> Parsec a -> Parsec a
forall config a. Annotate config => config -> Parsec a -> Parsec a
annotate config
label 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
<* config -> Parsec Char -> Parsec Char
forall a. config -> Parsec a -> Parsec a
forall config a. Annotate config => config -> Parsec a -> Parsec a
annotate config
endLabel 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 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
<|> VerifiedBadChars -> Parsec Char
forall a. VerifiedBadChars -> Parsec a
checkBadChar (ErrorConfig -> VerifiedBadChars
verifiedCharBadCharsUsedInLiteral ErrorConfig
err)

        graphic :: Parsec Char
graphic = LabelWithExplainConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelWithExplainConfig
labelGraphicCharacter ErrorConfig
err) (Parsec Char -> Parsec Char) -> Parsec Char -> Parsec Char
forall a b. (a -> b) -> a -> b
$ 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)

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

mkEscapeChar :: EscapeDesc -> Escape -> Parsec () -> ErrorConfig -> StringChar
mkEscapeChar :: EscapeDesc -> Escape -> Parsec () -> ErrorConfig -> StringChar
mkEscapeChar !EscapeDesc
desc !Escape
esc !Parsec ()
space !ErrorConfig
err = 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 (LabelConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelConfig
labelStringEscapeEmpty ErrorConfig
err) (Parsec Char -> Parsec Char)
-> (Char -> Parsec Char) -> Char -> Parsec Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (LabelConfig -> Parsec () -> Parsec ()
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelConfig
labelStringEscapeGap ErrorConfig
err) Parsec ()
space)
                              Parsec [()] -> Parsec () -> Parsec ()
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LabelConfig -> Parsec () -> Parsec ()
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelConfig
labelStringEscapeGapEnd ErrorConfig
err) (Escape -> Parsec ()
escapeBegin Escape
esc)
          | Bool
otherwise = Parsec ()
forall a. Parsec a
forall (f :: * -> *) a. Alternative f => f a
empty

mkChar :: StringChar -> ErrorConfig -> CharPredicate -> Parsec (Maybe Char)
mkChar :: StringChar -> ErrorConfig -> CharPredicate -> Parsec (Maybe Char)
mkChar StringChar
RawChar !ErrorConfig
err = 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 ((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
<|> VerifiedBadChars -> Parsec (Maybe Char)
forall a. VerifiedBadChars -> Parsec a
checkBadChar (ErrorConfig -> VerifiedBadChars
verifiedStringBadCharsUsedInLiteral ErrorConfig
err)) (Parsec (Maybe Char) -> Parsec (Maybe Char))
-> ((Char -> Bool) -> Parsec (Maybe Char))
-> (Char -> Bool)
-> Parsec (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
. LabelConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelConfig
labelStringCharacter ErrorConfig
err) (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) ErrorConfig
err =
  ((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 -> LabelConfig -> Parsec (Maybe Char) -> Parsec (Maybe Char)
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelConfig
labelStringCharacter ErrorConfig
err) (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
<|> VerifiedBadChars -> Parsec (Maybe Char)
forall a. VerifiedBadChars -> Parsec a
checkBadChar (ErrorConfig -> VerifiedBadChars
verifiedStringBadCharsUsedInLiteral ErrorConfig
err)) (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 (LabelWithExplainConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelWithExplainConfig
labelGraphicCharacter ErrorConfig
err) ((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 (Maybe Char)
stringEsc

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

ensureAscii :: ErrorConfig -> Parsec String -> Parsec String
ensureAscii :: ErrorConfig -> Parsec String -> Parsec String
ensureAscii !ErrorConfig
err = SpecializedFilterConfig String
-> (String -> Bool) -> Parsec String -> Parsec String
forall a.
SpecializedFilterConfig a -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a.
Filter config =>
config a -> (a -> Bool) -> Parsec a -> Parsec a
filterS (ErrorConfig -> SpecializedFilterConfig String
filterStringNonAscii ErrorConfig
err) (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii)

ensureLatin1 :: ErrorConfig -> Parsec String -> Parsec String
ensureLatin1 :: ErrorConfig -> Parsec String -> Parsec String
ensureLatin1 !ErrorConfig
err = SpecializedFilterConfig String
-> (String -> Bool) -> Parsec String -> Parsec String
forall a.
SpecializedFilterConfig a -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a.
Filter config =>
config a -> (a -> Bool) -> Parsec a -> Parsec a
filterS (ErrorConfig -> SpecializedFilterConfig String
filterStringNonLatin1 ErrorConfig
err) (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLatin1)

mkStringParsers :: Set (String, String) -> StringChar -> CharPredicate -> Bool -> ErrorConfig -> StringParsers
mkStringParsers :: Set (String, String)
-> StringChar
-> CharPredicate
-> Bool
-> ErrorConfig
-> StringParsers
mkStringParsers !Set (String, String)
ends !StringChar
stringChar !CharPredicate
isGraphic !Bool
allowsAllSpace !ErrorConfig
err = 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)
-> (Bool -> Bool -> LabelWithExplainConfig)
-> (Bool -> Bool -> LabelConfig)
-> Parsec String
stringLiteral (ErrorConfig -> Parsec String -> Parsec String
ensureAscii ErrorConfig
err) (ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringAscii ErrorConfig
err) (ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringAsciiEnd ErrorConfig
err)
        latin1 :: Parsec String
latin1 = (Parsec String -> Parsec String)
-> (Bool -> Bool -> LabelWithExplainConfig)
-> (Bool -> Bool -> LabelConfig)
-> Parsec String
stringLiteral (ErrorConfig -> Parsec String -> Parsec String
ensureLatin1 ErrorConfig
err) (ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringLatin1 ErrorConfig
err) (ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringLatin1End ErrorConfig
err)
        unicode :: Parsec String
unicode = (Parsec String -> Parsec String)
-> (Bool -> Bool -> LabelWithExplainConfig)
-> (Bool -> Bool -> LabelConfig)
-> Parsec String
stringLiteral Parsec String -> Parsec String
forall a. a -> a
id (ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringUnicode ErrorConfig
err) (ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringUnicodeEnd ErrorConfig
err)

        stringLiteral :: (Parsec String -> Parsec String)
                      -> (Bool -> Bool -> LabelWithExplainConfig)
                      -> (Bool -> Bool -> LabelConfig)
                      -> Parsec String
        stringLiteral :: (Parsec String -> Parsec String)
-> (Bool -> Bool -> LabelWithExplainConfig)
-> (Bool -> Bool -> LabelConfig)
-> Parsec String
stringLiteral Parsec String -> Parsec String
valid Bool -> Bool -> LabelWithExplainConfig
openLabel Bool -> Bool -> LabelConfig
closeLabel =
          [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)
-> (Bool -> Bool -> LabelWithExplainConfig)
-> (Bool -> Bool -> LabelConfig)
-> String
-> String
-> Parsec String
makeStringParser Parsec String -> Parsec String
valid Bool -> Bool -> LabelWithExplainConfig
openLabel Bool -> Bool -> LabelConfig
closeLabel)) (Set (String, String) -> [(String, String)]
forall a. Set a -> [a]
Set.toList Set (String, String)
ends))

        makeStringParser :: (Parsec String -> Parsec String)
                         -> (Bool -> Bool -> LabelWithExplainConfig)
                         -> (Bool -> Bool -> LabelConfig)
                         -> String -> String -> Parsec String
        makeStringParser :: (Parsec String -> Parsec String)
-> (Bool -> Bool -> LabelWithExplainConfig)
-> (Bool -> Bool -> LabelConfig)
-> String
-> String
-> Parsec String
makeStringParser Parsec String -> Parsec String
valid Bool -> Bool -> LabelWithExplainConfig
openLabel Bool -> Bool -> LabelConfig
closeLabel String
begin end :: String
end@(Char
terminalInit : String
_) =
          let strChar :: Parsec (Maybe Char)
strChar = StringChar -> ErrorConfig -> CharPredicate -> Parsec (Maybe Char)
mkChar StringChar
stringChar ErrorConfig
err (Char -> Bool -> CharPredicate -> CharPredicate
letter Char
terminalInit Bool
allowsAllSpace CharPredicate
isGraphic)
          in (LabelWithExplainConfig -> Parsec String -> Parsec String
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (Bool -> Bool -> LabelWithExplainConfig
openLabel Bool
allowsAllSpace (StringChar -> Bool
isRawChar StringChar
stringChar)) (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)
                                      (LabelConfig -> Parsec String -> Parsec String
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelConfig -> Parsec a -> Parsec a
annotate (Bool -> Bool -> LabelConfig
closeLabel Bool
allowsAllSpace (StringChar -> Bool
isRawChar StringChar
stringChar)) (Parsec String -> Parsec String
forall a. Parsec a -> Parsec a
atomic (String -> Parsec String
string String
end)))
        makeStringParser Parsec String -> Parsec String
_ Bool -> Bool -> LabelWithExplainConfig
_ Bool -> Bool -> LabelConfig
_ 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 -> ErrorConfig -> Escape
mkEscape :: EscapeDesc -> GenericNumeric -> ErrorConfig -> 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 !ErrorConfig
err = Escape {Parsec Char
Parsec ()
escapeChar :: Parsec Char
escapeBegin :: Parsec ()
escapeCode :: Parsec Char
escapeBegin :: Parsec ()
escapeCode :: Parsec Char
escapeChar :: Parsec Char
..}
  where
    escapeBegin :: Parsec ()
escapeBegin = LabelWithExplainConfig -> Parsec () -> Parsec ()
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelWithExplainConfig
labelEscapeSequence ErrorConfig
err) (Parsec () -> Parsec ()) -> Parsec () -> Parsec ()
forall a b. (a -> b) -> a -> b
$ Parsec Char -> Parsec ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parsec Char
char Char
escBegin)
    escapeCode :: Parsec Char
escapeCode = LabelWithExplainConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> LabelWithExplainConfig
labelEscapeEnd ErrorConfig
err) (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 -> LabelConfig -> Parsec Integer
zeroAllowedDecimal GenericNumeric
gen LabelConfig
forall config. NotConfigurable config => config
notConfigured) Parsec Char
digit
    hexadecimalEsc :: Parsec Char
hexadecimalEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
16 NumericEscape
hexadecimalEscape (GenericNumeric -> LabelConfig -> Parsec Integer
zeroAllowedHexadecimal GenericNumeric
gen LabelConfig
forall config. NotConfigurable config => config
notConfigured) Parsec Char
hexDigit
    octalEsc :: Parsec Char
octalEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
8 NumericEscape
octalEscape (GenericNumeric -> LabelConfig -> Parsec Integer
zeroAllowedOctal GenericNumeric
gen LabelConfig
forall config. NotConfigurable config => config
notConfigured) Parsec Char
octDigit
    binaryEsc :: Parsec Char
binaryEsc = Int
-> NumericEscape -> Parsec Integer -> Parsec Char -> Parsec Char
fromDesc Int
2 NumericEscape
binaryEscape (GenericNumeric -> LabelConfig -> Parsec Integer
zeroAllowedBinary GenericNumeric
gen LabelConfig
forall config. NotConfigurable config => config
notConfigured) 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 = LabelWithExplainConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> Int -> LabelWithExplainConfig
labelEscapeNumeric ErrorConfig
err Int
radix) (Parsec Char -> Parsec Char) -> Parsec Char -> Parsec Char
forall a b. (a -> b) -> a -> b
$
      (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
*> LabelWithExplainConfig -> Parsec Char -> Parsec Char
forall config a. Annotate config => config -> Parsec a -> Parsec a
forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate (ErrorConfig -> Char -> Int -> LabelWithExplainConfig
labelEscapeNumericEnd ErrorConfig
err Char
c Int
radix) Parsec Char
t)
            (SpecializedFilterConfig Integer
-> (Integer -> Maybe Char) -> Parsec Integer -> Parsec Char
forall a b.
SpecializedFilterConfig a -> (a -> Maybe b) -> Parsec a -> Parsec b
forall (config :: * -> *) a b.
Filter config =>
config a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeS SpecializedFilterConfig Integer
config Integer -> Maybe Char
f Parsec Integer
p)
            Maybe Char
prefix
      where config :: SpecializedFilterConfig Integer
config = ErrorConfig -> Char -> Int -> SpecializedFilterConfig Integer
filterEscapeCharNumericSequenceIllegal ErrorConfig
err Char
maxValue Int
radix
            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

    atMost' :: Int -> Parsec Char -> Ref r Word -> Parsec Integer
    atMost' :: forall r. Int -> Parsec Char -> Ref r Word -> Parsec Integer
atMost' Int
radix Parsec Char
dig Ref 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 (Ref r Word -> (Word -> Bool) -> Parsec Bool
forall r a b. Ref r a -> (a -> b) -> Parsec b
gets Ref 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
<* Ref r Word -> (Word -> Word) -> Parsec ()
forall r a. Ref r a -> (a -> a) -> Parsec ()
update Ref 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. Ref r Word -> Parsec Integer) -> Parsec Integer
forall a b. a -> (forall r. Ref r a -> Parsec b) -> Parsec b
make Word
n (Int -> Parsec Char -> Ref r Word -> Parsec Integer
forall r. Int -> Parsec Char -> Ref 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. Ref r Word -> Parsec Integer) -> Parsec Integer
forall a b. a -> (forall r. Ref r a -> Parsec b) -> Parsec b
make Word
n ((forall r. Ref r Word -> Parsec Integer) -> Parsec Integer)
-> (forall r. Ref r Word -> Parsec Integer) -> Parsec Integer
forall a b. (a -> b) -> a -> b
$ \Ref r Word
atMostR ->
      ((Integer, Word) -> Word)
-> SpecializedFilterConfig Word
-> ((Integer, Word) -> Maybe Integer)
-> Parsec (Integer, Word)
-> Parsec Integer
forall a x b.
(a -> x)
-> SpecializedFilterConfig x
-> (a -> Maybe b)
-> Parsec a
-> Parsec b
forall (config :: * -> *) a x b.
Filter config =>
(a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeS' (Integer, Word) -> Word
forall a b. (a, b) -> b
snd (ErrorConfig -> Int -> NonEmpty Word -> SpecializedFilterConfig Word
filterEscapeCharRequiresExactDigits ErrorConfig
err Int
radix NonEmpty Word
reqDigits)
                 (\(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 -> Ref r Word -> Parsec Integer
forall r. Int -> Parsec Char -> Ref r Word -> Parsec Integer
atMost' Int
radix Parsec Char
dig Ref r Word
atMostR Parsec Integer -> Parsec Word -> Parsec (Integer, Word)
forall a b. Parsec a -> Parsec b -> Parsec (a, b)
<~> Ref r Word -> (Word -> Word) -> Parsec Word
forall r a b. Ref r a -> (a -> b) -> Parsec b
gets Ref r Word
atMostR (Word
full Word -> Word -> Word
forall a. Num a => a -> a -> a
-))

    oneOfExactly' :: NonEmpty Word -> Word -> Word -> [Word] -> Int -> Parsec Char -> Ref r Word -> Parsec Integer
    oneOfExactly' :: forall r.
NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Ref r Word
-> Parsec Integer
oneOfExactly' NonEmpty Word
reqDigits Word
digits Word
m [] Int
radix Parsec Char
dig Ref 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
<* Ref r Word -> Word -> Parsec ()
forall r a. Ref r a -> a -> Parsec ()
set Ref r Word
digitsParsed Word
digits
    oneOfExactly' NonEmpty Word
reqDigits Word
digits Word
m (Word
n:[Word]
ns) Int
radix Parsec Char
dig Ref 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
-> Ref r Word
-> Parsec Integer
forall r.
NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Ref 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 Ref 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
<* Ref r Word -> (Word -> Word) -> Parsec ()
forall r a. Ref r a -> (a -> a) -> Parsec ()
update Ref 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
<|> Ref r Word -> Word -> Parsec ()
forall r a. Ref r a -> a -> Parsec ()
set Ref 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 (Ref r Word -> Parsec Word
forall r a. Ref r a -> Parsec a
get Ref 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. Ref r Word -> Parsec Integer) -> Parsec Integer
forall a b. (forall r. Ref r a -> Parsec b) -> Parsec b
unsafeMake (NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Ref r Word
-> Parsec Integer
forall r.
NonEmpty Word
-> Word
-> Word
-> [Word]
-> Int
-> Parsec Char
-> Ref 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
  }