{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
module Text.Gigaparsec.Errors.Combinator (
label, (<?>), hide, explain,
emptyWide,
fail, failWide,
unexpected, unexpectedWide,
amend, partialAmend, entrench, dislodge, dislodgeBy,
amendThenDislodge, amendThenDislodgeBy, partialAmendThenDislodge, partialAmendThenDislodgeBy,
markAsToken
) where
import Prelude hiding (fail)
import Text.Gigaparsec (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 (ParseError, CaretWidth(FlexibleCaret, RigidCaret), ExpectItem(ExpectNamed))
import Text.Gigaparsec.Internal.Errors qualified as Internal (setLexical, amendErr, entrenchErr, dislodgeErr, partialAmendErr, labelErr, explainErr)
import Text.Gigaparsec.Internal.Require (require)
import Data.Set (Set)
import Data.Set qualified as Set (empty, map)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty (toList)
label :: Set String
-> Parsec a
-> Parsec a
label :: forall a. Set String -> Parsec a -> Parsec a
label Set String
ls (Internal.Parsec forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p) =
forall a. Bool -> String -> String -> a -> a
require (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set String
ls) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set String
ls)) String
"Text.Gigaparsec.Errors.Combinator.label"
String
"labels cannot be empty" forall a b. (a -> b) -> a -> b
$
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good ParseError -> 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' 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' { hints :: Set ExpectItem
Internal.hints = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map String -> ExpectItem
ExpectNamed Set String
ls }
bad' :: ParseError -> State -> RT r
bad' ParseError
err = forall r.
(ParseError -> State -> RT r) -> ParseError -> State -> RT r
Internal.useHints ParseError -> State -> RT r
bad (Word -> Set String -> ParseError -> ParseError
Internal.labelErr Word
origConsumed Set String
ls ParseError
err)
in forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good' ParseError -> State -> RT r
bad'
hide :: Parsec a -> Parsec a
hide :: forall a. Parsec a -> Parsec a
hide (Internal.Parsec forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p) =
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good ParseError -> 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' { hints :: Set ExpectItem
Internal.hints = forall a. Set a
Set.empty }
bad' :: ParseError -> State -> RT r
bad' ParseError
err State
st'
| State -> Word
Internal.consumed State
st' forall a. Eq a => a -> a -> Bool
/= Word
origConsumed = ParseError -> State -> RT r
bad ParseError
err State
st'
| Bool
otherwise = forall r.
(ParseError -> State -> RT r) -> ParseError -> State -> RT r
Internal.useHints ParseError -> State -> RT r
bad (State -> Word -> ParseError
Internal.emptyErr State
st' Word
0) State
st'
in forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good' ParseError -> State -> RT r
bad'
explain :: String
-> Parsec a
-> Parsec a
explain :: forall a. String -> Parsec a -> Parsec a
explain String
reason (Internal.Parsec forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p) =
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good ParseError -> State -> RT r
bad ->
let !origConsumed :: Word
origConsumed = State -> Word
Internal.consumed State
st
bad' :: ParseError -> State -> RT r
bad' ParseError
err = forall r.
(ParseError -> State -> RT r) -> ParseError -> State -> RT r
Internal.useHints ParseError -> State -> RT r
bad (Word -> String -> ParseError -> ParseError
Internal.explainErr Word
origConsumed String
reason ParseError
err)
in forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good ParseError -> State -> RT r
bad'
emptyWide :: Word
-> Parsec a
emptyWide :: forall a. Word -> Parsec a
emptyWide Word
width = forall a. (State -> ParseError) -> Parsec a
Internal.raise (State -> Word -> ParseError
`Internal.emptyErr` Word
width)
fail :: NonEmpty String
-> Parsec a
fail :: forall a. NonEmpty String -> Parsec a
fail = forall a. CaretWidth -> NonEmpty String -> Parsec a
_fail (Word -> CaretWidth
FlexibleCaret Word
1)
failWide :: Word
-> NonEmpty String
-> Parsec a
failWide :: forall a. Word -> NonEmpty String -> Parsec a
failWide Word
width = 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 = forall a. (State -> ParseError) -> Parsec a
Internal.raise (\State
st -> State -> [String] -> CaretWidth -> ParseError
Internal.specialisedErr State
st (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
msgs) CaretWidth
width)
unexpected :: String
-> Parsec a
unexpected :: forall a. String -> Parsec a
unexpected = forall a. CaretWidth -> String -> Parsec a
_unexpected (Word -> CaretWidth
FlexibleCaret Word
1)
unexpectedWide :: Word
-> String
-> Parsec a
unexpectedWide :: forall a. Word -> String -> Parsec a
unexpectedWide Word
width = 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 = forall a. (State -> ParseError) -> Parsec a
Internal.raise forall a b. (a -> b) -> a -> b
$ \State
st -> State -> Set ExpectItem -> String -> CaretWidth -> ParseError
Internal.unexpectedErr State
st forall a. Set a
Set.empty String
name CaretWidth
width
amend :: Parsec a -> Parsec a
amend :: forall a. Parsec a -> Parsec a
amend = forall a.
(Word -> Word -> Word -> ParseError -> ParseError)
-> Parsec a -> Parsec a
_amend Word -> Word -> Word -> ParseError -> ParseError
Internal.amendErr
partialAmend :: Parsec a -> Parsec a
partialAmend :: forall a. Parsec a -> Parsec a
partialAmend = forall a.
(Word -> Word -> Word -> ParseError -> ParseError)
-> Parsec a -> Parsec a
_amend Word -> Word -> Word -> ParseError -> ParseError
Internal.partialAmendErr
{-# INLINE _amend #-}
_amend :: (Word -> Word -> Word -> ParseError -> ParseError) -> Parsec a -> Parsec a
_amend :: forall a.
(Word -> Word -> Word -> ParseError -> ParseError)
-> Parsec a -> Parsec a
_amend Word -> Word -> Word -> ParseError -> ParseError
f (Internal.Parsec forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p) =
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good ParseError -> 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 :: Set ExpectItem
origHints = State -> Set ExpectItem
Internal.hints State
st
!origHintsValidOffset :: Word
origHintsValidOffset = State -> Word
Internal.hintsValidOffset State
st
in forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good forall a b. (a -> b) -> a -> b
$ \ParseError
err State
st' -> ParseError -> State -> RT r
bad (Word -> Word -> Word -> ParseError -> ParseError
f Word
origConsumed Word
origLine Word
origCol ParseError
err)
State
st' { hints :: Set ExpectItem
Internal.hints = Set ExpectItem
origHints
, hintsValidOffset :: Word
Internal.hintsValidOffset = Word
origHintsValidOffset }
entrench :: Parsec a -> Parsec a
entrench :: forall a. Parsec a -> Parsec a
entrench = forall a. (ParseError -> ParseError) -> Parsec a -> Parsec a
Internal.adjustErr ParseError -> ParseError
Internal.entrenchErr
dislodge :: Parsec a -> Parsec a
dislodge :: forall a. Parsec a -> Parsec a
dislodge = forall a. Word -> Parsec a -> Parsec a
dislodgeBy forall a. Bounded a => a
maxBound
dislodgeBy :: Word -> Parsec a -> Parsec a
dislodgeBy :: forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
by = forall a. (ParseError -> ParseError) -> Parsec a -> Parsec a
Internal.adjustErr (Word -> ParseError -> ParseError
Internal.dislodgeErr Word
by)
amendThenDislodge :: Parsec a -> Parsec a
amendThenDislodge :: forall a. Parsec a -> Parsec a
amendThenDislodge = forall a. Parsec a -> Parsec a
dislodge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parsec a -> Parsec a
amend
amendThenDislodgeBy :: Word -> Parsec a -> Parsec a
amendThenDislodgeBy :: forall a. Word -> Parsec a -> Parsec a
amendThenDislodgeBy Word
n = forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parsec a -> Parsec a
amend
partialAmendThenDislodge :: Parsec a -> Parsec a
partialAmendThenDislodge :: forall a. Parsec a -> Parsec a
partialAmendThenDislodge = forall a. Parsec a -> Parsec a
dislodge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parsec a -> Parsec a
partialAmend
partialAmendThenDislodgeBy :: Word -> Parsec a -> Parsec a
partialAmendThenDislodgeBy :: forall a. Word -> Parsec a -> Parsec a
partialAmendThenDislodgeBy Word
n = forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parsec a -> Parsec a
partialAmend
markAsToken :: Parsec a -> Parsec a
markAsToken :: forall a. Parsec a -> Parsec a
markAsToken = forall a. (ParseError -> ParseError) -> Parsec a -> Parsec a
Internal.adjustErr ParseError -> ParseError
Internal.setLexical
{-# INLINE (<?>) #-}
infix 0 <?>
(<?>) :: Parsec a -> Set String -> Parsec a
<?> :: forall a. Parsec a -> Set String -> Parsec a
(<?>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Set String -> Parsec a -> Parsec a
label