{-# 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) type LabelWithExplainConfig :: * data LabelWithExplainConfig = LENotConfigured | LELabel !(Set String) | LEReason !String | LEHidden | LELabelAndReason !(Set String) !String type LabelConfig :: * data LabelConfig = LNotConfigured | LLabel !(Set String) | LHidden type ExplainConfig :: * data ExplainConfig = ENotConfigured | EReason !String type Annotate :: * -> Constraint class Annotate config where annotate :: config -> Parsec a -> Parsec a 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 type FilterConfig :: * -> * data FilterConfig a = VSBasicFilter | VSSpecializedFilter (a -> NonEmpty String) | VSUnexpected (a -> String) | VSBecause (a -> String) | VSUnexpectedBecause (a -> String) (a -> String) type VanillaFilterConfig :: * -> * data VanillaFilterConfig a = VBasicFilter | VUnexpected (a -> String) | VBecause (a -> String) | VUnexpectedBecause (a -> String) (a -> String) type SpecializedFilterConfig :: * -> * data SpecializedFilterConfig a = SBasicFilter | SSpecializedFilter (a -> NonEmpty String) type Filter :: (* -> *) -> Constraint class Filter config where filterS :: config a -> (a -> Bool) -> Parsec a -> Parsec a 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 mapMaybeS :: config a -> (a -> Maybe b) -> Parsec a -> Parsec b 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) type VerifiedBadChars :: * data VerifiedBadChars = BadCharsFail !(Map Char (NonEmpty String)) | BadCharsReason !(Map Char String) | 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 forall (f :: * -> *) a. Alternative f => f a empty