{-# LANGUAGE Safe #-}
{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.Gigaparsec.Internal.Token.Errors (module Text.Gigaparsec.Internal.Token.Errors) where

import Text.Gigaparsec (Parsec, empty)
import Text.Gigaparsec qualified as Errors (filterS, mapMaybeS)
import Text.Gigaparsec.Char (satisfy)
import Text.Gigaparsec.Errors.Combinator qualified as Errors (
    label, explain, hide,
    filterOut, guardAgainst, mapEitherS, unexpectedWhen, unexpectedWithReasonWhen
  )
import Text.Gigaparsec.Errors.Patterns (verifiedFail, verifiedExplain)

import Data.Set (Set)
import Data.Map (Map)

import Data.Map qualified as Map (member, (!))
import Data.Kind (Constraint)
import Data.Maybe (isJust, fromJust)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty (toList)

{-|
This type configures both errors that make labels and those that make reasons.
-}
type LabelWithExplainConfig :: *
data LabelWithExplainConfig
  -- | No special labels or reasons should be generated, and default errors should be used instead.
  = LENotConfigured
  -- | The configuration produces the labels in the given set, which should be non-empty.
  | LELabel !(Set String)
  -- | The error should be displayed using the given reason.
  | LEReason !String
  -- | This label should be hidden.
  | LEHidden
  -- | The configuration produces the labels in the given set, and provides the given reason.
  | LELabelAndReason !(Set String) !String

{-|
This type configures errors that make labels.
-}
type LabelConfig :: *
data LabelConfig
  -- | No special labels should be generated, and default errors should be used instead.
  = LNotConfigured
  -- | The configuration produces the labels in the given set, which should not be empty.
  | LLabel !(Set String)
  -- | This label should be hidden.
  | LHidden

{-|
This type configures errors that give reasons.
-}
type ExplainConfig :: *
data ExplainConfig
  -- | No special reasons should be generated, and default errors should be used instead.
  = ENotConfigured
  -- | The error should be displayed using the given reason.
  | EReason !String

{-|
A type @config@ is an 'Annotate' if it can be used to attach extra information to a 'Parsec' parser.

These annotations may consist of, for example:

- Labels ('LabelConfig'), which give a parser a name (or names) they can be referred to by.
- Reasons for errors ('ExplainConfig'), which will supply a reason for when a parser produces an error.
-}
type Annotate :: * -> Constraint
class Annotate config where
  -- | Annotate the given parser according to the @config@.
  annotate :: config   -- ^ The configuration controlling the annotation.
           -> Parsec a -- ^ The parser to annotate
           -> Parsec a -- ^ An annotated parser.

instance Annotate LabelConfig where
  annotate :: forall a. LabelConfig -> Parsec a -> Parsec a
annotate LabelConfig
LNotConfigured = Parsec a -> Parsec a
forall a. a -> a
id
  annotate (LLabel Set String
ls) = Set String -> Parsec a -> Parsec a
forall a. Set String -> Parsec a -> Parsec a
Errors.label Set String
ls
  annotate LabelConfig
LHidden = Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
Errors.hide

instance Annotate ExplainConfig where
  annotate :: forall a. ExplainConfig -> Parsec a -> Parsec a
annotate ExplainConfig
ENotConfigured = Parsec a -> Parsec a
forall a. a -> a
id
  annotate (EReason String
r) = String -> Parsec a -> Parsec a
forall a. String -> Parsec a -> Parsec a
Errors.explain String
r

instance Annotate LabelWithExplainConfig where
  annotate :: forall a. LabelWithExplainConfig -> Parsec a -> Parsec a
annotate LabelWithExplainConfig
LENotConfigured = Parsec a -> Parsec a
forall a. a -> a
id
  annotate (LELabel Set String
ls) = Set String -> Parsec a -> Parsec a
forall a. Set String -> Parsec a -> Parsec a
Errors.label Set String
ls
  annotate LabelWithExplainConfig
LEHidden = Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
Errors.hide
  annotate (LEReason String
r) = String -> Parsec a -> Parsec a
forall a. String -> Parsec a -> Parsec a
Errors.explain String
r
  annotate (LELabelAndReason Set String
ls String
r) = Set String -> Parsec a -> Parsec a
forall a. Set String -> Parsec a -> Parsec a
Errors.label Set String
ls (Parsec a -> Parsec a)
-> (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parsec a -> Parsec a
forall a. String -> Parsec a -> Parsec a
Errors.explain String
r

{-|
Configures how filters should be used within the 'Text.Gigaparsec.Token.Lexer.Lexer'.
-}
type FilterConfig :: * -> *
data FilterConfig a
  -- | No error configuration for the filter is specified; a regular filter is used instead.
  = VSBasicFilter
  {-|
  Ensure the filter will generate specialised messages for the given failing parse.

  Usage: @'VSSpecializedFilter' message@, where

  - @message@: a function producing the message for the given value.
  -}
  | VSSpecializedFilter
    (a -> NonEmpty String) -- ^ a function producing the message for the given value.
  {-|
  Ensure the filter generates a /vanilla/ unexpected item for the given failing parse.

  Usage: @'VSUnexpected' unexpected@, where

  - @unexpected@: a function producing the unexpected label for the given value.
  -}
  | VSUnexpected (a -> String)
  {-|
  Ensure that the filter will generate a /vanilla/ reason for the given failing parse.

  Usage: @'VSBecause' reason@, where

  - @reason@: a function producing the reason for the given value.
  -}
  | VSBecause
    (a -> String) -- ^ a function producing the reason for the given value.
  {-|
  The filter generates a /vanilla/ unexpected item and a reason for the given failing parse.

  Usage: @'VSUnexpectedBecause' reason unexpected@, where

  - @reason@: a function producing the reason for the given value.
  - @unexpected@: a function producing the unexpected label for the given value.
  -}
  | VSUnexpectedBecause
    (a -> String) -- ^ a function producing the reason for the given value.
    (a -> String) -- ^ a function producing the unexpected label for the given value.

{-|
Specifies that only filters generating /vanilla/ errors can be used.
-}
type VanillaFilterConfig :: * -> *
data VanillaFilterConfig a
  -- | No error configuration for the filter is specified; a regular filter is used instead.
  = VBasicFilter
  {-|
  Ensure the filter generates a /vanilla/ unexpected item for the given failing parse.

  Usage: @'VUnexpected' unexpected@, where

  - @unexpected@: a function producing the unexpected label for the given value.
  -}
  | VUnexpected
    (a -> String) -- ^ a function producing the unexpected label for the given value.
  {-|
  Ensure that the filter will generate a /vanilla/ reason for the given failing parse.

  Usage: @'VBecause' reason@, where

  - @reason@: a function producing the reason for the given value.
  -}
  | VBecause
    (a -> String)
  {-|
  The filter generates a /vanilla/ unexpected item, and a reason for the given failing parse.

  Usage: @'VUnexpectedBecause' reason unexpected@, where

  - @reason@: a function producing the reason for the given value.
  - @unexpected@: a function producing the unexpected label for the given value.
  -}
  | VUnexpectedBecause
    (a -> String) -- ^ a function producing the reason for the given value.
    (a -> String) -- ^ a function producing the unexpected label for the given value.

{-|
Specifies that only filters generating /specialised/ errors can be used.
-}
type SpecializedFilterConfig :: * -> *
data SpecializedFilterConfig a
  -- | No error configuration for the filter is specified; a regular filter is used instead.
  = SBasicFilter
  {-|
  Ensure the filter will generate specialised messages for the given failing parse.

  Usage: @'SSpecializedFilter' message@, where

  - @message@: a function producing the message for the given value.
  -}
  | SSpecializedFilter
    (a -> NonEmpty String) -- ^ a function producing the message for the given value.


{-|
A type @config@ is a 'Filter' when it describes how to process the results of a 'Errors.filterS' or 'Errors.mapMaybeS' on a parser.

The @config@ may allow for these results to have more specialised error messages.
-}
type Filter :: (* -> *) -> Constraint
class Filter config where
  {-|
  Filter a parser according to a predicate, use the @config@ to improve the error message if the predicate fails.

  This combinator filters the result of this parser using a given predicate, succeeding only if the predicate returns true;
  if the predicate fails, the @config@ is used to elaborate the error message.

  This will likely have the same success/failure behaviour as 'Errors.filterS', except the messages output by failure will
  be changed according to the @config@.
  -}
  filterS :: config a     -- ^ The configuration which alters the failure message.
          -> (a -> Bool)  -- ^ @pred@, the predicate to filter by.
          -> Parsec a     -- ^ @p@, the parser whose results are to be filtered.
          -> Parsec a     -- ^ a parser that returns the result of @p@ if it passes @pred@;
                          --   if @pred@ fails, then the error message is altered according to the config.
  filterS = (a -> a) -> config a -> (a -> Bool) -> Parsec a -> Parsec a
forall a x.
(a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a x.
Filter config =>
(a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
filterS' a -> a
forall a. a -> a
id
  {-|
  This combinator filters the result of this parser using a given predicate, succeeding only if the predicate returns @Just x@ for some @x@;
  if the predicate fails, the @config@ is used to elaborate the error message.

  This will likely have the same success/failure behaviour as 'Errors.mapMaybeS', except the messages output by failure will
  be changed according to the @config@.
  -}
  mapMaybeS :: config a       -- ^ The configuration which alters the failure message.
            -> (a -> Maybe b) -- ^ @pred@, the predicate to filter by.
            -> Parsec a       -- ^ @p@, the parser whose results are to be filtered.
            -> Parsec b       -- ^ a parser that returns the result of @pred@ applied to that of @p@;
                              --   if @pred@ returns @Nothing@, then the error message is altered according to the config.
  mapMaybeS = (a -> a) -> config a -> (a -> Maybe b) -> Parsec a -> Parsec b
forall a x b.
(a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b
forall (config :: * -> *) a x b.
Filter config =>
(a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeS' a -> a
forall a. a -> a
id

  filterS' :: (a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
  mapMaybeS' :: (a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b

instance Filter FilterConfig where
  filterS' :: forall a x.
(a -> x) -> FilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
filterS' a -> x
_ FilterConfig x
VSBasicFilter a -> Bool
g = (a -> Bool) -> Parsec a -> Parsec a
forall a. (a -> Bool) -> Parsec a -> Parsec a
Errors.filterS a -> Bool
g
  filterS' a -> x
f (VSSpecializedFilter x -> NonEmpty String
msgs) a -> Bool
g = (a -> Maybe [String]) -> Parsec a -> Parsec a
forall a. (a -> Maybe [String]) -> Parsec a -> Parsec a
Errors.guardAgainst ((a -> x) -> (x -> [String]) -> (a -> Bool) -> a -> Maybe [String]
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty String -> [String])
-> (x -> NonEmpty String) -> x -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NonEmpty String
msgs) a -> Bool
g)
  filterS' a -> x
f (VSBecause x -> String
reason) a -> Bool
g = (a -> Maybe String) -> Parsec a -> Parsec a
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
Errors.filterOut ((a -> x) -> (x -> String) -> (a -> Bool) -> a -> Maybe String
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f x -> String
reason a -> Bool
g)
  filterS' a -> x
f (VSUnexpected x -> String
unex) a -> Bool
g = (a -> Maybe String) -> Parsec a -> Parsec a
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
Errors.unexpectedWhen ((a -> x) -> (x -> String) -> (a -> Bool) -> a -> Maybe String
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f x -> String
unex a -> Bool
g)
  filterS' a -> x
f (VSUnexpectedBecause x -> String
unex x -> String
reason) a -> Bool
g =
    (a -> Maybe (String, String)) -> Parsec a -> Parsec a
forall a. (a -> Maybe (String, String)) -> Parsec a -> Parsec a
Errors.unexpectedWithReasonWhen ((a -> x)
-> (x -> (String, String))
-> (a -> Bool)
-> a
-> Maybe (String, String)
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f (\x
x -> (x -> String
unex x
x, x -> String
reason x
x)) a -> Bool
g)

  mapMaybeS' :: forall a x b.
(a -> x)
-> FilterConfig x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeS' a -> x
_ FilterConfig x
VSBasicFilter a -> Maybe b
g = (a -> Maybe b) -> Parsec a -> Parsec b
forall a b. (a -> Maybe b) -> Parsec a -> Parsec b
Errors.mapMaybeS a -> Maybe b
g
  mapMaybeS' a -> x
f (VSSpecializedFilter x -> NonEmpty String
msgs) a -> Maybe b
g = (a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b
forall a b.
(a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b
Errors.mapEitherS ((a -> x)
-> (x -> NonEmpty String)
-> (a -> Maybe b)
-> a
-> Either (NonEmpty String) b
forall a x e b.
(a -> x) -> (x -> e) -> (a -> Maybe b) -> a -> Either e b
errMap a -> x
f x -> NonEmpty String
msgs a -> Maybe b
g)
  mapMaybeS' a -> x
f FilterConfig x
config a -> Maybe b
g = ((a -> x) -> FilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a)
-> (a -> x)
-> FilterConfig x
-> (a -> Maybe b)
-> Parsec a
-> Parsec b
forall a x (config :: * -> *) b.
((a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a)
-> (a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSDefault (a -> x) -> FilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
forall a x.
(a -> x) -> FilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a x.
Filter config =>
(a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
filterS' a -> x
f FilterConfig x
config a -> Maybe b
g

instance Filter VanillaFilterConfig where
  filterS' :: forall a x.
(a -> x)
-> VanillaFilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
filterS' a -> x
_ VanillaFilterConfig x
VBasicFilter a -> Bool
g = (a -> Bool) -> Parsec a -> Parsec a
forall a. (a -> Bool) -> Parsec a -> Parsec a
Errors.filterS a -> Bool
g
  filterS' a -> x
f (VBecause x -> String
reason) a -> Bool
g = (a -> Maybe String) -> Parsec a -> Parsec a
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
Errors.filterOut ((a -> x) -> (x -> String) -> (a -> Bool) -> a -> Maybe String
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f x -> String
reason a -> Bool
g)
  filterS' a -> x
f (VUnexpected x -> String
unex) a -> Bool
g = (a -> Maybe String) -> Parsec a -> Parsec a
forall a. (a -> Maybe String) -> Parsec a -> Parsec a
Errors.unexpectedWhen ((a -> x) -> (x -> String) -> (a -> Bool) -> a -> Maybe String
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f x -> String
unex a -> Bool
g)
  filterS' a -> x
f (VUnexpectedBecause x -> String
unex x -> String
reason) a -> Bool
g =
    (a -> Maybe (String, String)) -> Parsec a -> Parsec a
forall a. (a -> Maybe (String, String)) -> Parsec a -> Parsec a
Errors.unexpectedWithReasonWhen ((a -> x)
-> (x -> (String, String))
-> (a -> Bool)
-> a
-> Maybe (String, String)
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f (\x
x -> (x -> String
unex x
x, x -> String
reason x
x)) a -> Bool
g)

  mapMaybeS' :: forall a x b.
(a -> x)
-> VanillaFilterConfig x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeS' a -> x
_ VanillaFilterConfig x
VBasicFilter a -> Maybe b
g = (a -> Maybe b) -> Parsec a -> Parsec b
forall a b. (a -> Maybe b) -> Parsec a -> Parsec b
Errors.mapMaybeS a -> Maybe b
g
  mapMaybeS' a -> x
f VanillaFilterConfig x
config a -> Maybe b
g = ((a -> x)
 -> VanillaFilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a)
-> (a -> x)
-> VanillaFilterConfig x
-> (a -> Maybe b)
-> Parsec a
-> Parsec b
forall a x (config :: * -> *) b.
((a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a)
-> (a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSDefault (a -> x)
-> VanillaFilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
forall a x.
(a -> x)
-> VanillaFilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
forall (config :: * -> *) a x.
Filter config =>
(a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
filterS' a -> x
f VanillaFilterConfig x
config a -> Maybe b
g

instance Filter SpecializedFilterConfig where
  filterS' :: forall a x.
(a -> x)
-> SpecializedFilterConfig x -> (a -> Bool) -> Parsec a -> Parsec a
filterS' a -> x
_ SpecializedFilterConfig x
SBasicFilter a -> Bool
g = (a -> Bool) -> Parsec a -> Parsec a
forall a. (a -> Bool) -> Parsec a -> Parsec a
Errors.filterS a -> Bool
g
  filterS' a -> x
f (SSpecializedFilter x -> NonEmpty String
msgs) a -> Bool
g = (a -> Maybe [String]) -> Parsec a -> Parsec a
forall a. (a -> Maybe [String]) -> Parsec a -> Parsec a
Errors.guardAgainst ((a -> x) -> (x -> [String]) -> (a -> Bool) -> a -> Maybe [String]
forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty String -> [String])
-> (x -> NonEmpty String) -> x -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NonEmpty String
msgs) a -> Bool
g)

  mapMaybeS' :: forall a x b.
(a -> x)
-> SpecializedFilterConfig x
-> (a -> Maybe b)
-> Parsec a
-> Parsec b
mapMaybeS' a -> x
_ SpecializedFilterConfig x
SBasicFilter a -> Maybe b
g = (a -> Maybe b) -> Parsec a -> Parsec b
forall a b. (a -> Maybe b) -> Parsec a -> Parsec b
Errors.mapMaybeS a -> Maybe b
g
  mapMaybeS' a -> x
f (SSpecializedFilter x -> NonEmpty String
msgs) a -> Maybe b
g = (a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b
forall a b.
(a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b
Errors.mapEitherS ((a -> x)
-> (x -> NonEmpty String)
-> (a -> Maybe b)
-> a
-> Either (NonEmpty String) b
forall a x e b.
(a -> x) -> (x -> e) -> (a -> Maybe b) -> a -> Either e b
errMap a -> x
f x -> NonEmpty String
msgs a -> Maybe b
g)

errWhen :: (a -> x) -> (x -> e) -> (a -> Bool) -> (a -> Maybe e)
errWhen :: forall a x e. (a -> x) -> (x -> e) -> (a -> Bool) -> a -> Maybe e
errWhen a -> x
f x -> e
g a -> Bool
p a
x
  | a -> Bool
p a
x = e -> Maybe e
forall a. a -> Maybe a
Just (x -> e
g (a -> x
f a
x))
  | Bool
otherwise = Maybe e
forall a. Maybe a
Nothing

errMap :: (a -> x) -> (x -> e) -> (a -> Maybe b) -> (a -> Either e b)
errMap :: forall a x e b.
(a -> x) -> (x -> e) -> (a -> Maybe b) -> a -> Either e b
errMap a -> x
f x -> e
g a -> Maybe b
p a
x = Either e b -> (b -> Either e b) -> Maybe b -> Either e b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e b
forall a b. a -> Either a b
Left (x -> e
g (a -> x
f a
x))) b -> Either e b
forall a b. b -> Either a b
Right (a -> Maybe b
p a
x)

mapMaybeSDefault :: ((a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a)
                 -> ((a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b)
mapMaybeSDefault :: forall a x (config :: * -> *) b.
((a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a)
-> (a -> x) -> config x -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSDefault (a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
filt a -> x
f config x
config a -> Maybe b
g = (a -> b) -> Parsec a -> Parsec b
forall a b. (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe b -> b) -> (a -> Maybe b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
g) (Parsec a -> Parsec b)
-> (Parsec a -> Parsec a) -> Parsec a -> Parsec b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a
filt a -> x
f config x
config (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool) -> (a -> Maybe b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
g)


{-|
Configures what error should be generated when illegal characters in a string or character literal are parsable.
-}
type VerifiedBadChars :: *
data VerifiedBadChars
  {-|
  "bad literal chars" generate a bunch of given messages in a specialised error.
  The map sends bad characters to their messages.
  -}
  = BadCharsFail !(Map Char (NonEmpty String))
  {-|
  "bad literal chars" generate a reason as a /vanilla/ error.
  The map sends bad characters to their reasons.
  -}
  | BadCharsReason !(Map Char String)
  {-|
  Disable the verified error for bad characters:
  this may improve parsing performance slightly on the failure case.
  -}
  | BadCharsUnverified

checkBadChar :: VerifiedBadChars -> Parsec a
checkBadChar :: forall a. VerifiedBadChars -> Parsec a
checkBadChar (BadCharsFail Map Char (NonEmpty String)
cs) = (Char -> [String]) -> Parsec Char -> Parsec a
forall a b. (a -> [String]) -> Parsec a -> Parsec b
verifiedFail (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty String -> [String])
-> (Char -> NonEmpty String) -> Char -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Char (NonEmpty String)
cs Map Char (NonEmpty String) -> Char -> NonEmpty String
forall k a. Ord k => Map k a -> k -> a
Map.!)) ((Char -> Bool) -> Parsec Char
satisfy (Char -> Map Char (NonEmpty String) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Char (NonEmpty String)
cs))
checkBadChar (BadCharsReason Map Char String
cs) = (Char -> String) -> Parsec Char -> Parsec a
forall a b. (a -> String) -> Parsec a -> Parsec b
verifiedExplain (Map Char String
cs Map Char String -> Char -> String
forall k a. Ord k => Map k a -> k -> a
Map.!) ((Char -> Bool) -> Parsec Char
satisfy (Char -> Map Char String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Char String
cs))
checkBadChar VerifiedBadChars
BadCharsUnverified = Parsec a
forall a. Parsec a
empty