{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module Text.Gigaparsec.Errors.Combinator (
label, (<?>), hide, explain,
emptyWide,
fail, failWide,
unexpected, unexpectedWide,
amend, partialAmend, entrench, dislodge, dislodgeBy,
amendThenDislodge, amendThenDislodgeBy, partialAmendThenDislodge, partialAmendThenDislodgeBy,
markAsToken,
filterSWith, mapMaybeSWith, filterOut, guardAgainst, unexpectedWhen, unexpectedWithReasonWhen
) where
import Prelude hiding (fail)
import Text.Gigaparsec.Errors.ErrorGen (ErrorGen, vanillaGen, specializedGen)
import Text.Gigaparsec.Errors.ErrorGen qualified as ErrorGen
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 (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 Text.Gigaparsec.Position (withWidth)
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)
import Data.Maybe (isNothing, fromJust)
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) =
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) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a)
-> (forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
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' 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 = Set.map ExpectNamed ls }
bad' :: ParseError -> State -> RT r
bad' ParseError
err = (ParseError -> State -> RT r) -> ParseError -> State -> RT r
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 State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
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 r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a)
-> (forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
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' { Internal.hints = Internal.hints st }
bad' :: ParseError -> State -> RT r
bad' ParseError
err State
st'
| State -> Word
Internal.consumed State
st' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
origConsumed = ParseError -> State -> RT r
bad ParseError
err State
st'
| Bool
otherwise = (ParseError -> State -> RT r) -> ParseError -> State -> RT r
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 State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
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 r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a)
-> (forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
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 = (ParseError -> State -> RT r) -> ParseError -> State -> RT r
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 State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
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 = (State -> ParseError) -> Parsec a
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 = CaretWidth -> NonEmpty String -> Parsec a
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 = 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 -> ParseError) -> Parsec a
forall a. (State -> ParseError) -> Parsec a
Internal.raise (\State
st -> State -> [String] -> CaretWidth -> ParseError
Internal.specialisedErr State
st (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
msgs) CaretWidth
width)
unexpected :: String
-> 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)
unexpectedWide :: Word
-> String
-> 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 -> ParseError) -> Parsec a
forall a. (State -> ParseError) -> Parsec a
Internal.raise ((State -> ParseError) -> Parsec a)
-> (State -> ParseError) -> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st -> State -> Set ExpectItem -> String -> CaretWidth -> ParseError
Internal.unexpectedErr State
st Set ExpectItem
forall a. Set a
Set.empty String
name CaretWidth
width
amend :: Parsec a -> Parsec a
amend :: forall a. Parsec a -> Parsec a
amend = (Word -> Word -> Word -> ParseError -> ParseError)
-> Parsec a -> Parsec a
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 = (Word -> Word -> Word -> ParseError -> ParseError)
-> Parsec a -> Parsec a
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 r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a)
-> (forall r.
State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r)
-> Parsec a
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 State
-> (a -> State -> RT r) -> (ParseError -> State -> RT r) -> RT r
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) -> RT r)
-> (ParseError -> State -> RT r) -> RT r
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' { Internal.hints = origHints
, Internal.hintsValidOffset = origHintsValidOffset }
entrench :: Parsec a -> Parsec a
entrench :: forall a. Parsec a -> Parsec a
entrench = (ParseError -> ParseError) -> Parsec a -> Parsec a
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 = Word -> Parsec a -> Parsec a
forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
forall a. Bounded a => a
maxBound
dislodgeBy :: Word -> Parsec a -> Parsec a
dislodgeBy :: forall a. Word -> Parsec a -> Parsec a
dislodgeBy Word
by = (ParseError -> ParseError) -> Parsec a -> Parsec a
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 = 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
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
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
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
markAsToken :: Parsec a -> Parsec a
markAsToken :: forall a. Parsec a -> Parsec a
markAsToken = (ParseError -> ParseError) -> Parsec a -> Parsec a
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
(<?>) = (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
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
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)
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)
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)
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)
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)