}
deriving instance Show (InputToken inp) => Show (ParsingError inp)
--- ** Type 'Hints'
-newtype Hints inp = Hints [Set (ErrorItem (InputToken inp))]
-instance Semigroup (Hints t) where
- Hints xs <> Hints ys = Hints $ xs <> ys
-instance Monoid (Hints t) where
- mempty = Hints mempty
-
-{-
-accHints ::
- -- | 'Hints' to add
- Hints t ->
- -- | An “OK” continuation to alter
- (a -> State s e -> Hints t -> m b) ->
- -- | Altered “OK” continuation
- (a -> State s e -> Hints t -> m b)
-accHints hs1 c x s hs2 = c x s (hs1 <> hs2)
--}
-
-toHints :: Offset -> ParsingError inp -> Hints inp
-toHints curOff = \case
- ParsingErrorStandard errOff _ es ->
- if curOff == errOff
- then Hints (if Set.null es then [] else [es])
- else mempty
-
-{-
-withHints ::
- Stream s =>
- -- | Hints to use
- Hints (Token s) ->
- -- | Continuation to influence
- (ParseError s e -> State s e -> m b) ->
- -- | First argument of resulting continuation
- ParseError s e ->
- -- | Second argument of resulting continuation
- State s e ->
- m b
-withHints (Hints hs) c e =
- case e of
- ParsingErrorStandard pos us es -> c (ParsingErrorStandard pos us (Set.unions (es : hs)))
-{-# INLINE withHints #-}
--}
-
-- ** Type 'Offset'
type Offset = Int