{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-|
Module      : Text.Gigaparsec.Errors.Combinator
Description : This module contains combinators that can be used to directly influence error
              messages of parsers.
License     : BSD-3-Clause
Maintainer  : Jamie Willis, Gigaparsec Maintainers
Stability   : stable

Error messages are, by default, not /particularly/ descriptive. However, the combinators in this
module can be used to improve the generation of error messages by providing labels for expected
items, explanations for why things went wrong, custom error messages, custom unexpected error messages,
as well as correcting the offsets that error messages actually occurred at.

==== Terminology

__Observably consumes input__: a parser is said to /observably/ consume input when error messages generated by a parser @p@ occur at a deeper
offset than @p@ originally started at. While this sounds like it is the same as "having consumed input" for the
purposes of backtracking, they are disjoint concepts:

  1. in @atomic p@, @p@ can /observably/ consume input even though the wider parser does not consume input due to the @atomic@.
  2. in @amend p@, @p@ can consume input and may not backtrack even though the consumption is not /observable/ in the error
     message due to the @amend@.

@since 0.2.0.0
-}
module Text.Gigaparsec.Errors.Combinator (
  -- * Error Enrichment Combinators
  -- | These combinators add additional information - or refine the existing information within - to
  -- an error message that has been generated within the scope of the parser they have been called on.
  -- These are a very basic, but effective, way of improving the quality of error messages generated
  -- by gigaparsec.
    label, (<?>), hide, explain,
  -- * Failure Combinators
  -- | These combinators immediately fail the parser, with a more bespoke message.
    emptyWide,
    fail, failWide,
    unexpected, unexpectedWide,
  -- * Error Adjustment Combinators
  -- | These combinators can affect at what position an error is caused at. They are
  -- opposites: where 'amend' will ensure an error message is said to have generated
  -- at the position on entry to the combinator, 'entrench' will resist these changes.
    amend, partialAmend, entrench, dislodge, dislodgeBy,
    amendThenDislodge, amendThenDislodgeBy, partialAmendThenDislodge, partialAmendThenDislodgeBy,
    markAsToken,
    filterSWith, mapMaybeSWith,
    filterOut, guardAgainst, unexpectedWhen, unexpectedWithReasonWhen,
    mapEitherS
  ) where

{-
Future doc headings:

Filtering Combinators
=====================
These combinators perform filtering on a parser, with particular emphasis on generating meaningful
error messages if the filtering fails. This is particularly useful for data validation within the
parser, as very instructive error messages describing what went wrong can be generated. These combinators
often filter using a `PartialFunction`: this may be because they combine filtering with mapping (in which
case, the error message is provided separately), or the function may produce a `String`.

In these cases, the partial function is producing the error messages: if the input to the function is
defined, this means that it is invalid and the filtering will fail using the message obtained from the
successful partial function invocation.

Generic Filtering Combinators
=============================
This combinators generalise the combinators from above, which are all special cases of them. Each of these
takes the characteristic predicate or function of the regular variants, but takes an `errGen` object that
can be used to fine-tune the error messages. These offer some flexiblity not offered by the specialised
filtering combinators, but are a little more verbose to use.
-}

import Prelude hiding (fail)

import Text.Gigaparsec.Errors.ErrorGen (ErrorGen, vanillaGen, specializedGen)
import Text.Gigaparsec.Errors.ErrorGen qualified as ErrorGen
-- We want to use this to make the docs point to the right definition for users.
import Text.Gigaparsec.Internal (Parsec)
import Text.Gigaparsec.Internal qualified as Internal (Parsec(Parsec), line, col, emptyErr, specialisedErr, raise, unexpectedErr, hints, consumed, useHints, adjustErr, hints, hintsValidOffset)
import Text.Gigaparsec.Internal.Errors (Error, CaretWidth(FlexibleCaret, RigidCaret))
import Text.Gigaparsec.Internal.Errors qualified as Internal (setLexical, amendErr, entrenchErr, dislodgeErr, partialAmendErr, labelErr, explainErr, replaceHints)
import Text.Gigaparsec.Internal.Require (require)
import Text.Gigaparsec.Position (withWidth)

import Data.Set (Set)
import Data.Set qualified as Set (empty)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty (toList)
import Data.Maybe (isNothing, fromJust)

{-|
This combinator changes the expected component of any errors generated by this parser.

When this parser fails having not /observably/ consumed input, the expected component of the generated
error message is set to be the given items.
-}
label :: Set String -- ^ the names to give to the expected component of any qualifying errors.
      -> Parsec a   -- ^ the parser to apply the labels to
      -> Parsec a
label :: forall a. Set String -> Parsec a -> Parsec a
label Set String
ls (Internal.Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) =
  Bool -> String -> String -> Parsec a -> Parsec a
forall a. Bool -> String -> String -> a -> a
require (Bool -> Bool
not (Set String -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set String
ls) Bool -> Bool -> Bool
&& Bool -> Bool
not ((String -> Bool) -> Set String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set String
ls)) String
"Text.Gigaparsec.Errors.Combinator.label"
                                               String
"labels cannot be empty" (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall a b. (a -> b) -> a -> b
$
    (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
bad ->
      let !origConsumed :: Word
origConsumed = State -> Word
Internal.consumed State
st
          good' :: a -> State -> RT r
good' a
x State
st'
            | State -> Word
Internal.consumed State
st' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
origConsumed = a -> State -> RT r
good a
x State
st'
            | Bool
otherwise = a -> State -> RT r
good a
x State
st' { Internal.hints = Internal.replaceHints ls (Internal.hints st') }
          bad' :: Error -> State -> RT r
bad' Error
err = (Error -> State -> RT r) -> Error -> State -> RT r
forall r. (Error -> State -> RT r) -> Error -> State -> RT r
Internal.useHints Error -> State -> RT r
bad (Word -> Set String -> Error -> Error
Internal.labelErr Word
origConsumed Set String
ls Error
err)
      in State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good' Error -> State -> RT r
bad'

{-|
This combinator suppresses the entire error message generated by a given parser.

When this parser fails having not /observably/ consumed input, this combinator
replaces any error generated by the given parser to match the 'Text.Gigaparsec.empty' combinator.

This can be useful, say, for hiding whitespace labels, which are not normally useful
information to include in an error message for whitespace insensitive grammars.
-}
hide :: Parsec a -> Parsec a
hide :: forall a. Parsec a -> Parsec a
hide (Internal.Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) =
  (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
bad ->
    let !origConsumed :: Word
origConsumed = State -> Word
Internal.consumed State
st
        good' :: a -> State -> RT r
good' a
x State
st' = a -> State -> RT r
good a
x State
st' {
          Internal.hints = Internal.hints st,
          Internal.hintsValidOffset = Internal.hintsValidOffset st
        }
        bad' :: Error -> State -> RT r
bad' Error
err State
st'
          | State -> Word
Internal.consumed State
st' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
origConsumed = Error -> State -> RT r
bad Error
err State
st'
          | Bool
otherwise = (Error -> State -> RT r) -> Error -> State -> RT r
forall r. (Error -> State -> RT r) -> Error -> State -> RT r
Internal.useHints Error -> State -> RT r
bad (State -> Word -> Error
Internal.emptyErr State
st' Word
0) State
st'
    in State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good' Error -> State -> RT r
bad'

{-|
This combinator adds a reason to error messages generated by this parser.

When this parser fails having not /observably/ consumed input, this combinator adds
a reason to the error message, which should justify why the error occured. Unlike error
labels, which may persist if more progress is made having not consumed input, reasons
are not carried forward in the error message, and are lost.
-}
explain :: String   -- ^ reason the reason why a parser failed.
        -> Parsec a -- ^ the parser to apply the reason to
        -> Parsec a
explain :: forall a. String -> Parsec a -> Parsec a
explain String
reason (Internal.Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) =
  (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
bad ->
    let !origConsumed :: Word
origConsumed = State -> Word
Internal.consumed State
st
        bad' :: Error -> State -> RT r
bad' Error
err = (Error -> State -> RT r) -> Error -> State -> RT r
forall r. (Error -> State -> RT r) -> Error -> State -> RT r
Internal.useHints Error -> State -> RT r
bad (Word -> String -> Error -> Error
Internal.explainErr Word
origConsumed String
reason Error
err)
    in State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good Error -> State -> RT r
bad'

{-|
This combinator fails immediately, with a caret of the given width and no other information.

By producing basically no information, this combinator is principally for adjusting the
caret-width of another error, rather than the value 'Text.Gigaparsec.empty', which is used to fail with
no effect on error content.
-}
emptyWide :: Word     -- ^ the width of the caret for the error produced by this combinator.
          -> Parsec a
emptyWide :: forall a. Word -> Parsec a
emptyWide Word
width = (State -> Error) -> Parsec a
forall a. (State -> Error) -> Parsec a
Internal.raise (State -> Word -> Error
`Internal.emptyErr` Word
width)

{-|
This combinator consumes no input and fails immediately with the given error messages.

Produces a /specialised/ error message where all the lines of the error are the
given @msgs@ in order of appearance.

==== __Examples__
>>> let failing = fail ["hello,", "this is an error message", "broken across multiple lines"]

-}
fail :: NonEmpty String -- ^ the messages that will make up the error message.
     -> Parsec a
fail :: forall a. NonEmpty String -> Parsec a
fail = CaretWidth -> NonEmpty String -> Parsec a
forall a. CaretWidth -> NonEmpty String -> Parsec a
_fail (Word -> CaretWidth
FlexibleCaret Word
1)

{-|
This combinator consumes no input and fails immediately with the given error messages.

Produces a /specialised/ error message where all the lines of the error are the
given @msgs@ in order of appearance. The caret width of the message is set to the
given value.

==== __Examples__
>>> let failing = fail 3 ["hello,", "this is an error message", "broken across multiple lines"]

-}
failWide :: Word            -- ^ the width of the caret for the error produced by this combinator.
         -> NonEmpty String -- ^ the messages that will make up the error message.
         -> Parsec a
failWide :: forall a. Word -> NonEmpty String -> Parsec a
failWide Word
width = CaretWidth -> NonEmpty String -> Parsec a
forall a. CaretWidth -> NonEmpty String -> Parsec a
_fail (Word -> CaretWidth
RigidCaret Word
width)

{-# INLINE _fail #-}
_fail :: CaretWidth -> NonEmpty String -> Parsec a
_fail :: forall a. CaretWidth -> NonEmpty String -> Parsec a
_fail CaretWidth
width NonEmpty String
msgs = (State -> Error) -> Parsec a
forall a. (State -> Error) -> Parsec a
Internal.raise (\State
st -> State -> [String] -> CaretWidth -> Error
Internal.specialisedErr State
st (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
msgs) CaretWidth
width)

{-|
This combinator consumes no input and fails immediately, setting the unexpected component
to the given item.

Produces a /trivial/ error message where the unexpected component of the error is
replaced with the given item.
-}
unexpected :: String   -- ^ the unexpected message for the error generated.
           -> Parsec a
unexpected :: forall a. String -> Parsec a
unexpected = CaretWidth -> String -> Parsec a
forall a. CaretWidth -> String -> Parsec a
_unexpected (Word -> CaretWidth
FlexibleCaret Word
1)

{-|
This combinator consumes no input and fails immediately, setting the unexpected component
to the given item.

Produces a /trivial/ error message where the unexpected component of the error is
replaced with the given item. The caret width of the message is set to the
given value.
-}
unexpectedWide :: Word     -- ^ the width of the caret for the error produced by this combinator.
               -> String   -- ^ the unexpected message for the error generated.
               -> Parsec a
unexpectedWide :: forall a. Word -> String -> Parsec a
unexpectedWide Word
width = CaretWidth -> String -> Parsec a
forall a. CaretWidth -> String -> Parsec a
_unexpected (Word -> CaretWidth
RigidCaret Word
width)

{-# INLINE _unexpected #-}
_unexpected :: CaretWidth -> String -> Parsec a
_unexpected :: forall a. CaretWidth -> String -> Parsec a
_unexpected CaretWidth
width String
name = (State -> Error) -> Parsec a
forall a. (State -> Error) -> Parsec a
Internal.raise ((State -> Error) -> Parsec a) -> (State -> Error) -> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st -> State -> Set ExpectItem -> String -> CaretWidth -> Error
Internal.unexpectedErr State
st Set ExpectItem
forall a. Set a
Set.empty String
name CaretWidth
width

{-|
This combinator adjusts any error messages generated by the given parser so that they
occur at the position recorded on entry to this combinator (effectively as if no
input were consumed).

This is useful if validation work is done
on the output of a parser that may render it invalid, but the error should point to the
beginning of the structure. This combinators effect can be cancelled with 'entrench'.

==== __Examples__
>>> let greeting = string "hello world" <* char '!'
>>> parseRepl (greeting <?> ["greeting"]) "hello world."
(line 1, column 12):
  unexpected "."
  expected "!"
  >hello world.
              ^
>>> parseRepl (amend greeting <?> ["greeting"]) "hello world."
(line 1, column 1):
  unexpected "h"
  expected greeting
  >hello world.
   ^
-}
amend :: Parsec a -> Parsec a
amend :: forall a. Parsec a -> Parsec a
amend = (Word -> Word -> Word -> Error -> Error) -> Parsec a -> Parsec a
forall a.
(Word -> Word -> Word -> Error -> Error) -> Parsec a -> Parsec a
_amend Word -> Word -> Word -> Error -> Error
Internal.amendErr

--TODO: examples
{-|
This combinator adjusts any error messages generated by the given parser so that they
occur at the position recorded on entry to this combinator, but retains the original offset.

Similar to 'amend', but retains the original offset the error occurred at. This is known
as its /underlying offset/ as opposed to the visual /presentation offset/. To the reader, the
error messages appears as if no input was consumed, but for the purposes of error message merging
the error is still deeper. A key thing to note is that two errors can only merge if they are at
the same presentation /and/ underlying offsets: if they are not the deeper of the two /dominates/.

The ability for an error to still dominate others after partial amendment can be useful for allowing
it to avoid being lost when merging with errors that are deeper than the presentation offset but
shallower than the underlying.
-}
partialAmend :: Parsec a -> Parsec a
partialAmend :: forall a. Parsec a -> Parsec a
partialAmend = (Word -> Word -> Word -> Error -> Error) -> Parsec a -> Parsec a
forall a.
(Word -> Word -> Word -> Error -> Error) -> Parsec a -> Parsec a
_amend Word -> Word -> Word -> Error -> Error
Internal.partialAmendErr

{-# INLINE _amend #-}
_amend :: (Word -> Word -> Word -> Error -> Error) -> Parsec a -> Parsec a
_amend :: forall a.
(Word -> Word -> Word -> Error -> Error) -> Parsec a -> Parsec a
_amend Word -> Word -> Word -> Error -> Error
f (Internal.Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) =
  (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
bad ->
    let !origConsumed :: Word
origConsumed = State -> Word
Internal.consumed State
st
        !origLine :: Word
origLine = State -> Word
Internal.line State
st
        !origCol :: Word
origCol = State -> Word
Internal.col State
st
        !origHints :: Hints
origHints = State -> Hints
Internal.hints State
st
        !origHintsValidOffset :: Word
origHintsValidOffset = State -> Word
Internal.hintsValidOffset State
st
    in State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good ((Error -> State -> RT r) -> RT r)
-> (Error -> State -> RT r) -> RT r
forall a b. (a -> b) -> a -> b
$ \Error
err State
st' -> Error -> State -> RT r
bad (Word -> Word -> Word -> Error -> Error
f Word
origConsumed Word
origLine Word
origCol Error
err)
                                   State
st' { Internal.hints = origHints
                                       , Internal.hintsValidOffset = origHintsValidOffset }

--TODO: examples
{-|
This combinator prevents the action of any enclosing 'amend' on the errors generated by the given
parser.

Sometimes, the error adjustments performed by 'amend' should only affect errors generated
within a certain part of a parser and not the whole thing; in this case, 'entrench' can be used
to protect sub-parsers from having their errors adjusted, providing a much more fine-grained
scope for error adjustment.
-}
entrench :: Parsec a -> Parsec a
entrench :: forall a. Parsec a -> Parsec a
entrench = (Error -> Error) -> Parsec a -> Parsec a
forall a. (Error -> Error) -> Parsec a -> Parsec a
Internal.adjustErr Error -> Error
Internal.entrenchErr

{-|
This combinator undoes the action of any 'entrench' combinators on the given parser.

Entrenchment is important for preventing the incorrect amendment of certain parts of sub-errors
for a parser, but it may be then undesireable to block further amendments from elsewhere in the
parser. This combinator can be used to cancel all entrenchment after the critical section has
passed.
-}
dislodge :: Parsec a -> Parsec a
dislodge :: forall a. Parsec a -> Parsec a
dislodge = Word -> Parsec a -> Parsec a
forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
forall a. Bounded a => a
maxBound

{-|
This combinator undoes the action of the given number of 'entrench' combinators on the given parser.

Entrenchment is important for preventing the incorrect amendment of certain parts of sub-errors
for a parser, but it may be then undesireable to block further amendments from elsewhere in the
parser. This combinator can be used to cancel all entrenchment after the critical section has
passed.
-}
dislodgeBy :: Word -> Parsec a -> Parsec a
dislodgeBy :: forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
by = (Error -> Error) -> Parsec a -> Parsec a
forall a. (Error -> Error) -> Parsec a -> Parsec a
Internal.adjustErr (Word -> Error -> Error
Internal.dislodgeErr Word
by)

{-|
This combinator first tries to amend the position of any error generated by the given parser,
and if the error was entrenched will dislodge it instead.
-}
amendThenDislodge :: Parsec a -> Parsec a
amendThenDislodge :: forall a. Parsec a -> Parsec a
amendThenDislodge = Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
dislodge (Parsec a -> Parsec a)
-> (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
amend

{-|
This combinator first tries to amend the position of any error generated by the given parser,
and if the error was entrenched will dislodge it the given number of times instead.
-}
amendThenDislodgeBy :: Word -> Parsec a -> Parsec a
amendThenDislodgeBy :: forall a. Word -> Parsec a -> Parsec a
amendThenDislodgeBy Word
n = Word -> Parsec a -> Parsec a
forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
n (Parsec a -> Parsec a)
-> (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
amend

{-|
This combinator first tries to partially amend the position of any error generated by the given parser,
and if the error was entrenched will dislodge it instead.
-}
partialAmendThenDislodge :: Parsec a -> Parsec a
partialAmendThenDislodge :: forall a. Parsec a -> Parsec a
partialAmendThenDislodge = Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
dislodge (Parsec a -> Parsec a)
-> (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
partialAmend

{-|
This combinator first tries to partially amend the position of any error generated by the given parser,
and if the error was entrenched will dislodge it the given number of times instead.
-}
partialAmendThenDislodgeBy :: Word -> Parsec a -> Parsec a
partialAmendThenDislodgeBy :: forall a. Word -> Parsec a -> Parsec a
partialAmendThenDislodgeBy Word
n = Word -> Parsec a -> Parsec a
forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
n (Parsec a -> Parsec a)
-> (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
partialAmend

{-|
This combinator marks any errors within the given parser as being /lexical errors/.

When an error is marked as a /lexical error/, it sets a flag within the error that is
passed to 'Text.Gigaparsec.Errors.ErrorBuilder.unexpectedToken': this
should be used to prevent @Lexer@-based token extraction from being performed on an error,
since lexing errors cannot be the result of unexpected tokens.
-}
markAsToken :: Parsec a -> Parsec a
markAsToken :: forall a. Parsec a -> Parsec a
markAsToken (Internal.Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) = (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
bad ->
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good ((Error -> State -> RT r) -> RT r)
-> (Error -> State -> RT r) -> RT r
forall a b. (a -> b) -> a -> b
$ \Error
err -> Error -> State -> RT r
bad (Word -> Error -> Error
Internal.setLexical (State -> Word
Internal.consumed State
st) Error
err)

{-|
This combinator changes the expected component of any errors generated by this parser.

This is just an alias for the 'label' combinator.
-}
{-# INLINE (<?>) #-}
infix 0 <?>
(<?>) :: Parsec a -> Set String -> Parsec a
<?> :: forall a. Parsec a -> Set String -> Parsec a
(<?>) = (Set String -> Parsec a -> Parsec a)
-> Parsec a -> Set String -> Parsec a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set String -> Parsec a -> Parsec a
forall a. Set String -> Parsec a -> Parsec a
label

-- should these be implemented with branch? probably not.
{-
@since 0.2.2.0
-}
filterSWith :: ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
filterSWith :: forall a. ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
filterSWith ErrorGen a
errGen a -> Bool
f Parsec a
p = Word -> Parsec a -> Parsec a
forall a. Word -> Parsec a -> Parsec a
amendThenDislodgeBy Word
1 (Parsec a -> Parsec a) -> Parsec a -> Parsec a
forall a b. (a -> b) -> a -> b
$ Parsec a -> Parsec (a, Word)
forall a. Parsec a -> Parsec (a, Word)
withWidth (Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
entrench Parsec a
p) Parsec (a, Word) -> ((a, Word) -> Parsec a) -> Parsec a
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x, Word
w) ->
  if a -> Bool
f a
x then a -> Parsec a
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x else ErrorGen a -> a -> Word -> Parsec a
forall a b. ErrorGen a -> a -> Word -> Parsec b
ErrorGen.asErr ErrorGen a
errGen a
x Word
w

{-
@since 0.2.2.0
-}
filterOut :: (a -> Maybe String) -> Parsec a -> Parsec a
filterOut :: forall a. (a -> Maybe String) -> Parsec a -> Parsec a
filterOut a -> Maybe String
p =
  ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
forall a. ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
filterSWith (ErrorGen a
forall a. ErrorGen a
vanillaGen { ErrorGen.reason = p }) (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> (a -> Maybe String) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe String
p)

{-
@since 0.2.2.0
-}
-- FIXME: 0.3.0.0 change to NonEmptyList
guardAgainst :: (a -> Maybe [String]) -> Parsec a -> Parsec a
guardAgainst :: forall a. (a -> Maybe [String]) -> Parsec a -> Parsec a
guardAgainst a -> Maybe [String]
p =
  ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
forall a. ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
filterSWith (ErrorGen a
forall a. ErrorGen a
specializedGen { ErrorGen.messages = fromJust . p }) (Maybe [String] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [String] -> Bool) -> (a -> Maybe [String]) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe [String]
p)

{-
@since 0.2.2.0
-}
unexpectedWhen :: (a -> Maybe String) -> Parsec a -> Parsec a
unexpectedWhen :: forall a. (a -> Maybe String) -> Parsec a -> Parsec a
unexpectedWhen a -> Maybe String
p =
  ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
forall a. ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
filterSWith (ErrorGen a
forall a. ErrorGen a
vanillaGen { ErrorGen.unexpected = ErrorGen.NamedItem . fromJust . p }) (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> (a -> Maybe String) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe String
p)

{-
@since 0.2.2.0
-}
unexpectedWithReasonWhen :: (a -> Maybe (String, String)) -> Parsec a -> Parsec a
unexpectedWithReasonWhen :: forall a. (a -> Maybe (String, String)) -> Parsec a -> Parsec a
unexpectedWithReasonWhen a -> Maybe (String, String)
p =
  ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
forall a. ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a
filterSWith (ErrorGen a
forall a. ErrorGen a
vanillaGen { ErrorGen.unexpected = ErrorGen.NamedItem . fst . fromJust . p
                          , ErrorGen.reason = fmap snd . p
                          }) (Maybe (String, String) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (String, String) -> Bool)
-> (a -> Maybe (String, String)) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (String, String)
p)

-- this is called mapFilter in Scala... there is no collect counterpart
{-
@since 0.2.2.0
-}
mapMaybeSWith :: ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSWith :: forall a b. ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSWith ErrorGen a
errGen a -> Maybe b
f Parsec a
p = Word -> Parsec b -> Parsec b
forall a. Word -> Parsec a -> Parsec a
amendThenDislodgeBy Word
1 (Parsec b -> Parsec b) -> Parsec b -> Parsec b
forall a b. (a -> b) -> a -> b
$ Parsec a -> Parsec (a, Word)
forall a. Parsec a -> Parsec (a, Word)
withWidth (Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
entrench Parsec a
p) Parsec (a, Word) -> ((a, Word) -> Parsec b) -> Parsec b
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x, Word
w) ->
  Parsec b -> (b -> Parsec b) -> Maybe b -> Parsec b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ErrorGen a -> a -> Word -> Parsec b
forall a b. ErrorGen a -> a -> Word -> Parsec b
ErrorGen.asErr ErrorGen a
errGen a
x Word
w) b -> Parsec b
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe b
f a
x)

{-
@since 0.2.4.0
-}
mapEitherS :: (a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b
mapEitherS :: forall a b.
(a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b
mapEitherS a -> Either (NonEmpty String) b
f Parsec a
p = Word -> Parsec b -> Parsec b
forall a. Word -> Parsec a -> Parsec a
amendThenDislodgeBy Word
1 (Parsec b -> Parsec b) -> Parsec b -> Parsec b
forall a b. (a -> b) -> a -> b
$ Parsec a -> Parsec (a, Word)
forall a. Parsec a -> Parsec (a, Word)
withWidth (Parsec a -> Parsec a
forall a. Parsec a -> Parsec a
entrench Parsec a
p) Parsec (a, Word) -> ((a, Word) -> Parsec b) -> Parsec b
forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x, Word
w) ->
  (NonEmpty String -> Parsec b)
-> (b -> Parsec b) -> Either (NonEmpty String) b -> Parsec b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Word -> NonEmpty String -> Parsec b
forall a. Word -> NonEmpty String -> Parsec a
failWide Word
w) b -> Parsec b
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either (NonEmpty String) b
f a
x)