{-# LANGUAGE Safe #-}
{-# LANGUAGE NoMonomorphismRestriction, BlockArguments, OverloadedLists, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
  {-|
Module      : Text.Gigaparsec.Token.Errors
Description : This module contains the relevant functionality for configuring the error messages generated by the parsers provided by the Lexer.
License     : BSD-3-Clause
Maintainer  : Jamie Willis, Gigaparsec Maintainers
Stability   : experimental

This module contains the relevant functionality for configuring the error messages generated by the parsers provided by the 'Text.Gigaparsec.Token.Lexer.Lexer'.

@since 0.2.2.0
-}
module Text.Gigaparsec.Token.Errors (
    -- ** Error Configuration
    -- | This is the main type that defines the configuration for errors from the Lexer.
    ErrorConfig,
    -- *** Labelling and Explanation Configuration
    {-| 
    Labels and Explanations make parser errors more descriptive, by giving a name to the parser that failed, or providing a reason a particular parser failed.
    These help make error messages more descriptive than the usual 'unexpected symbol' messages.

    'LabelConfigurable' types describe errors that can provide labels upon failure, 
    'ExplainConfigurable' types those that can providing reaons for failure, 
    and 'LabelWithExplainConfigurable' types those that can provide both.    
    These configs are used by the 'ErrorConfig', whose fields include combinators that configure both labels and/or explains for simple description configurations.
    -}
    -- **** Label Configurations 
    {-| 
    Labels provide names to a parser to be used upon failure.
    A 'LabelConfig' or 'LabelConfigurable' type is able to produce these sorts of errors.
    -}
    LabelConfig, LabelConfigurable(..),
    -- **** Explain Configurations 
    {-| 
    Explains provide a reason that a parser has failed.
    An 'ExplainConfig' or 'ExplainConfigurable' type is able to produce these sorts of errors.
    -}
    ExplainConfig, ExplainConfigurable(..),
    -- **** Label-with-Explain Configurations 
    {-| 
    'LabelWithExplainConfig' combines 'LabelConfig' and 'ExplainConfig', 
    describing configs that are able to give labels and/or reasons to errors.

    'LabelWithExplainConfigurable' types are those able to produce an error providing both labels and a reason.
    -}
    LabelWithExplainConfig, LabelWithExplainConfigurable(..),
    -- **** No-special-error-generating Configs
    {-|
    Sometimes it is best to defer to the default errors, instead of generating specialised ones.
    Configs that allow this are 'NotConfigurable'.
    -}
    NotConfigurable(..),
    -- *** Numeric Errors
    {-|
    These control the errors generated with the numeric ('Text.Gigaparsec.Token.Descriptions.NumericDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.
    -}
    labelNumericBreakChar, labelIntegerUnsignedDecimal,
    labelIntegerUnsignedHexadecimal, labelIntegerUnsignedOctal,
    labelIntegerUnsignedBinary, labelIntegerUnsignedNumber,
    labelIntegerSignedDecimal,
    labelIntegerSignedHexadecimal, labelIntegerSignedOctal,
    labelIntegerSignedBinary, labelIntegerSignedNumber,
    labelIntegerDecimalEnd,
    labelIntegerHexadecimalEnd, labelIntegerOctalEnd,
    labelIntegerBinaryEnd, labelIntegerNumberEnd,
    filterIntegerOutOfBounds,
    -- **** Bit-Widths
    {-|
    Some of the numeric errors can take into account the supposed bit-width of the parsed data.
    
    Using 'Bits' achieves this.
    -}
    Bits(B8, B16, B32, B64),
    -- *** Name Errors
    {-|
    These control the errors generated with the names ('Text.Gigaparsec.Token.Descriptions.NameDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.
    -}
    labelNameIdentifier, labelNameOperator,
    unexpectedNameIllegalIdentifier, unexpectedNameIllegalOperator,
    filterNameIllFormedIdentifier, filterNameIllFormedOperator,
     -- *** Text Errors
    {-|
    These control the errors generated with the text ('Text.Gigaparsec.Token.Descriptions.TextDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.
    -}
    labelCharAscii, labelCharLatin1, labelCharUnicode,
    labelCharAsciiEnd, labelCharLatin1End, labelCharUnicodeEnd,
    labelStringAscii, labelStringLatin1, labelStringUnicode,
    labelStringAsciiEnd, labelStringLatin1End, labelStringUnicodeEnd,
    labelStringCharacter, labelGraphicCharacter, labelEscapeSequence,
    labelEscapeNumeric, labelEscapeNumericEnd, labelEscapeEnd,
    labelStringEscapeEmpty, labelStringEscapeGap, labelStringEscapeGapEnd,
    -- *** Filtering Errors
    {-|
    These configs and combinators describe how to generate the filters to rule out specific parses. 
    They can generate types of vanilla error or specialised errors.
    -}
    -- **** Filtering Configs
    FilterConfig,
    BasicFilterConfigurable(..),
    VanillaFilterConfig, VanillaFilterConfigurable(..),
    SpecializedFilterConfig, SpecializedFilterConfigurable(..),
    -- **** Filtering Combinators
    filterCharNonAscii, filterCharNonLatin1, filterStringNonAscii, filterStringNonLatin1,
    filterEscapeCharRequiresExactDigits, filterEscapeCharNumericSequenceIllegal,
    -- *** Verifying Bad Characters 
    {-|
    These types and combinators help implement the Verified Error™ pattern for illegal string and literal characters.
    -}
    -- **** Configs
    {-|
    These types help configure the Verified Error pattern for illegal string and character literal characters, 
    used by 'verifiedCharBadCharsUsedInLiteral' and 'verifiedStringBadCharsUsedInLiteral'.
    -}
    VerifiedBadChars, 
    Unverified(..),
    -- **** Combinators
    badCharsFail, badCharsReason,
    verifiedCharBadCharsUsedInLiteral, verifiedStringBadCharsUsedInLiteral,
    -- *** Symbol Errors
    {-| 
    These control the errors generated with the symbol ('Text.Gigaparsec.Token.Descriptions.SymbolDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'
    -}
    labelSymbol, labelSymbolEndOfKeyword, labelSymbolEndOfOperator,
    -- *** Space Errors
    {-| 
    These control the errors generated with the space ('Text.Gigaparsec.Token.Descriptions.SpaceDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.
    -}
    labelSpaceEndOfLineComment, labelSpaceEndOfMultiComment,
    -- ** The Default Configuration
    defaultErrorConfig,
  ) 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)
  )

{-|
An 'ErrorConfig' specifies how errors should be produced by the 'Text.Gigaparsec.Token.Lexer.Lexer'.

The Lexer is set up to produce a variety of different errors via @label@-ing, @explain@-ing, and @filter@-ing, 
and some applications of the Verified and Preventative error patterns. 
The exact content of those errors can be configured here. 
Errors can be suppressed or specified with different levels of detail, 
or even switching between vanilla or specialised errors.

A custom 'ErrorConfig' should be created by extending the 'defaultErrorConfig' 
with record updates to override the relevant default fields.
Not configuring something does not mean it will not appear in the message, 
but will mean it uses the underlying base errors.
-}
type ErrorConfig :: *
data ErrorConfig =
  ErrorConfig { 
  -- | How a numeric break character should (like @_@) be referred to or explained within an error.
    ErrorConfig -> LabelWithExplainConfig
labelNumericBreakChar :: !LabelWithExplainConfig
  -- | How unsigned decimal integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedDecimal :: Maybe Bits -> LabelWithExplainConfig
  -- | How unsigned hexadecimal integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig
  -- | How unsigned octal integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedOctal :: Maybe Bits -> LabelWithExplainConfig
  -- | How unsigned binary integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedBinary :: Maybe Bits -> LabelWithExplainConfig
  -- | How generic unsigned integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerUnsignedNumber :: Maybe Bits -> LabelWithExplainConfig
  -- | How signed decimal integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedDecimal :: Maybe Bits -> LabelWithExplainConfig
  -- | How signed hexadecimal integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig
  -- | How signed octal integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedOctal :: Maybe Bits -> LabelWithExplainConfig
  -- | How signed binary integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedBinary :: Maybe Bits -> LabelWithExplainConfig
  -- | How generic signed integers (of a possibly given bit-width) should be referred to or explained within an error.
  , ErrorConfig -> Maybe Bits -> LabelWithExplainConfig
labelIntegerSignedNumber :: Maybe Bits -> LabelWithExplainConfig
  -- | How the fact that the end of a decimal integer literal is expected should be referred to within an error.
  , ErrorConfig -> LabelConfig
labelIntegerDecimalEnd :: LabelConfig
  -- | How the fact that the end of a hexadecimal integer literal is expected should be referred to within an error.
  , ErrorConfig -> LabelConfig
labelIntegerHexadecimalEnd :: LabelConfig
  -- | How the fact that the end of an octal integer literal is expected should be referred to within an error.
  , ErrorConfig -> LabelConfig
labelIntegerOctalEnd :: LabelConfig
  -- | How the fact that the end of a binary integer literal is expected should be referred to within an error.
  , ErrorConfig -> LabelConfig
labelIntegerBinaryEnd :: LabelConfig
  -- | How the fact that the end of a generic integer literal is expected should be referred to within an error.
  , ErrorConfig -> LabelConfig
labelIntegerNumberEnd :: LabelConfig
  -- | Describes the content of the error when an integer literal is parsed and it is not within the required bit-width.
  --
  -- In @'filterIntegerOutOfBounds' x y r@: 
  --
  --  - @x@ is the smallest value the integer could have taken, 
  --  - @y@ is the largest value the integer could have taken, and
  --  - @r@ is the radix that the integer was parsed using
  , ErrorConfig -> Integer -> Integer -> Int -> FilterConfig Integer
filterIntegerOutOfBounds  :: Integer
                              -> Integer 
                              -> Int 
                              -> FilterConfig Integer
  -- | How an identifier should be referred to in an error message.
  , ErrorConfig -> [Char]
labelNameIdentifier :: String
  -- | How a user-defined operator should be referred to in an error message.
  , ErrorConfig -> [Char]
labelNameOperator :: String
  -- | How an illegally parsed hard keyword should be referred to as an unexpected component.
  , ErrorConfig -> [Char] -> [Char]
unexpectedNameIllegalIdentifier :: String -> String
  -- | How an illegally parsed hard operator should be referred to as an unexpected component.
  , ErrorConfig -> [Char] -> [Char]
unexpectedNameIllegalOperator :: String -> String
  -- | When parsing identifiers that are required to have specific start characters, how bad identifiers should be reported.
  , ErrorConfig -> FilterConfig [Char]
filterNameIllFormedIdentifier :: FilterConfig String
  -- | When parsing operators that are required to have specific start/end characters, how bad operators should be reported.
  , ErrorConfig -> FilterConfig [Char]
filterNameIllFormedOperator :: FilterConfig String
  -- | How an ASCII character literal should be referred to or explained in error messages.
  , ErrorConfig -> LabelWithExplainConfig
labelCharAscii :: LabelWithExplainConfig
  -- | How a Latin1 (extended ASCII) character literal should be referred to or explained in error messages.
  , ErrorConfig -> LabelWithExplainConfig
labelCharLatin1 :: LabelWithExplainConfig
  -- | How a UTF-16 character literal should be referred to or explained in error messages.
  , ErrorConfig -> LabelWithExplainConfig
labelCharUnicode :: LabelWithExplainConfig
  -- | How the closing quote of an ASCII character literal should be referred to in error messages.
  , ErrorConfig -> LabelConfig
labelCharAsciiEnd :: LabelConfig
  -- | How the closing quote of a Latin1 (extended ASCII) character literal should be referred to in error messages.
  , ErrorConfig -> LabelConfig
labelCharLatin1End :: LabelConfig
  -- | How the closing quote of a UTF-16 character literal should be referred to in error messages.
  , ErrorConfig -> LabelConfig
labelCharUnicodeEnd :: LabelConfig
  {-| How an ASCII-only string should literal be referred to or explained in error messages.

  With the arguments @'labelStringAscii' multi raw@:

  - @multi@: whether this is for a multi-line string
  - @raw@: whether this is for a raw string
  -}
  , ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringAscii :: Bool -> Bool -> LabelWithExplainConfig
  {-| How a Latin1-only string should literal be referred to or explained in error messages.

  With the arguments @'labelStringLatin1' multi raw@:

  - @multi@: whether this is for a multi-line string
  - @raw@: whether this is for a raw string
  -}
  , ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringLatin1 :: Bool -> Bool -> LabelWithExplainConfig
  {-| How a UTF-16-only string should literal be referred to or explained in error messages.

  With the arguments @'labelStringUnicode' multi raw@:

  - @multi@: whether this is for a multi-line string
  - @raw@: whether this is for a raw string
  -}
  , ErrorConfig -> Bool -> Bool -> LabelWithExplainConfig
labelStringUnicode :: Bool -> Bool -> LabelWithExplainConfig
  {- | How the closing quote(s) of an ASCII string literal should be referred to in error messages.

  With the arguments @'labelStringAsciiEnd' multi raw@:

  - @multi@: whether this is for a multi-line string
  - @raw@: whether this is for a raw string
  -}
  , ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringAsciiEnd :: Bool -> Bool -> LabelConfig
  {-| How the closing quote(s) of a Latin1 string literal should be referred to in error messages.

  With the arguments @'labelStringLatin1End' multi raw@:

  - @multi@: whether this is for a multi-line string
  - @raw@: whether this is for a raw string
  -}
  , ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringLatin1End :: Bool -> Bool -> LabelConfig
  {-| How the closing quote(s) of a UTF-16 string literal should be referred to in error messages.

  With the arguments @'labelStringUnicodeEnd' multi raw@:

  - @multi@: whether this is for a multi-line string
  - @raw@: whether this is for a raw string
  -}
  , ErrorConfig -> Bool -> Bool -> LabelConfig
labelStringUnicodeEnd :: Bool -> Bool -> LabelConfig
  -- | How general string characters should be referred to in error messages.
  , ErrorConfig -> LabelConfig
labelStringCharacter :: LabelConfig
  -- | How a graphic character (a regular character in the literal) should be referred to or explained in error messages.
  , ErrorConfig -> LabelWithExplainConfig
labelGraphicCharacter :: LabelWithExplainConfig
  -- | How an escape sequence should be referred to or explained in error messages.
  , ErrorConfig -> LabelWithExplainConfig
labelEscapeSequence :: LabelWithExplainConfig
  {- | How a numeric escape sequence (after the opening character) should be referred to or explained in error messages.

  In @'labelEscapeNumeric' radix@:

  - @radix@: the radix this specific configuration applies to.
  -}
  , ErrorConfig -> Int -> LabelWithExplainConfig
labelEscapeNumeric :: Int -> LabelWithExplainConfig
  {-| How the end of a numeric escape sequence (after a prefix) should be referred to or explained in error messages.

  In @'labelEscapeNumericEnd' prefix radix@:

  - @prefix@: the character that started this sequence
  - @radix@: the radix this specific configuration applies to.
  -}
  , ErrorConfig -> Char -> Int -> LabelWithExplainConfig
labelEscapeNumericEnd :: Char -> Int -> LabelWithExplainConfig
  -- | How the end of an escape sequence (anything past the opening character) should be referred to or explained within an error message.
  , ErrorConfig -> LabelWithExplainConfig
labelEscapeEnd :: LabelWithExplainConfig
  -- | How zero-width escape characters should be referred to within error messages.
  , ErrorConfig -> LabelConfig
labelStringEscapeEmpty :: LabelConfig
  -- | How string gaps should be referred to within error messages.
  , ErrorConfig -> LabelConfig
labelStringEscapeGap :: LabelConfig
  -- | How the end of a string gap (the closing slash) should be referred to within error messages.
  , ErrorConfig -> LabelConfig
labelStringEscapeGapEnd :: LabelConfig
  -- | When a non-ASCII character is found in a ASCII-only character literal, specifies how this should be reported.
  , ErrorConfig -> VanillaFilterConfig Char
filterCharNonAscii :: VanillaFilterConfig Char
  -- | When a non-Latin1 character is found in a Latin1-only character literal, specifies how this should be reported.
  , ErrorConfig -> VanillaFilterConfig Char
filterCharNonLatin1 :: VanillaFilterConfig Char
  -- | When a non-ASCII character is found in a ASCII-only string literal, specifies how this should be reported.
  , ErrorConfig -> SpecializedFilterConfig [Char]
filterStringNonAscii :: SpecializedFilterConfig String
  -- | When a non-Latin1 character is found in a Latin1-only string literal, specifies how this should be reported.
  , ErrorConfig -> SpecializedFilterConfig [Char]
filterStringNonLatin1 :: SpecializedFilterConfig String
  {-| When a numeric escape sequence requires a specific number of digits but this was not successfully parsed, 
  this describes how to report that error given the number of successfully parsed digits up this point.

  In @'filterEscapeCharRequiresExactDigits' radix needed@:

  - @radix@: the radix used for this numeric escape sequence.
  - @needed@: the possible numbers of digits required.
  -}
  , ErrorConfig -> Int -> NonEmpty Word -> SpecializedFilterConfig Word
filterEscapeCharRequiresExactDigits :: Int -> NonEmpty Word -> SpecializedFilterConfig Word
  {-| When a numeric escape sequence is not legal, this describes how to report that error, given the original illegal character.
  
  In @'filterEscapeCharNumericSequenceIllegal' maxEscape radix@:

  - @maxEscape@: the largest legal escape character.
  - @radix@: the radix used for this numeric escape sequence.
  -}
  , ErrorConfig -> Char -> Int -> SpecializedFilterConfig Integer
filterEscapeCharNumericSequenceIllegal :: Char -> Int -> SpecializedFilterConfig Integer
  -- | Character literals parse either graphic characters or escape characters.
  , ErrorConfig -> VerifiedBadChars
verifiedCharBadCharsUsedInLiteral :: VerifiedBadChars
  -- | String literals parse either graphic characters or escape characters.
  , ErrorConfig -> VerifiedBadChars
verifiedStringBadCharsUsedInLiteral :: VerifiedBadChars
  {-|
  Gives names and/or reasons to symbols.

  Symbols that do not appear in the map are assumed to be 'NotConfigurable'.
  -}
  , ErrorConfig -> Map [Char] LabelWithExplainConfig
labelSymbol :: Map String LabelWithExplainConfig
  -- don't bother with these until parsley standardises
  --, defaultSymbolKeyword :: Labeller
  --, defaultSymbolOperator :: Labeller
  --, defaultSymbolPunctuaton :: Labeller

  -- | How the required end of a given keyword should be specified in an error.
  , ErrorConfig -> [Char] -> [Char]
labelSymbolEndOfKeyword :: String -> String
  -- | How the required end of a given operator should be specified in an error.
  , ErrorConfig -> [Char] -> [Char]
labelSymbolEndOfOperator :: String -> String
  -- | How the end of a single-line comment should be described or explained.
  , ErrorConfig -> LabelWithExplainConfig
labelSpaceEndOfLineComment :: LabelWithExplainConfig
  -- | How the end of a multi-line comment should be described or explained.
  , ErrorConfig -> LabelWithExplainConfig
labelSpaceEndOfMultiComment :: LabelWithExplainConfig
  }

{-|
The default configuration.
This serves as the base configuration, to be customised using record field updates.
-}
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

{-|
A type @config@ is 'ExplainConfigurable' when it is able to configure errors that make labels.

This means @config@ is able to behave like a 'LabelConfig'
-}
type LabelConfigurable :: * -> Constraint
class LabelConfigurable config where
  -- | The configuration produces the labels in the given set, which should not be empty.
  label :: Set String -- ^ The labels to produce.
        -> config
  -- | Configure a label by stating it must be hidden.
  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

{-|
A type @config@ is 'ExplainConfigurable' when it is able to configure an error which provides a reason.

This means @config@ is able to behave like an 'ExplainConfig'
-}
type ExplainConfigurable :: * -> Constraint
class ExplainConfigurable config where
  -- | The error should be displayed using the given reason.
  reason  :: String -- ^ The reason a parser failed.
          -> config

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

{-|
A type @config@ is 'LabelWithExplainConfigurable' when it is able to configure an error which provides both a reason and labels.
-}
type LabelWithExplainConfigurable :: * -> Constraint
class LabelWithExplainConfigurable config where
  -- | The configuration produces the labels in the given set, and provides the given reason.
  labelAndReason :: Set String -- ^ The labels to produce
                 -> String     -- ^ The reason for the error.
                 -> config

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

{-|
A type @config@ is 'NotConfigurable' when it is able to specify that no special error should be generated,
and instead use default errors.
-}
type NotConfigurable :: * -> Constraint
class NotConfigurable config where
  -- | No special error should be generated, and default errors should be used instead.
  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

{-|
A type @config@ is 'VanillaFilterConfigurable' when it is able to generate vanilla errors.

This means @config@ is able to behave like a 'VanillaFilterConfig'
-}
type VanillaFilterConfigurable :: (* -> *) -> Constraint
class VanillaFilterConfigurable config where
  -- | Ensure the filter generates a /vanilla/ unexpected item for the given failing parse.
  unexpected  :: (a -> String) -- ^ a function producing the unexpected label for the given value.
              -> config a
  -- | Ensure the filter generates a /vanilla/ reason for the given failing parse.
  because :: (a -> String)  -- ^ a function producing the reason for the given value.
          -> config a
  -- | Ensure the filter generates a /vanilla/ unexpected item and a reason for the given failing parse.
  unexpectedBecause 
    :: (a -> String) -- ^ @reason@, a function producing the reason for the given value.
    -> (a -> String) -- ^ @unexpected@, a function producing the unexpected label for the given value.
    -> 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

{-|
A type @config@ is 'SpecializedFilterConfigurable' when it is able to generate specialised errors.

This means @config@ is able to behave like a 'SpecializedFilterConfig'
-}
type SpecializedFilterConfigurable :: (* -> *) -> Constraint
class SpecializedFilterConfigurable config where
  -- | Ensure the filter generates /specialised/ messages for the given failing parse.
  specializedFilter 
    :: (a -> NonEmpty String) -- ^ @message@: a function producing the message for the given value.
    -> 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

{-|
A type @config@ is 'BasicFilterConfigurable' when it is able to provide /no/ error configuration, 
and instead defer to a regular filter.
-}
type BasicFilterConfigurable :: (* -> *) -> Constraint
class BasicFilterConfigurable config where
  -- | No error configuration for the filter is specified; a regular filter is used instead.
  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

-- | Makes "bad literal chars" generate a bunch of given messages in a specialised error. 
-- Requires a map from bad characters to their messages.
badCharsFail :: Map Char (NonEmpty String) -> VerifiedBadChars
badCharsFail :: Map Char (NonEmpty [Char]) -> VerifiedBadChars
badCharsFail = Map Char (NonEmpty [Char]) -> VerifiedBadChars
BadCharsFail

-- | Makes "bad literal chars" generate a reason in a vanilla error. 
-- Requires a map from bad characters to their reasons.
badCharsReason :: Map Char String -> VerifiedBadChars
badCharsReason :: Map Char [Char] -> VerifiedBadChars
badCharsReason = Map Char [Char] -> VerifiedBadChars
BadCharsReason

{-|
A type @config@ is 'Unverified' when it can disable the verified error for bad characters:
this may improve parsing performance slightly on the failure case.
-}
type Unverified :: * -> Constraint
class Unverified config where
  -- | A configuration which disables the verified error for bad characters.
  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
:| []