{-# LANGUAGE Safe #-}
{-# LANGUAGE NoMonomorphismRestriction, BlockArguments, OverloadedLists, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Text.Gigaparsec.Token.Errors (
    ErrorConfig(
      labelNumericBreakChar, labelIntegerUnsignedDecimal,
      labelIntegerUnsignedHexadecimal, labelIntegerUnsignedOctal,
      labelIntegerUnsignedBinary, labelIntegerUnsignedNumber,
      labelIntegerSignedDecimal,
      labelIntegerSignedHexadecimal, labelIntegerSignedOctal,
      labelIntegerSignedBinary, labelIntegerSignedNumber,
      labelIntegerDecimalEnd,
      labelIntegerHexadecimalEnd, labelIntegerOctalEnd,
      labelIntegerBinaryEnd, labelIntegerNumberEnd,
      filterIntegerOutOfBounds,
      labelNameIdentifier, labelNameOperator,
      unexpectedNameIllegalIdentifier, unexpectedNameIllegalOperator,
      filterNameIllFormedIdentifier, filterNameIllFormedOperator,
      labelCharAscii, labelCharLatin1, labelCharUnicode,
      labelCharAsciiEnd, labelCharLatin1End, labelCharUnicodeEnd,
      labelStringAscii, labelStringLatin1, labelStringUnicode,
      labelStringAsciiEnd, labelStringLatin1End, labelStringUnicodeEnd,
      labelStringCharacter, labelGraphicCharacter, labelEscapeSequence,
      labelEscapeNumeric, labelEscapeNumericEnd, labelEscapeEnd,
      labelStringEscapeEmpty, labelStringEscapeGap, labelStringEscapeGapEnd,
      filterCharNonAscii, filterCharNonLatin1, filterStringNonAscii, filterStringNonLatin1,
      filterEscapeCharRequiresExactDigits, filterEscapeCharNumericSequenceIllegal,
      verifiedCharBadCharsUsedInLiteral, verifiedStringBadCharsUsedInLiteral,
      labelSymbol, labelSymbolEndOfKeyword, labelSymbolEndOfOperator,
      labelSpaceEndOfLineComment, labelSpaceEndOfMultiComment
    ),
    defaultErrorConfig,
    LabelWithExplainConfig, LabelWithExplainConfigurable(..),
    LabelConfig, LabelConfigurable(..),
    ExplainConfig, ExplainConfigurable(..),
    NotConfigurable(..),
    FilterConfig,
    VanillaFilterConfig, VanillaFilterConfigurable(..),
    SpecializedFilterConfig, SpecializedFilterConfigurable(..),
    BasicFilterConfigurable(..),
    VerifiedBadChars, badCharsFail, badCharsReason,
    Unverified(..),
    Bits(B8, B16, B32, B64)
  ) where

import Data.Set (Set)
import Data.Map (Map)
import Data.Map qualified as Map (empty)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List.NonEmpty qualified as NonEmpty (toList)
import Data.Kind (Constraint)
import Text.Gigaparsec.Internal.Token.BitBounds (Bits(B8, B16, B32, B64))
import Numeric (showIntAtBase)
import Data.Char (intToDigit, ord)
import Text.Gigaparsec.Errors.DefaultErrorBuilder (from, disjunct, toString)
import Text.Gigaparsec.Internal.Token.Errors (
    LabelWithExplainConfig(LELabelAndReason, LELabel, LEHidden, LEReason, LENotConfigured),
    LabelConfig(LLabel, LHidden, LNotConfigured), ExplainConfig(EReason, ENotConfigured),
    FilterConfig(VSBecause, VSUnexpected, VSUnexpectedBecause, VSBasicFilter, VSSpecializedFilter),
    SpecializedFilterConfig(SSpecializedFilter, SBasicFilter),
    VanillaFilterConfig(VBecause, VUnexpected, VUnexpectedBecause, VBasicFilter),
    VerifiedBadChars(BadCharsUnverified, BadCharsFail, BadCharsReason)
  )

type ErrorConfig :: *
data ErrorConfig =
  ErrorConfig { ErrorConfig -> LabelWithExplainConfig
labelNumericBreakChar :: !LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedDecimal :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedOctal :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedBinary :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedNumber :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedDecimal :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedOctal :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedBinary :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedNumber :: Maybe Bits -> LabelWithExplainConfig
              , ErrorConfig -> LabelConfig
labelIntegerDecimalEnd :: LabelConfig
              , ErrorConfig -> LabelConfig
labelIntegerHexadecimalEnd :: LabelConfig
              , ErrorConfig -> LabelConfig
labelIntegerOctalEnd :: LabelConfig
              , ErrorConfig -> LabelConfig
labelIntegerBinaryEnd :: LabelConfig
              , ErrorConfig -> LabelConfig
labelIntegerNumberEnd :: LabelConfig
              , ErrorConfig -> Integer -> Integer -> Int -> FilterConfig Integer
filterIntegerOutOfBounds :: Integer -> Integer -> Int -> FilterConfig Integer
              , ErrorConfig -> [Char]
labelNameIdentifier :: String
              , ErrorConfig -> [Char]
labelNameOperator :: String
              , ErrorConfig -> [Char] -> [Char]
unexpectedNameIllegalIdentifier :: String -> String
              , ErrorConfig -> [Char] -> [Char]
unexpectedNameIllegalOperator :: String -> String
              , ErrorConfig -> FilterConfig [Char]
filterNameIllFormedIdentifier :: FilterConfig String
              , ErrorConfig -> FilterConfig [Char]
filterNameIllFormedOperator :: FilterConfig String
              , ErrorConfig -> LabelWithExplainConfig
labelCharAscii :: LabelWithExplainConfig
              , ErrorConfig -> LabelWithExplainConfig
labelCharLatin1 :: LabelWithExplainConfig
              , ErrorConfig -> LabelWithExplainConfig
labelCharUnicode :: LabelWithExplainConfig
              , ErrorConfig -> LabelConfig
labelCharAsciiEnd :: LabelConfig
              , ErrorConfig -> LabelConfig
labelCharLatin1End :: LabelConfig
              , ErrorConfig -> LabelConfig
labelCharUnicodeEnd :: LabelConfig
              , ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringAscii :: Bool -> Bool -> LabelWithExplainConfig
              , ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringLatin1 :: Bool -> Bool -> LabelWithExplainConfig
              , ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringUnicode :: Bool -> Bool -> LabelWithExplainConfig
              , ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringAsciiEnd :: Bool -> Bool -> LabelConfig
              , ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringLatin1End :: Bool -> Bool -> LabelConfig
              , ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringUnicodeEnd :: Bool -> Bool -> LabelConfig
              , ErrorConfig -> LabelConfig
labelStringCharacter :: LabelConfig
              , ErrorConfig -> LabelWithExplainConfig
labelGraphicCharacter :: LabelWithExplainConfig
              , ErrorConfig -> LabelWithExplainConfig
labelEscapeSequence :: LabelWithExplainConfig
              , ErrorConfig -> Int -> LabelWithExplainConfig
labelEscapeNumeric :: Int -> LabelWithExplainConfig
              , ErrorConfig -> Char -> Int -> LabelWithExplainConfig
labelEscapeNumericEnd :: Char -> Int -> LabelWithExplainConfig
              , ErrorConfig -> LabelWithExplainConfig
labelEscapeEnd :: LabelWithExplainConfig
              , ErrorConfig -> LabelConfig
labelStringEscapeEmpty :: LabelConfig
              , ErrorConfig -> LabelConfig
labelStringEscapeGap :: LabelConfig
              , ErrorConfig -> LabelConfig
labelStringEscapeGapEnd :: LabelConfig
              , ErrorConfig -> VanillaFilterConfig Char
filterCharNonAscii :: VanillaFilterConfig Char
              , ErrorConfig -> VanillaFilterConfig Char
filterCharNonLatin1 :: VanillaFilterConfig Char
              , ErrorConfig -> SpecializedFilterConfig [Char]
filterStringNonAscii :: SpecializedFilterConfig String
              , ErrorConfig -> SpecializedFilterConfig [Char]
filterStringNonLatin1 :: SpecializedFilterConfig String
              , ErrorConfig -> Int -> NonEmpty Word -> SpecializedFilterConfig Word
filterEscapeCharRequiresExactDigits :: Int -> NonEmpty Word -> SpecializedFilterConfig Word
              , ErrorConfig -> Char -> Int -> SpecializedFilterConfig Integer
filterEscapeCharNumericSequenceIllegal :: Char -> Int -> SpecializedFilterConfig Integer
              , ErrorConfig -> VerifiedBadChars
verifiedCharBadCharsUsedInLiteral :: VerifiedBadChars
              , ErrorConfig -> VerifiedBadChars
verifiedStringBadCharsUsedInLiteral :: VerifiedBadChars
              , ErrorConfig -> Map [Char] LabelWithExplainConfig
labelSymbol :: Map String LabelWithExplainConfig
              -- don't bother with these until parsley standardises
              --, defaultSymbolKeyword :: Labeller
              --, defaultSymbolOperator :: Labeller
              --, defaultSymbolPunctuaton :: Labeller
              , ErrorConfig -> [Char] -> [Char]
labelSymbolEndOfKeyword :: String -> String
              , ErrorConfig -> [Char] -> [Char]
labelSymbolEndOfOperator :: String -> String
              , ErrorConfig -> LabelWithExplainConfig
labelSpaceEndOfLineComment :: LabelWithExplainConfig
              , ErrorConfig -> LabelWithExplainConfig
labelSpaceEndOfMultiComment :: LabelWithExplainConfig
              }

defaultErrorConfig :: ErrorConfig
defaultErrorConfig :: ErrorConfig
defaultErrorConfig = ErrorConfig {[Char]
Map [Char] LabelWithExplainConfig
VerifiedBadChars
SpecializedFilterConfig [Char]
VanillaFilterConfig Char
FilterConfig [Char]
LabelConfig
LabelWithExplainConfig
Bool -> Bool -> LabelConfig
Bool -> Bool -> LabelWithExplainConfig
Char -> Int -> SpecializedFilterConfig Integer
Char -> Int -> LabelWithExplainConfig
Int -> LabelWithExplainConfig
Int -> NonEmpty Word -> SpecializedFilterConfig Word
Integer -> Integer -> Int -> FilterConfig Integer
[Char] -> [Char]
Maybe Bits -> LabelWithExplainConfig
forall {a}. IsString a => a
forall {config}. Unverified config => config
forall {config}. NotConfigurable config => config
forall {config}. LabelWithExplainConfigurable config => config
forall {config}. LabelConfigurable config => config
forall {k} {a}. Map k a
forall {config} {p}. NotConfigurable config => p -> config
forall {config} {p} {p}. NotConfigurable config => p -> p -> config
forall {a} {config :: * -> *}.
(Integral a, SpecializedFilterConfigurable config) =>
Char -> a -> config Integer
forall {config :: * -> *}.
SpecializedFilterConfigurable config =>
Integer -> Integer -> Int -> config Integer
forall {config :: * -> *}.
VanillaFilterConfigurable config =>
config [Char]
forall {config :: * -> *} {a}.
SpecializedFilterConfigurable config =>
config a
forall {config :: * -> *} {a}.
VanillaFilterConfigurable config =>
config a
forall {config :: * -> *} {a} {a} {p}.
(SpecializedFilterConfigurable config, Show a, Show a) =>
p -> NonEmpty a -> config a
labelNumericBreakChar :: LabelWithExplainConfig
labelIntegerUnsignedDecimal :: Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedOctal :: Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedBinary :: Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedNumber :: Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedDecimal :: Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedOctal :: Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedBinary :: Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedNumber :: Maybe Bits -> LabelWithExplainConfig
labelIntegerDecimalEnd :: LabelConfig
labelIntegerHexadecimalEnd :: LabelConfig
labelIntegerOctalEnd :: LabelConfig
labelIntegerBinaryEnd :: LabelConfig
labelIntegerNumberEnd :: LabelConfig
filterIntegerOutOfBounds :: Integer -> Integer -> Int -> FilterConfig Integer
labelNameIdentifier :: [Char]
labelNameOperator :: [Char]
unexpectedNameIllegalIdentifier :: [Char] -> [Char]
unexpectedNameIllegalOperator :: [Char] -> [Char]
filterNameIllFormedIdentifier :: FilterConfig [Char]
filterNameIllFormedOperator :: FilterConfig [Char]
labelCharAscii :: LabelWithExplainConfig
labelCharLatin1 :: LabelWithExplainConfig
labelCharUnicode :: LabelWithExplainConfig
labelCharAsciiEnd :: LabelConfig
labelCharLatin1End :: LabelConfig
labelCharUnicodeEnd :: LabelConfig
labelStringAscii :: Bool -> Bool -> LabelWithExplainConfig
labelStringLatin1 :: Bool -> Bool -> LabelWithExplainConfig
labelStringUnicode :: Bool -> Bool -> LabelWithExplainConfig
labelStringAsciiEnd :: Bool -> Bool -> LabelConfig
labelStringLatin1End :: Bool -> Bool -> LabelConfig
labelStringUnicodeEnd :: Bool -> Bool -> LabelConfig
labelStringCharacter :: LabelConfig
labelGraphicCharacter :: LabelWithExplainConfig
labelEscapeSequence :: LabelWithExplainConfig
labelEscapeNumeric :: Int -> LabelWithExplainConfig
labelEscapeNumericEnd :: Char -> Int -> LabelWithExplainConfig
labelEscapeEnd :: LabelWithExplainConfig
labelStringEscapeEmpty :: LabelConfig
labelStringEscapeGap :: LabelConfig
labelStringEscapeGapEnd :: LabelConfig
filterCharNonAscii :: VanillaFilterConfig Char
filterCharNonLatin1 :: VanillaFilterConfig Char
filterStringNonAscii :: SpecializedFilterConfig [Char]
filterStringNonLatin1 :: SpecializedFilterConfig [Char]
filterEscapeCharRequiresExactDigits :: Int -> NonEmpty Word -> SpecializedFilterConfig Word
filterEscapeCharNumericSequenceIllegal :: Char -> Int -> SpecializedFilterConfig Integer
verifiedCharBadCharsUsedInLiteral :: VerifiedBadChars
verifiedStringBadCharsUsedInLiteral :: VerifiedBadChars
labelSymbol :: Map [Char] LabelWithExplainConfig
labelSymbolEndOfKeyword :: [Char] -> [Char]
labelSymbolEndOfOperator :: [Char] -> [Char]
labelSpaceEndOfLineComment :: LabelWithExplainConfig
labelSpaceEndOfMultiComment :: LabelWithExplainConfig
labelNumericBreakChar :: forall {config}. NotConfigurable config => config
labelIntegerUnsignedDecimal :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerUnsignedHexadecimal :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerUnsignedOctal :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerUnsignedBinary :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerUnsignedNumber :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerSignedDecimal :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerSignedHexadecimal :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerSignedOctal :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerSignedBinary :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerSignedNumber :: forall {config} {p}. NotConfigurable config => p -> config
labelIntegerDecimalEnd :: forall {config}. NotConfigurable config => config
labelIntegerHexadecimalEnd :: forall {config}. NotConfigurable config => config
labelIntegerOctalEnd :: forall {config}. NotConfigurable config => config
labelIntegerBinaryEnd :: forall {config}. NotConfigurable config => config
labelIntegerNumberEnd :: forall {config}. NotConfigurable config => config
filterIntegerOutOfBounds :: forall {config :: * -> *}.
SpecializedFilterConfigurable config =>
Integer -> Integer -> Int -> config Integer
labelNameIdentifier :: forall {a}. IsString a => a
labelNameOperator :: forall {a}. IsString a => a
unexpectedNameIllegalIdentifier :: [Char] -> [Char]
unexpectedNameIllegalOperator :: [Char] -> [Char]
filterNameIllFormedIdentifier :: forall {config :: * -> *}.
VanillaFilterConfigurable config =>
config [Char]
filterNameIllFormedOperator :: forall {config :: * -> *}.
VanillaFilterConfigurable config =>
config [Char]
labelCharAscii :: forall {config}. NotConfigurable config => config
labelCharLatin1 :: forall {config}. NotConfigurable config => config
labelCharUnicode :: forall {config}. NotConfigurable config => config
labelCharAsciiEnd :: forall {config}. NotConfigurable config => config
labelCharLatin1End :: forall {config}. NotConfigurable config => config
labelCharUnicodeEnd :: forall {config}. NotConfigurable config => config
labelStringAscii :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelStringLatin1 :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelStringUnicode :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelStringAsciiEnd :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelStringLatin1End :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelStringUnicodeEnd :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelStringCharacter :: forall {config}. LabelConfigurable config => config
labelGraphicCharacter :: forall {config}. LabelConfigurable config => config
labelEscapeSequence :: forall {config}. LabelConfigurable config => config
labelEscapeNumeric :: forall {config} {p}. NotConfigurable config => p -> config
labelEscapeNumericEnd :: forall {config} {p} {p}. NotConfigurable config => p -> p -> config
labelEscapeEnd :: forall {config}. LabelWithExplainConfigurable config => config
labelStringEscapeEmpty :: forall {config}. NotConfigurable config => config
labelStringEscapeGap :: forall {config}. LabelConfigurable config => config
labelStringEscapeGapEnd :: forall {config}. LabelConfigurable config => config
filterCharNonAscii :: forall {config :: * -> *} {a}.
VanillaFilterConfigurable config =>
config a
filterCharNonLatin1 :: forall {config :: * -> *} {a}.
VanillaFilterConfigurable config =>
config a
filterStringNonAscii :: forall {config :: * -> *} {a}.
SpecializedFilterConfigurable config =>
config a
filterStringNonLatin1 :: forall {config :: * -> *} {a}.
SpecializedFilterConfigurable config =>
config a
filterEscapeCharRequiresExactDigits :: forall {config :: * -> *} {a} {a} {p}.
(SpecializedFilterConfigurable config, Show a, Show a) =>
p -> NonEmpty a -> config a
filterEscapeCharNumericSequenceIllegal :: forall {a} {config :: * -> *}.
(Integral a, SpecializedFilterConfigurable config) =>
Char -> a -> config Integer
verifiedCharBadCharsUsedInLiteral :: forall {config}. Unverified config => config
verifiedStringBadCharsUsedInLiteral :: forall {config}. Unverified config => config
labelSymbol :: forall {k} {a}. Map k a
labelSymbolEndOfKeyword :: [Char] -> [Char]
labelSymbolEndOfOperator :: [Char] -> [Char]
labelSpaceEndOfLineComment :: forall {config}. LabelConfigurable config => config
labelSpaceEndOfMultiComment :: forall {config}. LabelConfigurable config => config
..}
  where labelNumericBreakChar :: config
labelNumericBreakChar = config
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerUnsignedDecimal :: b -> a
labelIntegerUnsignedDecimal = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerUnsignedHexadecimal :: b -> a
labelIntegerUnsignedHexadecimal = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerUnsignedOctal :: b -> a
labelIntegerUnsignedOctal = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerUnsignedBinary :: b -> a
labelIntegerUnsignedBinary = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerUnsignedNumber :: b -> a
labelIntegerUnsignedNumber = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerSignedDecimal :: b -> a
labelIntegerSignedDecimal = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerSignedHexadecimal :: b -> a
labelIntegerSignedHexadecimal = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerSignedOctal :: b -> a
labelIntegerSignedOctal = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerSignedBinary :: b -> a
labelIntegerSignedBinary = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerSignedNumber :: b -> a
labelIntegerSignedNumber = a -> b -> a
forall a b. a -> b -> a
const a
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerDecimalEnd :: config
labelIntegerDecimalEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerHexadecimalEnd :: config
labelIntegerHexadecimalEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerOctalEnd :: config
labelIntegerOctalEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerBinaryEnd :: config
labelIntegerBinaryEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        labelIntegerNumberEnd :: config
labelIntegerNumberEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        filterIntegerOutOfBounds :: Integer -> Integer -> Int -> config Integer
filterIntegerOutOfBounds Integer
small Integer
big Int
nativeRadix = (Integer -> NonEmpty [Char]) -> config Integer
forall a. (a -> NonEmpty [Char]) -> config a
forall (config :: * -> *) a.
SpecializedFilterConfigurable config =>
(a -> NonEmpty [Char]) -> config a
specializedFilter
          (Integer -> Integer -> Int -> Integer -> NonEmpty [Char]
outOfBounds Integer
small Integer
big Int
nativeRadix)
        labelNameIdentifier :: a
labelNameIdentifier = a
"identifier"
        labelNameOperator :: a
labelNameOperator = a
"operator"
        unexpectedNameIllegalIdentifier :: [Char] -> [Char]
unexpectedNameIllegalIdentifier = ([Char]
"keyword " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        unexpectedNameIllegalOperator :: [Char] -> [Char]
unexpectedNameIllegalOperator = ([Char]
"reserved operator " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        filterNameIllFormedIdentifier :: config [Char]
filterNameIllFormedIdentifier = ([Char] -> [Char]) -> config [Char]
forall a. (a -> [Char]) -> config a
forall (config :: * -> *) a.
VanillaFilterConfigurable config =>
(a -> [Char]) -> config a
unexpected ([Char]
"identifier " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        filterNameIllFormedOperator :: config [Char]
filterNameIllFormedOperator = ([Char] -> [Char]) -> config [Char]
forall a. (a -> [Char]) -> config a
forall (config :: * -> *) a.
VanillaFilterConfigurable config =>
(a -> [Char]) -> config a
unexpected ([Char]
"operator " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        labelCharAscii :: config
labelCharAscii = config
forall {config}. NotConfigurable config => config
notConfigured
        labelCharLatin1 :: config
labelCharLatin1 = config
forall {config}. NotConfigurable config => config
notConfigured
        labelCharUnicode :: config
labelCharUnicode = config
forall {config}. NotConfigurable config => config
notConfigured
        labelCharAsciiEnd :: config
labelCharAsciiEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        labelCharLatin1End :: config
labelCharLatin1End = config
forall {config}. NotConfigurable config => config
notConfigured
        labelCharUnicodeEnd :: config
labelCharUnicodeEnd = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringAscii :: p -> p -> config
labelStringAscii p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringLatin1 :: p -> p -> config
labelStringLatin1 p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringUnicode :: p -> p -> config
labelStringUnicode p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringAsciiEnd :: p -> p -> config
labelStringAsciiEnd p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringLatin1End :: p -> p -> config
labelStringLatin1End p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringUnicodeEnd :: p -> p -> config
labelStringUnicodeEnd p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringCharacter :: config
labelStringCharacter = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"string character"]
        labelGraphicCharacter :: config
labelGraphicCharacter = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"graphic character"]
        labelEscapeSequence :: config
labelEscapeSequence = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"escape sequence"]
        labelEscapeNumeric :: p -> config
labelEscapeNumeric p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelEscapeNumericEnd :: p -> p -> config
labelEscapeNumericEnd p
_ p
_ = config
forall {config}. NotConfigurable config => config
notConfigured
        labelEscapeEnd :: config
labelEscapeEnd = Set [Char] -> [Char] -> config
forall config.
LabelWithExplainConfigurable config =>
Set [Char] -> [Char] -> config
labelAndReason [[Char]
Item (Set [Char])
"end of escape sequence"] [Char]
"invalid escape sequence"
        labelStringEscapeEmpty :: config
labelStringEscapeEmpty = config
forall {config}. NotConfigurable config => config
notConfigured
        labelStringEscapeGap :: config
labelStringEscapeGap = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"string gap"]
        labelStringEscapeGapEnd :: config
labelStringEscapeGapEnd = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"end of string gap"]
        filterCharNonAscii :: config a
filterCharNonAscii = (a -> [Char]) -> config a
forall a. (a -> [Char]) -> config a
forall (config :: * -> *) a.
VanillaFilterConfigurable config =>
(a -> [Char]) -> config a
because ([Char] -> a -> [Char]
forall a b. a -> b -> a
const [Char]
"non-ascii character")
        filterCharNonLatin1 :: config a
filterCharNonLatin1 = (a -> [Char]) -> config a
forall a. (a -> [Char]) -> config a
forall (config :: * -> *) a.
VanillaFilterConfigurable config =>
(a -> [Char]) -> config a
because ([Char] -> a -> [Char]
forall a b. a -> b -> a
const [Char]
"non-latin1 character")
        filterStringNonAscii :: config a
filterStringNonAscii =
          (a -> NonEmpty [Char]) -> config a
forall a. (a -> NonEmpty [Char]) -> config a
forall (config :: * -> *) a.
SpecializedFilterConfigurable config =>
(a -> NonEmpty [Char]) -> config a
specializedFilter (NonEmpty [Char] -> a -> NonEmpty [Char]
forall a b. a -> b -> a
const [[Char]
Item (NonEmpty [Char])
"non-ascii characters in string literal, this is not allowed"])
        filterStringNonLatin1 :: config a
filterStringNonLatin1 =
          (a -> NonEmpty [Char]) -> config a
forall a. (a -> NonEmpty [Char]) -> config a
forall (config :: * -> *) a.
SpecializedFilterConfigurable config =>
(a -> NonEmpty [Char]) -> config a
specializedFilter (NonEmpty [Char] -> a -> NonEmpty [Char]
forall a b. a -> b -> a
const [[Char]
Item (NonEmpty [Char])
"non-latin1 characters in string literal, this is not allowed"])
        filterEscapeCharRequiresExactDigits :: p -> NonEmpty a -> config a
filterEscapeCharRequiresExactDigits p
_ NonEmpty a
needed = (a -> NonEmpty [Char]) -> config a
forall a. (a -> NonEmpty [Char]) -> config a
forall (config :: * -> *) a.
SpecializedFilterConfigurable config =>
(a -> NonEmpty [Char]) -> config a
specializedFilter \a
got ->
          let ~(Just StringBuilder
formatted) = Bool -> [[Char]] -> Maybe StringBuilder
disjunct Bool
True ((a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
show (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
needed))
          in [StringBuilder -> [Char]
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
<> a -> StringBuilder
forall a. Show a => a -> StringBuilder
from a
got)]
        filterEscapeCharNumericSequenceIllegal :: Char -> a -> config Integer
filterEscapeCharNumericSequenceIllegal Char
maxEscape a
radix =
          let messages :: Integer -> NonEmpty String
              messages :: Integer -> NonEmpty [Char]
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
maxEscape) = [Char] -> NonEmpty [Char]
forall a. a -> NonEmpty a
singleton ([Char] -> NonEmpty [Char]) -> [Char] -> NonEmpty [Char]
forall a b. (a -> b) -> a -> b
$
                    Integer -> (Int -> Char) -> Integer -> [Char] -> [Char]
forall a. Integral a => a -> (Int -> Char) -> a -> [Char] -> [Char]
showIntAtBase (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
radix) Int -> Char
intToDigit Integer
c
                      ([Char]
" is greater than the maximum character value of "
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> (Int -> Char) -> Integer -> [Char] -> [Char]
forall a. Integral a => a -> (Int -> Char) -> a -> [Char] -> [Char]
showIntAtBase (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
radix) Int -> Char
intToDigit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
maxEscape)) [Char]
"")
                | Bool
otherwise = [Char] -> NonEmpty [Char]
forall a. a -> NonEmpty a
singleton ([Char] -> NonEmpty [Char]) -> [Char] -> NonEmpty [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"illegal unicode character: "
                                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> (Int -> Char) -> Integer -> [Char] -> [Char]
forall a. Integral a => a -> (Int -> Char) -> a -> [Char] -> [Char]
showIntAtBase (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
radix) Int -> Char
intToDigit Integer
c [Char]
""
          in (Integer -> NonEmpty [Char]) -> config Integer
forall a. (a -> NonEmpty [Char]) -> config a
forall (config :: * -> *) a.
SpecializedFilterConfigurable config =>
(a -> NonEmpty [Char]) -> config a
specializedFilter Integer -> NonEmpty [Char]
messages
        verifiedCharBadCharsUsedInLiteral :: config
verifiedCharBadCharsUsedInLiteral = config
forall {config}. Unverified config => config
unverified
        verifiedStringBadCharsUsedInLiteral :: config
verifiedStringBadCharsUsedInLiteral = config
forall {config}. Unverified config => config
unverified
        labelSymbol :: Map k a
labelSymbol = Map k a
forall {k} {a}. Map k a
Map.empty
        -- defaultSymbolKeyword = Label
        -- defaultSymbolOperator = Label
        -- defaultSymbolOperator = NotConfigured
        labelSymbolEndOfKeyword :: [Char] -> [Char]
labelSymbolEndOfKeyword = ([Char]
"end of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        labelSymbolEndOfOperator :: [Char] -> [Char]
labelSymbolEndOfOperator = ([Char]
"end of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        labelSpaceEndOfLineComment :: config
labelSpaceEndOfLineComment = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"end of comment"]
        labelSpaceEndOfMultiComment :: config
labelSpaceEndOfMultiComment = Set [Char] -> config
forall config. LabelConfigurable config => Set [Char] -> config
label [[Char]
Item (Set [Char])
"end of comment"]

outOfBounds :: Integer -> Integer -> Int -> Integer -> NonEmpty String
outOfBounds :: Integer -> Integer -> Int -> Integer -> NonEmpty [Char]
outOfBounds Integer
small Integer
big Int
radix Integer
_n = [Char] -> NonEmpty [Char]
forall a. a -> NonEmpty a
singleton ([Char] -> NonEmpty [Char]) -> [Char] -> NonEmpty [Char]
forall a b. (a -> b) -> a -> b
$
    [Char]
"literal is not within the range " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char] -> [Char]
resign Integer
small ([Char]
" to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char] -> [Char]
resign Integer
big [Char]
"")
  where resign :: Integer -> [Char] -> [Char]
resign Integer
n
          | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = (Char
'-' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Int -> Char) -> Integer -> [Char] -> [Char]
forall a. Integral a => a -> (Int -> Char) -> a -> [Char] -> [Char]
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n)
          | Bool
otherwise = Integer -> (Int -> Char) -> Integer -> [Char] -> [Char]
forall a. Integral a => a -> (Int -> Char) -> a -> [Char] -> [Char]
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit Integer
n

type LabelConfigurable :: * -> Constraint
class LabelConfigurable config where
  label :: Set String -> config
  hidden :: config

instance LabelConfigurable LabelConfig where
  label :: Set [Char] -> LabelConfig
label = Set [Char] -> LabelConfig
LLabel
  hidden :: LabelConfig
hidden = LabelConfig
LHidden
instance LabelConfigurable LabelWithExplainConfig where
  label :: Set [Char] -> LabelWithExplainConfig
label = Set [Char] -> LabelWithExplainConfig
LELabel
  hidden :: LabelWithExplainConfig
hidden = LabelWithExplainConfig
LEHidden

type ExplainConfigurable :: * -> Constraint
class ExplainConfigurable config where
  reason :: String -> config

instance ExplainConfigurable ExplainConfig where reason :: [Char] -> ExplainConfig
reason = [Char] -> ExplainConfig
EReason
instance ExplainConfigurable LabelWithExplainConfig where reason :: [Char] -> LabelWithExplainConfig
reason = [Char] -> LabelWithExplainConfig
LEReason

type LabelWithExplainConfigurable :: * -> Constraint
class LabelWithExplainConfigurable config where
  labelAndReason :: Set String -> String -> config

instance LabelWithExplainConfigurable LabelWithExplainConfig where labelAndReason :: Set [Char] -> [Char] -> LabelWithExplainConfig
labelAndReason = Set [Char] -> [Char] -> LabelWithExplainConfig
LELabelAndReason

type NotConfigurable :: * -> Constraint
class NotConfigurable config where
  notConfigured :: config

instance NotConfigurable LabelWithExplainConfig where notConfigured :: LabelWithExplainConfig
notConfigured = LabelWithExplainConfig
LENotConfigured
instance NotConfigurable LabelConfig where notConfigured :: LabelConfig
notConfigured = LabelConfig
LNotConfigured
instance NotConfigurable ExplainConfig where notConfigured :: ExplainConfig
notConfigured = ExplainConfig
ENotConfigured

type VanillaFilterConfigurable :: (* -> *) -> Constraint
class VanillaFilterConfigurable config where
  unexpected :: (a -> String) -> config a
  because :: (a -> String) -> config a
  unexpectedBecause :: (a -> String) -> (a -> String) -> config a

instance VanillaFilterConfigurable FilterConfig where
  unexpected :: forall a. (a -> [Char]) -> FilterConfig a
unexpected = (a -> [Char]) -> FilterConfig a
forall a. (a -> [Char]) -> FilterConfig a
VSUnexpected
  because :: forall a. (a -> [Char]) -> FilterConfig a
because = (a -> [Char]) -> FilterConfig a
forall a. (a -> [Char]) -> FilterConfig a
VSBecause
  unexpectedBecause :: forall a. (a -> [Char]) -> (a -> [Char]) -> FilterConfig a
unexpectedBecause = (a -> [Char]) -> (a -> [Char]) -> FilterConfig a
forall a. (a -> [Char]) -> (a -> [Char]) -> FilterConfig a
VSUnexpectedBecause

instance VanillaFilterConfigurable VanillaFilterConfig where
  unexpected :: forall a. (a -> [Char]) -> VanillaFilterConfig a
unexpected = (a -> [Char]) -> VanillaFilterConfig a
forall a. (a -> [Char]) -> VanillaFilterConfig a
VUnexpected
  because :: forall a. (a -> [Char]) -> VanillaFilterConfig a
because = (a -> [Char]) -> VanillaFilterConfig a
forall a. (a -> [Char]) -> VanillaFilterConfig a
VBecause
  unexpectedBecause :: forall a. (a -> [Char]) -> (a -> [Char]) -> VanillaFilterConfig a
unexpectedBecause = (a -> [Char]) -> (a -> [Char]) -> VanillaFilterConfig a
forall a. (a -> [Char]) -> (a -> [Char]) -> VanillaFilterConfig a
VUnexpectedBecause

type SpecializedFilterConfigurable :: (* -> *) -> Constraint
class SpecializedFilterConfigurable config where
  specializedFilter :: (a -> NonEmpty String) -> config a

instance SpecializedFilterConfigurable FilterConfig where
  specializedFilter :: forall a. (a -> NonEmpty [Char]) -> FilterConfig a
specializedFilter = (a -> NonEmpty [Char]) -> FilterConfig a
forall a. (a -> NonEmpty [Char]) -> FilterConfig a
VSSpecializedFilter
instance SpecializedFilterConfigurable SpecializedFilterConfig where
  specializedFilter :: forall a. (a -> NonEmpty [Char]) -> SpecializedFilterConfig a
specializedFilter = (a -> NonEmpty [Char]) -> SpecializedFilterConfig a
forall a. (a -> NonEmpty [Char]) -> SpecializedFilterConfig a
SSpecializedFilter

type BasicFilterConfigurable :: (* -> *) -> Constraint
class BasicFilterConfigurable config where
  basicFilter :: config a

instance BasicFilterConfigurable FilterConfig where basicFilter :: forall a. FilterConfig a
basicFilter = FilterConfig a
forall a. FilterConfig a
VSBasicFilter
instance BasicFilterConfigurable VanillaFilterConfig where basicFilter :: forall a. VanillaFilterConfig a
basicFilter = VanillaFilterConfig a
forall a. VanillaFilterConfig a
VBasicFilter
instance BasicFilterConfigurable SpecializedFilterConfig where basicFilter :: forall a. SpecializedFilterConfig a
basicFilter = SpecializedFilterConfig a
forall a. SpecializedFilterConfig a
SBasicFilter

badCharsFail :: Map Char (NonEmpty String) -> VerifiedBadChars
badCharsFail :: Map Char (NonEmpty [Char]) -> VerifiedBadChars
badCharsFail = Map Char (NonEmpty [Char]) -> VerifiedBadChars
BadCharsFail
badCharsReason :: Map Char String -> VerifiedBadChars
badCharsReason :: Map Char [Char] -> VerifiedBadChars
badCharsReason = Map Char [Char] -> VerifiedBadChars
BadCharsReason

type Unverified :: * -> Constraint
class Unverified config where
  unverified :: config

instance Unverified VerifiedBadChars where unverified :: VerifiedBadChars
unverified = VerifiedBadChars
BadCharsUnverified

singleton :: a -> NonEmpty a
singleton :: forall a. a -> NonEmpty a
singleton a
x = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []