mirror of
https://github.com/mrkkrp/megaparsec.git
synced 2024-12-23 08:11:56 +03:00
Bump mrkkrp/ormolu-action from 9 to 10
Bumps [mrkkrp/ormolu-action](https://github.com/mrkkrp/ormolu-action) from 9 to 10. - [Release notes](https://github.com/mrkkrp/ormolu-action/releases) - [Changelog](https://github.com/mrkkrp/ormolu-action/blob/master/CHANGELOG.md) - [Commits](https://github.com/mrkkrp/ormolu-action/compare/v9...v10) --- updated-dependencies: - dependency-name: mrkkrp/ormolu-action dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] <support@github.com>
This commit is contained in:
dependabot[bot]
Mark Karpov
parent
e0cf82e0f6
commit
69d4c46e36
2
.github/workflows/ci.yaml
vendored
2
.github/workflows/ci.yaml
vendored
@ -12,7 +12,7 @@ jobs:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: mrkkrp/ormolu-action@v9
|
||||
- uses: mrkkrp/ormolu-action@v10
|
||||
build:
|
||||
runs-on: ubuntu-latest
|
||||
needs: ormolu
|
||||
|
||||
@ -253,7 +253,7 @@ runParser' p = runIdentity . runParserT' p
|
||||
-- underlying monad @m@ that returns either a 'ParseErrorBundle' ('Left') or
|
||||
-- a value of type @a@ ('Right').
|
||||
runParserT ::
|
||||
Monad m =>
|
||||
(Monad m) =>
|
||||
-- | Parser to run
|
||||
ParsecT e s m a ->
|
||||
-- | Name of source file
|
||||
@ -269,7 +269,7 @@ runParserT p name s = snd <$> runParserT' p (initialState name s)
|
||||
--
|
||||
-- @since 4.2.0
|
||||
runParserT' ::
|
||||
Monad m =>
|
||||
(Monad m) =>
|
||||
-- | Parser to run
|
||||
ParsecT e s m a ->
|
||||
-- | Initial state
|
||||
@ -323,7 +323,7 @@ initialState name s =
|
||||
--
|
||||
-- @since 6.0.0
|
||||
failure ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Unexpected item (if any)
|
||||
Maybe (ErrorItem (Token s)) ->
|
||||
-- | Expected items
|
||||
@ -339,7 +339,7 @@ failure us ps = do
|
||||
--
|
||||
-- @since 6.0.0
|
||||
fancyFailure ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Fancy error components
|
||||
Set (ErrorFancy e) ->
|
||||
m a
|
||||
@ -352,7 +352,7 @@ fancyFailure xs = do
|
||||
-- about unexpected item @item@ without consuming any input.
|
||||
--
|
||||
-- > unexpected item = failure (Just item) Set.empty
|
||||
unexpected :: MonadParsec e s m => ErrorItem (Token s) -> m a
|
||||
unexpected :: (MonadParsec e s m) => ErrorItem (Token s) -> m a
|
||||
unexpected item = failure (Just item) E.empty
|
||||
{-# INLINE unexpected #-}
|
||||
|
||||
@ -362,7 +362,7 @@ unexpected item = failure (Just item) E.empty
|
||||
-- > customFailure = fancyFailure . Set.singleton . ErrorCustom
|
||||
--
|
||||
-- @since 6.3.0
|
||||
customFailure :: MonadParsec e s m => e -> m a
|
||||
customFailure :: (MonadParsec e s m) => e -> m a
|
||||
customFailure = fancyFailure . E.singleton . ErrorCustom
|
||||
{-# INLINE customFailure #-}
|
||||
|
||||
@ -375,7 +375,7 @@ customFailure = fancyFailure . E.singleton . ErrorCustom
|
||||
--
|
||||
-- @since 5.3.0
|
||||
region ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | How to process 'ParseError's
|
||||
(ParseError s e -> ParseError s e) ->
|
||||
-- | The “region” that the processing applies to
|
||||
@ -401,7 +401,7 @@ region f m = do
|
||||
-- at once.
|
||||
--
|
||||
-- @since 8.0.0
|
||||
registerParseError :: MonadParsec e s m => ParseError s e -> m ()
|
||||
registerParseError :: (MonadParsec e s m) => ParseError s e -> m ()
|
||||
registerParseError e = updateParserState $ \s ->
|
||||
s {stateParseErrors = e : stateParseErrors s}
|
||||
{-# INLINE registerParseError #-}
|
||||
@ -410,7 +410,7 @@ registerParseError e = updateParserState $ \s ->
|
||||
--
|
||||
-- @since 8.0.0
|
||||
registerFailure ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Unexpected item (if any)
|
||||
Maybe (ErrorItem (Token s)) ->
|
||||
-- | Expected items
|
||||
@ -425,7 +425,7 @@ registerFailure us ps = do
|
||||
--
|
||||
-- @since 8.0.0
|
||||
registerFancyFailure ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Fancy error components
|
||||
Set (ErrorFancy e) ->
|
||||
m ()
|
||||
@ -446,7 +446,7 @@ registerFancyFailure xs = do
|
||||
--
|
||||
-- @since 7.0.0
|
||||
single ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Token to match
|
||||
Token s ->
|
||||
m (Token s)
|
||||
@ -470,7 +470,7 @@ single t = token testToken expected
|
||||
--
|
||||
-- @since 7.0.0
|
||||
satisfy ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Predicate to apply
|
||||
(Token s -> Bool) ->
|
||||
m (Token s)
|
||||
@ -487,7 +487,7 @@ satisfy f = token testChar E.empty
|
||||
-- See also: 'satisfy', 'anySingleBut'.
|
||||
--
|
||||
-- @since 7.0.0
|
||||
anySingle :: MonadParsec e s m => m (Token s)
|
||||
anySingle :: (MonadParsec e s m) => m (Token s)
|
||||
anySingle = satisfy (const True)
|
||||
{-# INLINE anySingle #-}
|
||||
|
||||
@ -500,7 +500,7 @@ anySingle = satisfy (const True)
|
||||
--
|
||||
-- @since 7.0.0
|
||||
anySingleBut ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Token we should not match
|
||||
Token s ->
|
||||
m (Token s)
|
||||
@ -564,7 +564,7 @@ noneOf cs = satisfy (`notElem` cs)
|
||||
--
|
||||
-- @since 7.0.0
|
||||
chunk ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Chunk to match
|
||||
Tokens s ->
|
||||
m (Tokens s)
|
||||
@ -574,7 +574,7 @@ chunk = tokens (==)
|
||||
-- | A synonym for 'label' in the form of an operator.
|
||||
infix 0 <?>
|
||||
|
||||
(<?>) :: MonadParsec e s m => m a -> String -> m a
|
||||
(<?>) :: (MonadParsec e s m) => m a -> String -> m a
|
||||
(<?>) = flip label
|
||||
{-# INLINE (<?>) #-}
|
||||
|
||||
@ -584,7 +584,7 @@ infix 0 <?>
|
||||
-- manually in the argument parser, prepare for troubles.
|
||||
--
|
||||
-- @since 5.3.0
|
||||
match :: MonadParsec e s m => m a -> m (Tokens s, a)
|
||||
match :: (MonadParsec e s m) => m a -> m (Tokens s, a)
|
||||
match p = do
|
||||
o <- getOffset
|
||||
s <- getInput
|
||||
@ -604,7 +604,7 @@ match p = do
|
||||
-- > takeRest = takeWhileP Nothing (const True)
|
||||
--
|
||||
-- @since 6.0.0
|
||||
takeRest :: MonadParsec e s m => m (Tokens s)
|
||||
takeRest :: (MonadParsec e s m) => m (Tokens s)
|
||||
takeRest = takeWhileP Nothing (const True)
|
||||
{-# INLINE takeRest #-}
|
||||
|
||||
@ -613,7 +613,7 @@ takeRest = takeWhileP Nothing (const True)
|
||||
-- > atEnd = option False (True <$ hidden eof)
|
||||
--
|
||||
-- @since 6.0.0
|
||||
atEnd :: MonadParsec e s m => m Bool
|
||||
atEnd :: (MonadParsec e s m) => m Bool
|
||||
atEnd = option False (True <$ hidden eof)
|
||||
{-# INLINE atEnd #-}
|
||||
|
||||
@ -621,12 +621,12 @@ atEnd = option False (True <$ hidden eof)
|
||||
-- Parser state combinators
|
||||
|
||||
-- | Return the current input.
|
||||
getInput :: MonadParsec e s m => m s
|
||||
getInput :: (MonadParsec e s m) => m s
|
||||
getInput = stateInput <$> getParserState
|
||||
{-# INLINE getInput #-}
|
||||
|
||||
-- | @'setInput' input@ continues parsing with @input@.
|
||||
setInput :: MonadParsec e s m => s -> m ()
|
||||
setInput :: (MonadParsec e s m) => s -> m ()
|
||||
setInput s = updateParserState (\(State _ o pst de) -> State s o pst de)
|
||||
{-# INLINE setInput #-}
|
||||
|
||||
@ -652,7 +652,7 @@ getSourcePos = do
|
||||
-- See also: 'setOffset'.
|
||||
--
|
||||
-- @since 7.0.0
|
||||
getOffset :: MonadParsec e s m => m Int
|
||||
getOffset :: (MonadParsec e s m) => m Int
|
||||
getOffset = stateOffset <$> getParserState
|
||||
{-# INLINE getOffset #-}
|
||||
|
||||
@ -661,7 +661,7 @@ getOffset = stateOffset <$> getParserState
|
||||
-- See also: 'getOffset'.
|
||||
--
|
||||
-- @since 7.0.0
|
||||
setOffset :: MonadParsec e s m => Int -> m ()
|
||||
setOffset :: (MonadParsec e s m) => Int -> m ()
|
||||
setOffset o = updateParserState $ \(State s _ pst de) ->
|
||||
State s o pst de
|
||||
{-# INLINE setOffset #-}
|
||||
@ -669,6 +669,6 @@ setOffset o = updateParserState $ \(State s _ pst de) ->
|
||||
-- | @'setParserState' st@ sets the parser state to @st@.
|
||||
--
|
||||
-- See also: 'getParserState', 'updateParserState'.
|
||||
setParserState :: MonadParsec e s m => State s e -> m ()
|
||||
setParserState :: (MonadParsec e s m) => State s e -> m ()
|
||||
setParserState st = updateParserState (const st)
|
||||
{-# INLINE setParserState #-}
|
||||
|
||||
@ -185,7 +185,7 @@ int64be = anyBE (Just "big-endian 64 int")
|
||||
--
|
||||
-- Performs ceiling division, so byte-unaligned types (bitsize not a
|
||||
-- multiple of 8) should work, but further usage is not tested.
|
||||
finiteByteSize :: forall a. FiniteBits a => Int
|
||||
finiteByteSize :: forall a. (FiniteBits a) => Int
|
||||
finiteByteSize = finiteBitSize @a undefined `ceilDiv` 8
|
||||
where
|
||||
ceilDiv x y = (x + y - 1) `div` y
|
||||
|
||||
@ -152,7 +152,7 @@ indentLevel = sourceColumn <$> getSourcePos
|
||||
--
|
||||
-- @since 5.0.0
|
||||
incorrectIndent ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | Desired ordering between reference level and actual level
|
||||
Ordering ->
|
||||
-- | Reference indentation level
|
||||
|
||||
@ -275,7 +275,7 @@ class (Stream s, MonadPlus m) => MonadParsec e s m | m -> e s where
|
||||
----------------------------------------------------------------------------
|
||||
-- Lifting through MTL
|
||||
|
||||
instance MonadParsec e s m => MonadParsec e s (L.StateT st m) where
|
||||
instance (MonadParsec e s m) => MonadParsec e s (L.StateT st m) where
|
||||
parseError e = lift (parseError e)
|
||||
label n (L.StateT m) = L.StateT $ label n . m
|
||||
try (L.StateT m) = L.StateT $ try . m
|
||||
@ -296,7 +296,7 @@ instance MonadParsec e s m => MonadParsec e s (L.StateT st m) where
|
||||
getParserState = lift getParserState
|
||||
updateParserState f = lift (updateParserState f)
|
||||
|
||||
instance MonadParsec e s m => MonadParsec e s (S.StateT st m) where
|
||||
instance (MonadParsec e s m) => MonadParsec e s (S.StateT st m) where
|
||||
parseError e = lift (parseError e)
|
||||
label n (S.StateT m) = S.StateT $ label n . m
|
||||
try (S.StateT m) = S.StateT $ try . m
|
||||
@ -317,7 +317,7 @@ instance MonadParsec e s m => MonadParsec e s (S.StateT st m) where
|
||||
getParserState = lift getParserState
|
||||
updateParserState f = lift (updateParserState f)
|
||||
|
||||
instance MonadParsec e s m => MonadParsec e s (L.ReaderT r m) where
|
||||
instance (MonadParsec e s m) => MonadParsec e s (L.ReaderT r m) where
|
||||
parseError e = lift (parseError e)
|
||||
label n (L.ReaderT m) = L.ReaderT $ label n . m
|
||||
try (L.ReaderT m) = L.ReaderT $ try . m
|
||||
@ -433,7 +433,7 @@ instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.RWST r w st m) wher
|
||||
getParserState = lift getParserState
|
||||
updateParserState f = lift (updateParserState f)
|
||||
|
||||
instance MonadParsec e s m => MonadParsec e s (IdentityT m) where
|
||||
instance (MonadParsec e s m) => MonadParsec e s (IdentityT m) where
|
||||
parseError e = lift (parseError e)
|
||||
label n (IdentityT m) = IdentityT $ label n m
|
||||
try = IdentityT . try . runIdentityT
|
||||
@ -457,7 +457,7 @@ fixs s (Left a) = (Left a, s)
|
||||
fixs _ (Right (b, s)) = (Right b, s)
|
||||
{-# INLINE fixs #-}
|
||||
|
||||
fixs' :: Monoid w => s -> Either a (b, s, w) -> (Either a b, s, w)
|
||||
fixs' :: (Monoid w) => s -> Either a (b, s, w) -> (Either a b, s, w)
|
||||
fixs' s (Left a) = (Left a, s, mempty)
|
||||
fixs' _ (Right (b, s, w)) = (Right b, s, w)
|
||||
{-# INLINE fixs' #-}
|
||||
|
||||
@ -25,7 +25,7 @@ import Data.Function (on)
|
||||
import Text.Megaparsec
|
||||
|
||||
-- | A synonym for 'chunk'.
|
||||
string :: MonadParsec e s m => Tokens s -> m (Tokens s)
|
||||
string :: (MonadParsec e s m) => Tokens s -> m (Tokens s)
|
||||
string = chunk
|
||||
{-# INLINE string #-}
|
||||
|
||||
|
||||
@ -43,7 +43,7 @@ import Text.Megaparsec.Stream
|
||||
-- | Type class describing parser monads that can trace during evaluation.
|
||||
--
|
||||
-- @since 9.3.0
|
||||
class MonadParsec e s m => MonadParsecDbg e s m where
|
||||
class (MonadParsec e s m) => MonadParsecDbg e s m where
|
||||
-- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated
|
||||
-- it prints information useful for debugging. The @label@ is only used to
|
||||
-- refer to this parser in the debugging output. This combinator uses the
|
||||
@ -70,7 +70,7 @@ class MonadParsec e s m => MonadParsecDbg e s m where
|
||||
-- function that worked only in 'ParsecT'. It was first introduced in the
|
||||
-- version /7.0.0/.
|
||||
dbg ::
|
||||
Show a =>
|
||||
(Show a) =>
|
||||
-- | Debugging label
|
||||
String ->
|
||||
-- | Parser to debug
|
||||
@ -109,7 +109,7 @@ instance
|
||||
dbgWithComment "STATE" str $ S.runStateT sma s
|
||||
|
||||
instance
|
||||
MonadParsecDbg e s m =>
|
||||
(MonadParsecDbg e s m) =>
|
||||
MonadParsecDbg e s (L.ReaderT r m)
|
||||
where
|
||||
dbg = L.mapReaderT . dbg
|
||||
@ -182,7 +182,7 @@ instance
|
||||
((a, st), w) <- first unComment . unComment <$> dbg str smth
|
||||
pure (a, st, w)
|
||||
|
||||
instance MonadParsecDbg e s m => MonadParsecDbg e s (IdentityT m) where
|
||||
instance (MonadParsecDbg e s m) => MonadParsecDbg e s (IdentityT m) where
|
||||
dbg = mapIdentityT . dbg
|
||||
|
||||
-- | @'dbgWithComment' label_a label_c m@ traces the first component of the
|
||||
@ -273,7 +273,7 @@ dbgLog lbl item = prefix msg
|
||||
"MATCH (EERR): " ++ showStream pxy ts ++ "\nERROR:\n" ++ parseErrorPretty e
|
||||
|
||||
-- | Pretty-print a list of tokens.
|
||||
showStream :: VisualStream s => Proxy s -> [Token s] -> String
|
||||
showStream :: (VisualStream s) => Proxy s -> [Token s] -> String
|
||||
showStream pxy ts =
|
||||
case NE.nonEmpty ts of
|
||||
Nothing -> "<EMPTY>"
|
||||
@ -293,7 +293,7 @@ streamDelta ::
|
||||
streamDelta s0 s1 = stateOffset s1 - stateOffset s0
|
||||
|
||||
-- | Extract a given number of tokens from the stream.
|
||||
streamTake :: forall s. Stream s => Int -> s -> [Token s]
|
||||
streamTake :: forall s. (Stream s) => Int -> s -> [Token s]
|
||||
streamTake n s =
|
||||
case fst <$> takeN_ n s of
|
||||
Nothing -> []
|
||||
@ -304,7 +304,7 @@ streamTake n s =
|
||||
--
|
||||
-- @since 9.1.0
|
||||
dbg' ::
|
||||
MonadParsecDbg e s m =>
|
||||
(MonadParsecDbg e s m) =>
|
||||
-- | Debugging label
|
||||
String ->
|
||||
-- | Parser to debug
|
||||
|
||||
@ -80,7 +80,7 @@ data ErrorItem t
|
||||
EndOfInput
|
||||
deriving (Show, Read, Eq, Ord, Data, Typeable, Generic, Functor)
|
||||
|
||||
instance NFData t => NFData (ErrorItem t)
|
||||
instance (NFData t) => NFData (ErrorItem t)
|
||||
|
||||
-- | Additional error data, extendable by user. When no custom data is
|
||||
-- necessary, the type is typically indexed by 'Void' to “cancel” the
|
||||
@ -98,7 +98,7 @@ data ErrorFancy e
|
||||
ErrorCustom e
|
||||
deriving (Show, Read, Eq, Ord, Data, Typeable, Generic, Functor)
|
||||
|
||||
instance NFData a => NFData (ErrorFancy a) where
|
||||
instance (NFData a) => NFData (ErrorFancy a) where
|
||||
rnf (ErrorFail str) = rnf str
|
||||
rnf (ErrorIndentation ord ref act) = ord `seq` rnf ref `seq` rnf act
|
||||
rnf (ErrorCustom a) = rnf a
|
||||
@ -180,7 +180,7 @@ instance
|
||||
--
|
||||
-- @since 7.0.0
|
||||
mapParseError ::
|
||||
Ord e' =>
|
||||
(Ord e') =>
|
||||
(e -> e') ->
|
||||
ParseError s e ->
|
||||
ParseError s e'
|
||||
@ -332,7 +332,7 @@ attachSourcePos projectOffset xs = runState (traverse f xs)
|
||||
-- | The type class defines how to print a custom component of 'ParseError'.
|
||||
--
|
||||
-- @since 5.0.0
|
||||
class Ord a => ShowErrorComponent a where
|
||||
class (Ord a) => ShowErrorComponent a where
|
||||
-- | Pretty-print a component of 'ParseError'.
|
||||
showErrorComponent :: a -> String
|
||||
|
||||
@ -458,20 +458,20 @@ parseErrorTextPretty (FancyError _ xs) =
|
||||
-- Helpers
|
||||
|
||||
-- | Pretty-print an 'ErrorItem'.
|
||||
showErrorItem :: VisualStream s => Proxy s -> ErrorItem (Token s) -> String
|
||||
showErrorItem :: (VisualStream s) => Proxy s -> ErrorItem (Token s) -> String
|
||||
showErrorItem pxy = \case
|
||||
Tokens ts -> showTokens pxy ts
|
||||
Label label -> NE.toList label
|
||||
EndOfInput -> "end of input"
|
||||
|
||||
-- | Get length of the “pointer” to display under a given 'ErrorItem'.
|
||||
errorItemLength :: VisualStream s => Proxy s -> ErrorItem (Token s) -> Int
|
||||
errorItemLength :: (VisualStream s) => Proxy s -> ErrorItem (Token s) -> Int
|
||||
errorItemLength pxy = \case
|
||||
Tokens ts -> tokensLength pxy ts
|
||||
_ -> 1
|
||||
|
||||
-- | Pretty-print an 'ErrorFancy'.
|
||||
showErrorFancy :: ShowErrorComponent e => ErrorFancy e -> String
|
||||
showErrorFancy :: (ShowErrorComponent e) => ErrorFancy e -> String
|
||||
showErrorFancy = \case
|
||||
ErrorFail msg -> msg
|
||||
ErrorIndentation ord ref actual ->
|
||||
@ -489,7 +489,7 @@ showErrorFancy = \case
|
||||
ErrorCustom a -> showErrorComponent a
|
||||
|
||||
-- | Get length of the “pointer” to display under a given 'ErrorFancy'.
|
||||
errorFancyLength :: ShowErrorComponent e => ErrorFancy e -> Int
|
||||
errorFancyLength :: (ShowErrorComponent e) => ErrorFancy e -> Int
|
||||
errorFancyLength = \case
|
||||
ErrorCustom a -> errorComponentLen a
|
||||
_ -> 1
|
||||
|
||||
@ -59,9 +59,9 @@ import Text.Megaparsec.Stream
|
||||
data ET s = ET (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s)))
|
||||
deriving (Typeable, Generic)
|
||||
|
||||
deriving instance Eq (Token s) => Eq (ET s)
|
||||
deriving instance (Eq (Token s)) => Eq (ET s)
|
||||
|
||||
deriving instance Ord (Token s) => Ord (ET s)
|
||||
deriving instance (Ord (Token s)) => Ord (ET s)
|
||||
|
||||
deriving instance
|
||||
( Data s,
|
||||
@ -70,7 +70,7 @@ deriving instance
|
||||
) =>
|
||||
Data (ET s)
|
||||
|
||||
instance Stream s => Semigroup (ET s) where
|
||||
instance (Stream s) => Semigroup (ET s) where
|
||||
ET us0 ps0 <> ET us1 ps1 = ET (n us0 us1) (E.union ps0 ps1)
|
||||
where
|
||||
n Nothing Nothing = Nothing
|
||||
@ -78,7 +78,7 @@ instance Stream s => Semigroup (ET s) where
|
||||
n Nothing (Just y) = Just y
|
||||
n (Just x) (Just y) = Just (max x y)
|
||||
|
||||
instance Stream s => Monoid (ET s) where
|
||||
instance (Stream s) => Monoid (ET s) where
|
||||
mempty = ET Nothing E.empty
|
||||
mappend = (<>)
|
||||
|
||||
@ -86,10 +86,10 @@ instance Stream s => Monoid (ET s) where
|
||||
newtype EF e = EF (Set (ErrorFancy e))
|
||||
deriving (Eq, Ord, Data, Typeable, Generic)
|
||||
|
||||
instance Ord e => Semigroup (EF e) where
|
||||
instance (Ord e) => Semigroup (EF e) where
|
||||
EF xs0 <> EF xs1 = EF (E.union xs0 xs1)
|
||||
|
||||
instance Ord e => Monoid (EF e) where
|
||||
instance (Ord e) => Monoid (EF e) where
|
||||
mempty = EF E.empty
|
||||
mappend = (<>)
|
||||
|
||||
@ -122,43 +122,43 @@ errFancy p (EF xs) = FancyError p xs
|
||||
-- Error components
|
||||
|
||||
-- | Construct an “unexpected token” error component.
|
||||
utok :: Stream s => Token s -> ET s
|
||||
utok :: (Stream s) => Token s -> ET s
|
||||
utok = unexp . Tokens . nes
|
||||
|
||||
-- | Construct an “unexpected tokens” error component. Empty chunk produces
|
||||
-- 'EndOfInput'.
|
||||
utoks :: forall s. Stream s => Tokens s -> ET s
|
||||
utoks :: forall s. (Stream s) => Tokens s -> ET s
|
||||
utoks = unexp . canonicalizeTokens (Proxy :: Proxy s)
|
||||
|
||||
-- | Construct an “unexpected label” error component. Do not use with empty
|
||||
-- strings (for empty strings it's bottom).
|
||||
ulabel :: Stream s => String -> ET s
|
||||
ulabel :: (Stream s) => String -> ET s
|
||||
ulabel label
|
||||
| label == "" = error "Text.Megaparsec.Error.Builder.ulabel: empty label"
|
||||
| otherwise = unexp . Label . NE.fromList $ label
|
||||
|
||||
-- | Construct an “unexpected end of input” error component.
|
||||
ueof :: Stream s => ET s
|
||||
ueof :: (Stream s) => ET s
|
||||
ueof = unexp EndOfInput
|
||||
|
||||
-- | Construct an “expected token” error component.
|
||||
etok :: Stream s => Token s -> ET s
|
||||
etok :: (Stream s) => Token s -> ET s
|
||||
etok = expe . Tokens . nes
|
||||
|
||||
-- | Construct an “expected tokens” error component. Empty chunk produces
|
||||
-- 'EndOfInput'.
|
||||
etoks :: forall s. Stream s => Tokens s -> ET s
|
||||
etoks :: forall s. (Stream s) => Tokens s -> ET s
|
||||
etoks = expe . canonicalizeTokens (Proxy :: Proxy s)
|
||||
|
||||
-- | Construct an “expected label” error component. Do not use with empty
|
||||
-- strings.
|
||||
elabel :: Stream s => String -> ET s
|
||||
elabel :: (Stream s) => String -> ET s
|
||||
elabel label
|
||||
| label == "" = error "Text.Megaparsec.Error.Builder.elabel: empty label"
|
||||
| otherwise = expe . Label . NE.fromList $ label
|
||||
|
||||
-- | Construct an “expected end of input” error component.
|
||||
eeof :: Stream s => ET s
|
||||
eeof :: (Stream s) => ET s
|
||||
eeof = expe EndOfInput
|
||||
|
||||
-- | Construct a custom error component.
|
||||
@ -171,7 +171,7 @@ fancy = EF . E.singleton
|
||||
-- | Construct the appropriate 'ErrorItem' representation for the given
|
||||
-- token stream. The empty string produces 'EndOfInput'.
|
||||
canonicalizeTokens ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
Proxy s ->
|
||||
Tokens s ->
|
||||
ErrorItem (Token s)
|
||||
@ -181,11 +181,11 @@ canonicalizeTokens pxy ts =
|
||||
Just xs -> Tokens xs
|
||||
|
||||
-- | Lift an unexpected item into 'ET'.
|
||||
unexp :: Stream s => ErrorItem (Token s) -> ET s
|
||||
unexp :: (Stream s) => ErrorItem (Token s) -> ET s
|
||||
unexp u = ET (pure u) E.empty
|
||||
|
||||
-- | Lift an expected item into 'ET'.
|
||||
expe :: Stream s => ErrorItem (Token s) -> ET s
|
||||
expe :: (Stream s) => ErrorItem (Token s) -> ET s
|
||||
expe p = ET Nothing (E.singleton p)
|
||||
|
||||
-- | Make a singleton non-empty list from a value.
|
||||
|
||||
@ -87,10 +87,10 @@ import Text.Megaparsec.Stream
|
||||
-- expecting 'r' or end of input
|
||||
newtype Hints t = Hints (Set (ErrorItem t))
|
||||
|
||||
instance Ord t => Semigroup (Hints t) where
|
||||
instance (Ord t) => Semigroup (Hints t) where
|
||||
Hints xs <> Hints ys = Hints $ xs <> ys
|
||||
|
||||
instance Ord t => Monoid (Hints t) where
|
||||
instance (Ord t) => Monoid (Hints t) where
|
||||
mempty = Hints mempty
|
||||
|
||||
-- | All information available after parsing. This includes consumption of
|
||||
@ -164,18 +164,18 @@ pMap f p = ParsecT $ \s cok cerr eok eerr ->
|
||||
{-# INLINE pMap #-}
|
||||
|
||||
-- | 'pure' returns a parser that __succeeds__ without consuming input.
|
||||
instance Stream s => Applicative (ParsecT e s m) where
|
||||
instance (Stream s) => Applicative (ParsecT e s m) where
|
||||
pure = pPure
|
||||
(<*>) = pAp
|
||||
p1 *> p2 = p1 `pBind` const p2
|
||||
p1 <* p2 = do x1 <- p1; void p2; return x1
|
||||
|
||||
pPure :: Stream s => a -> ParsecT e s m a
|
||||
pPure :: (Stream s) => a -> ParsecT e s m a
|
||||
pPure x = ParsecT $ \s _ _ eok _ -> eok x s mempty
|
||||
{-# INLINE pPure #-}
|
||||
|
||||
pAp ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
ParsecT e s m (a -> b) ->
|
||||
ParsecT e s m a ->
|
||||
ParsecT e s m b
|
||||
@ -205,12 +205,12 @@ instance (Ord e, Stream s) => Alternative (ParsecT e s m) where
|
||||
(<|>) = mplus
|
||||
|
||||
-- | 'return' returns a parser that __succeeds__ without consuming input.
|
||||
instance Stream s => Monad (ParsecT e s m) where
|
||||
instance (Stream s) => Monad (ParsecT e s m) where
|
||||
return = pure
|
||||
(>>=) = pBind
|
||||
|
||||
pBind ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
ParsecT e s m a ->
|
||||
(a -> ParsecT e s m b) ->
|
||||
ParsecT e s m b
|
||||
@ -234,7 +234,7 @@ pBind m k = ParsecT $ \s cok cerr eok eerr ->
|
||||
in unParser m s mcok cerr meok eerr
|
||||
{-# INLINE pBind #-}
|
||||
|
||||
instance Stream s => Fail.MonadFail (ParsecT e s m) where
|
||||
instance (Stream s) => Fail.MonadFail (ParsecT e s m) where
|
||||
fail = pFail
|
||||
|
||||
pFail :: String -> ParsecT e s m a
|
||||
@ -332,7 +332,7 @@ instance (Stream s, MonadFix m) => MonadFix (ParsecT e s m) where
|
||||
Error _ -> error "mfix ParsecT"
|
||||
runParsecT (f a) s
|
||||
|
||||
instance Stream s => MonadTrans (ParsecT e s) where
|
||||
instance (Stream s) => MonadTrans (ParsecT e s) where
|
||||
lift amb = ParsecT $ \s _ _ eok _ ->
|
||||
amb >>= \a -> eok a s mempty
|
||||
|
||||
@ -381,13 +381,13 @@ pTry p = ParsecT $ \s cok _ eok eerr ->
|
||||
in unParser p s cok eerr' eok eerr'
|
||||
{-# INLINE pTry #-}
|
||||
|
||||
pLookAhead :: Stream s => ParsecT e s m a -> ParsecT e s m a
|
||||
pLookAhead :: (Stream s) => ParsecT e s m a -> ParsecT e s m a
|
||||
pLookAhead p = ParsecT $ \s _ cerr eok eerr ->
|
||||
let eok' a _ _ = eok a s mempty
|
||||
in unParser p s eok' cerr eok' eerr
|
||||
{-# INLINE pLookAhead #-}
|
||||
|
||||
pNotFollowedBy :: Stream s => ParsecT e s m a -> ParsecT e s m ()
|
||||
pNotFollowedBy :: (Stream s) => ParsecT e s m a -> ParsecT e s m ()
|
||||
pNotFollowedBy p = ParsecT $ \s@(State input o _ _) _ _ eok eerr ->
|
||||
let what = maybe EndOfInput (Tokens . nes . fst) (take1_ input)
|
||||
unexpect u = TrivialError o (pure u) E.empty
|
||||
@ -399,7 +399,7 @@ pNotFollowedBy p = ParsecT $ \s@(State input o _ _) _ _ eok eerr ->
|
||||
{-# INLINE pNotFollowedBy #-}
|
||||
|
||||
pWithRecovery ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
(ParseError s e -> ParsecT e s m a) ->
|
||||
ParsecT e s m a ->
|
||||
ParsecT e s m a
|
||||
@ -420,7 +420,7 @@ pWithRecovery r p = ParsecT $ \s cok cerr eok eerr ->
|
||||
{-# INLINE pWithRecovery #-}
|
||||
|
||||
pObserving ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
ParsecT e s m a ->
|
||||
ParsecT e s m (Either (ParseError s e) a)
|
||||
pObserving p = ParsecT $ \s cok _ eok _ ->
|
||||
@ -429,7 +429,7 @@ pObserving p = ParsecT $ \s cok _ eok _ ->
|
||||
in unParser p s (cok . Right) cerr' (eok . Right) eerr'
|
||||
{-# INLINE pObserving #-}
|
||||
|
||||
pEof :: forall e s m. Stream s => ParsecT e s m ()
|
||||
pEof :: forall e s m. (Stream s) => ParsecT e s m ()
|
||||
pEof = ParsecT $ \s@(State input o pst de) _ _ eok eerr ->
|
||||
case take1_ input of
|
||||
Nothing -> eok () s mempty
|
||||
@ -443,7 +443,7 @@ pEof = ParsecT $ \s@(State input o pst de) _ _ eok eerr ->
|
||||
|
||||
pToken ::
|
||||
forall e s m a.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
(Token s -> Maybe a) ->
|
||||
Set (ErrorItem (Token s)) ->
|
||||
ParsecT e s m a
|
||||
@ -465,7 +465,7 @@ pToken test ps = ParsecT $ \s@(State input o pst de) cok _ _ eerr ->
|
||||
|
||||
pTokens ::
|
||||
forall e s m.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
(Tokens s -> Tokens s -> Bool) ->
|
||||
Tokens s ->
|
||||
ParsecT e s m (Tokens s)
|
||||
@ -493,7 +493,7 @@ pTokens f tts = ParsecT $ \s@(State input o pst de) cok _ eok eerr ->
|
||||
|
||||
pTakeWhileP ::
|
||||
forall e s m.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
Maybe String ->
|
||||
(Token s -> Bool) ->
|
||||
ParsecT e s m (Tokens s)
|
||||
@ -512,7 +512,7 @@ pTakeWhileP ml f = ParsecT $ \(State input o pst de) cok _ eok _ ->
|
||||
|
||||
pTakeWhile1P ::
|
||||
forall e s m.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
Maybe String ->
|
||||
(Token s -> Bool) ->
|
||||
ParsecT e s m (Tokens s)
|
||||
@ -540,7 +540,7 @@ pTakeWhile1P ml f = ParsecT $ \(State input o pst de) cok _ _ eerr ->
|
||||
|
||||
pTakeP ::
|
||||
forall e s m.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
Maybe String ->
|
||||
Int ->
|
||||
ParsecT e s m (Tokens s)
|
||||
@ -562,11 +562,11 @@ pTakeP ml n' = ParsecT $ \s@(State input o pst de) cok _ _ eerr ->
|
||||
else cok ts (State input' (o + len) pst de) mempty
|
||||
{-# INLINE pTakeP #-}
|
||||
|
||||
pGetParserState :: Stream s => ParsecT e s m (State s e)
|
||||
pGetParserState :: (Stream s) => ParsecT e s m (State s e)
|
||||
pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty
|
||||
{-# INLINE pGetParserState #-}
|
||||
|
||||
pUpdateParserState :: Stream s => (State s e -> State s e) -> ParsecT e s m ()
|
||||
pUpdateParserState :: (Stream s) => (State s e -> State s e) -> ParsecT e s m ()
|
||||
pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty
|
||||
{-# INLINE pUpdateParserState #-}
|
||||
|
||||
@ -579,7 +579,7 @@ nes x = x :| []
|
||||
|
||||
-- | Convert a 'ParseError' record into 'Hints'.
|
||||
toHints ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
-- | Current offset in input stream
|
||||
Int ->
|
||||
-- | Parse error to convert
|
||||
@ -602,7 +602,7 @@ toHints streamPos = \case
|
||||
-- __Note__ that if resulting continuation gets 'ParseError' that has custom
|
||||
-- data in it, hints are ignored.
|
||||
withHints ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
-- | Hints to use
|
||||
Hints (Token s) ->
|
||||
-- | Continuation to influence
|
||||
@ -621,7 +621,7 @@ withHints (Hints ps') c e =
|
||||
-- | @'accHints' hs c@ results in “OK” continuation that will add given
|
||||
-- hints @hs@ to third argument of original continuation @c@.
|
||||
accHints ::
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
-- | 'Hints' to add
|
||||
Hints (Token s) ->
|
||||
-- | An “OK” continuation to alter
|
||||
@ -643,7 +643,7 @@ refreshHints (Hints hs) (Just m) =
|
||||
|
||||
-- | Low-level unpacking of the 'ParsecT' type.
|
||||
runParsecT ::
|
||||
Monad m =>
|
||||
(Monad m) =>
|
||||
-- | Parser to run
|
||||
ParsecT e s m a ->
|
||||
-- | Initial state
|
||||
|
||||
@ -56,7 +56,7 @@ import Text.Megaparsec.Common
|
||||
-- 'space' will just move on or finish depending on whether there is more
|
||||
-- white space for it to consume.
|
||||
space ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | A parser for space characters which does not accept empty
|
||||
-- input (e.g. 'Text.Megaparsec.Char.space1')
|
||||
m () ->
|
||||
@ -78,7 +78,7 @@ space sp line block =
|
||||
-- > lexeme = L.lexeme spaceConsumer
|
||||
-- > integer = lexeme L.decimal
|
||||
lexeme ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | How to consume white space after lexeme
|
||||
m () ->
|
||||
-- | How to parse actual lexeme
|
||||
@ -102,7 +102,7 @@ lexeme spc p = p <* spc
|
||||
-- > colon = symbol ":"
|
||||
-- > dot = symbol "."
|
||||
symbol ::
|
||||
MonadParsec e s m =>
|
||||
(MonadParsec e s m) =>
|
||||
-- | How to consume white space after lexeme
|
||||
m () ->
|
||||
-- | Symbol to parse
|
||||
|
||||
@ -92,4 +92,4 @@ data PosState s = PosState
|
||||
}
|
||||
deriving (Show, Eq, Data, Typeable, Generic)
|
||||
|
||||
instance NFData s => NFData (PosState s)
|
||||
instance (NFData s) => NFData (PosState s)
|
||||
|
||||
@ -131,7 +131,7 @@ class (Ord (Token s), Ord (Tokens s)) => Stream s where
|
||||
takeWhile_ :: (Token s -> Bool) -> s -> (Tokens s, s)
|
||||
|
||||
-- | @since 9.0.0
|
||||
instance Ord a => Stream [a] where
|
||||
instance (Ord a) => Stream [a] where
|
||||
type Token [a] = a
|
||||
type Tokens [a] = [a]
|
||||
tokenToChunk Proxy = pure
|
||||
@ -148,7 +148,7 @@ instance Ord a => Stream [a] where
|
||||
takeWhile_ = span
|
||||
|
||||
-- | @since 9.0.0
|
||||
instance Ord a => Stream (S.Seq a) where
|
||||
instance (Ord a) => Stream (S.Seq a) where
|
||||
type Token (S.Seq a) = a
|
||||
type Tokens (S.Seq a) = S.Seq a
|
||||
tokenToChunk Proxy = pure
|
||||
@ -408,7 +408,7 @@ instance Stream TL.Text where
|
||||
-- | Type class for inputs that can also be used for debugging.
|
||||
--
|
||||
-- @since 9.0.0
|
||||
class Stream s => VisualStream s where
|
||||
class (Stream s) => VisualStream s where
|
||||
-- | Pretty-print non-empty stream of tokens. This function is also used
|
||||
-- to print single tokens (represented as singleton lists).
|
||||
--
|
||||
@ -441,7 +441,7 @@ instance VisualStream TL.Text where
|
||||
-- | Type class for inputs that can also be used for error reporting.
|
||||
--
|
||||
-- @since 9.0.0
|
||||
class Stream s => TraversableStream s where
|
||||
class (Stream s) => TraversableStream s where
|
||||
{-# MINIMAL reachOffset | reachOffsetNoLine #-}
|
||||
|
||||
-- | Given an offset @o@ and initial 'PosState', adjust the state in such
|
||||
@ -552,7 +552,7 @@ data St = St {-# UNPACK #-} !SourcePos ShowS
|
||||
-- stream types.
|
||||
reachOffset' ::
|
||||
forall s.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
-- | How to split input stream at given offset
|
||||
(Int -> s -> (Tokens s, s)) ->
|
||||
-- | How to fold over input stream
|
||||
@ -630,7 +630,7 @@ reachOffset'
|
||||
-- | Like 'reachOffset'' but for 'reachOffsetNoLine'.
|
||||
reachOffsetNoLine' ::
|
||||
forall s.
|
||||
Stream s =>
|
||||
(Stream s) =>
|
||||
-- | How to split input stream at given offset
|
||||
(Int -> s -> (Tokens s, s)) ->
|
||||
-- | How to fold over input stream
|
||||
|
||||
@ -76,7 +76,7 @@ main = mainWith $ do
|
||||
|
||||
-- | Perform a series of measurements with the same parser.
|
||||
bparser ::
|
||||
NFData a =>
|
||||
(NFData a) =>
|
||||
-- | Name of the benchmark group
|
||||
String ->
|
||||
-- | How to construct input
|
||||
@ -91,7 +91,7 @@ bparser name f p = forM_ stdSeries $ \i -> do
|
||||
|
||||
-- | Perform a series of measurements with the same parser.
|
||||
bparserBs ::
|
||||
NFData a =>
|
||||
(NFData a) =>
|
||||
-- | Name of the benchmark group
|
||||
String ->
|
||||
-- | How to construct input
|
||||
|
||||
@ -71,7 +71,7 @@ main =
|
||||
|
||||
-- | Perform a series to measurements with the same parser.
|
||||
bparser ::
|
||||
NFData a =>
|
||||
(NFData a) =>
|
||||
-- | Name of the benchmark group
|
||||
String ->
|
||||
-- | How to construct input
|
||||
@ -87,7 +87,7 @@ bparser name f p = bgroup name (bs <$> stdSeries)
|
||||
|
||||
-- | Perform a series to measurements with the same parser.
|
||||
bparserBs ::
|
||||
NFData a =>
|
||||
(NFData a) =>
|
||||
-- | Name of the benchmark group
|
||||
String ->
|
||||
-- | How to construct input
|
||||
|
||||
@ -121,7 +121,7 @@ prs_ p = parse (p <* eof) ""
|
||||
-- all supported monads transformers in turn).
|
||||
grs ::
|
||||
-- | Parser to run
|
||||
(forall m. MonadParsecDbg Void String m => m a) ->
|
||||
(forall m. (MonadParsecDbg Void String m) => m a) ->
|
||||
-- | Input for the parser
|
||||
String ->
|
||||
-- | How to check result of parsing
|
||||
@ -141,7 +141,7 @@ grs p s r = do
|
||||
-- | 'grs'' to 'grs' is as 'prs'' to 'prs'.
|
||||
grs' ::
|
||||
-- | Parser to run
|
||||
(forall m. MonadParsecDbg Void String m => m a) ->
|
||||
(forall m. (MonadParsecDbg Void String m) => m a) ->
|
||||
-- | Input for the parser
|
||||
String ->
|
||||
-- | How to check result of parsing
|
||||
@ -158,18 +158,18 @@ grs' p s r = do
|
||||
r (prs' (evalRWSTL p) s)
|
||||
r (prs' (evalRWSTS p) s)
|
||||
|
||||
evalWriterTL :: Monad m => L.WriterT [Int] m a -> m a
|
||||
evalWriterTL :: (Monad m) => L.WriterT [Int] m a -> m a
|
||||
evalWriterTL = fmap fst . L.runWriterT
|
||||
|
||||
evalWriterTS :: Monad m => S.WriterT [Int] m a -> m a
|
||||
evalWriterTS :: (Monad m) => S.WriterT [Int] m a -> m a
|
||||
evalWriterTS = fmap fst . S.runWriterT
|
||||
|
||||
evalRWSTL :: Monad m => L.RWST () [Int] () m a -> m a
|
||||
evalRWSTL :: (Monad m) => L.RWST () [Int] () m a -> m a
|
||||
evalRWSTL m = do
|
||||
(a, _, _) <- L.runRWST m () ()
|
||||
return a
|
||||
|
||||
evalRWSTS :: Monad m => S.RWST () [Int] () m a -> m a
|
||||
evalRWSTS :: (Monad m) => S.RWST () [Int] () m a -> m a
|
||||
evalRWSTS m = do
|
||||
(a, _, _) <- S.runRWST m () ()
|
||||
return a
|
||||
@ -201,11 +201,11 @@ rightOrder p s s' =
|
||||
prs_ p s `shouldParse` s'
|
||||
|
||||
-- | Get tab width from 'PosState'. Use with care only for testing.
|
||||
getTabWidth :: MonadParsec e s m => m Pos
|
||||
getTabWidth :: (MonadParsec e s m) => m Pos
|
||||
getTabWidth = pstateTabWidth . statePosState <$> getParserState
|
||||
|
||||
-- | Set tab width in 'PosState'. Use with care only for testing.
|
||||
setTabWidth :: MonadParsec e s m => Pos -> m ()
|
||||
setTabWidth :: (MonadParsec e s m) => Pos -> m ()
|
||||
setTabWidth w = updateParserState $ \st ->
|
||||
let pst = statePosState st
|
||||
in st {statePosState = pst {pstateTabWidth = w}}
|
||||
@ -277,7 +277,7 @@ instance Arbitrary SourcePos where
|
||||
<*> arbitrary
|
||||
<*> arbitrary
|
||||
|
||||
instance Arbitrary t => Arbitrary (ErrorItem t) where
|
||||
instance (Arbitrary t) => Arbitrary (ErrorItem t) where
|
||||
arbitrary =
|
||||
oneof
|
||||
[ Tokens <$> (NE.fromList . getNonEmpty <$> arbitrary),
|
||||
@ -307,7 +307,7 @@ instance
|
||||
<*> (E.fromList <$> scaleDown arbitrary)
|
||||
]
|
||||
|
||||
instance Arbitrary s => Arbitrary (State s e) where
|
||||
instance (Arbitrary s) => Arbitrary (State s e) where
|
||||
arbitrary = do
|
||||
input <- scaleDown arbitrary
|
||||
offset <- choose (1, 10000)
|
||||
@ -324,7 +324,7 @@ instance Arbitrary s => Arbitrary (State s e) where
|
||||
stateParseErrors = []
|
||||
}
|
||||
|
||||
instance Arbitrary s => Arbitrary (PosState s) where
|
||||
instance (Arbitrary s) => Arbitrary (PosState s) where
|
||||
arbitrary =
|
||||
PosState
|
||||
<$> arbitrary
|
||||
@ -345,5 +345,5 @@ instance Arbitrary B.ByteString where
|
||||
instance Arbitrary BL.ByteString where
|
||||
arbitrary = BL.pack <$> arbitrary
|
||||
|
||||
instance Arbitrary a => Arbitrary (NonEmpty a) where
|
||||
instance (Arbitrary a) => Arbitrary (NonEmpty a) where
|
||||
arbitrary = NE.fromList <$> (arbitrary `suchThat` (not . null))
|
||||
|
||||
@ -30,14 +30,14 @@ spec = do
|
||||
describe "dbg" $ do
|
||||
context "when inner parser succeeds consuming input" $ do
|
||||
it "has no effect on how parser works" $ do
|
||||
let p :: MonadParsecDbg Void String m => m Char
|
||||
let p :: (MonadParsecDbg Void String m) => m Char
|
||||
p = dbg "char" (char 'a')
|
||||
s = "ab"
|
||||
shouldStderr p s "char> IN: \"ab\"\nchar> MATCH (COK): 'a'\nchar> VALUE: 'a'\n\n"
|
||||
grs p s (`shouldParse` 'a')
|
||||
grs' p s (`succeedsLeaving` "b")
|
||||
it "its hints are preserved" $ do
|
||||
let p :: MonadParsecDbg Void String m => m String
|
||||
let p :: (MonadParsecDbg Void String m) => m String
|
||||
p = dbg "many chars" (many (char 'a')) <* empty
|
||||
s = "abcd"
|
||||
shouldStderr p s "many chars> IN: \"abcd\"\nmany chars> MATCH (COK): 'a'\nmany chars> VALUE: \"a\"\n\n"
|
||||
@ -45,7 +45,7 @@ spec = do
|
||||
grs' p s (`failsLeaving` "bcd")
|
||||
context "when inner parser fails consuming input" $
|
||||
it "has no effect on how parser works" $ do
|
||||
let p :: MonadParsecDbg Void String m => m Char
|
||||
let p :: (MonadParsecDbg Void String m) => m Char
|
||||
p = dbg "chars" (char 'a' *> char 'c')
|
||||
s = "abc"
|
||||
shouldStderr p s "chars> IN: \"abc\"\nchars> MATCH (CERR): 'a'\nchars> ERROR:\nchars> offset=1:\nchars> unexpected 'b'\nchars> expecting 'c'\n\n"
|
||||
@ -53,14 +53,14 @@ spec = do
|
||||
grs' p s (`failsLeaving` "bc")
|
||||
context "when inner parser succeeds without consuming" $ do
|
||||
it "has no effect on how parser works" $ do
|
||||
let p :: MonadParsecDbg Void String m => m Char
|
||||
let p :: (MonadParsecDbg Void String m) => m Char
|
||||
p = dbg "return" (return 'a')
|
||||
s = "abc"
|
||||
shouldStderr p s "return> IN: \"abc\"\nreturn> MATCH (EOK): <EMPTY>\nreturn> VALUE: 'a'\n\n"
|
||||
grs p s (`shouldParse` 'a')
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
it "its hints are preserved" $ do
|
||||
let p :: MonadParsecDbg Void String m => m String
|
||||
let p :: (MonadParsecDbg Void String m) => m String
|
||||
p = dbg "many chars" (many (char 'a')) <* empty
|
||||
s = "bcd"
|
||||
shouldStderr p s "many chars> IN: \"bcd\"\nmany chars> MATCH (EOK): <EMPTY>\nmany chars> VALUE: \"\"\n\n"
|
||||
@ -68,7 +68,7 @@ spec = do
|
||||
grs' p s (`failsLeaving` "bcd")
|
||||
context "when inner parser fails without consuming" $
|
||||
it "has no effect on how parser works" $ do
|
||||
let p :: MonadParsecDbg Void String m => m ()
|
||||
let p :: (MonadParsecDbg Void String m) => m ()
|
||||
p = dbg "empty" (void empty)
|
||||
s = "abc"
|
||||
shouldStderr p s "empty> IN: \"abc\"\nempty> MATCH (EERR): <EMPTY>\nempty> ERROR:\nempty> offset=0:\nempty> unknown parse error\n\n"
|
||||
|
||||
@ -266,7 +266,7 @@ instance ShowErrorComponent CustomErr where
|
||||
|
||||
type PE = ParseError String Void
|
||||
|
||||
contains :: Foldable t => (PE -> t a) -> (a -> String) -> PE -> Property
|
||||
contains :: (Foldable t) => (PE -> t a) -> (a -> String) -> PE -> Property
|
||||
contains g r e = property (all f (g e))
|
||||
where
|
||||
rendered = parseErrorPretty e
|
||||
|
||||
@ -422,7 +422,7 @@ spec = do
|
||||
describe "parseError" $ do
|
||||
it "immediately fails with given parse error" $
|
||||
property $ \st e -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = parseError e
|
||||
runParser' p st `shouldBe` (st, Left (mkBundle st (nes e)))
|
||||
|
||||
@ -432,7 +432,7 @@ spec = do
|
||||
it "collection of hints remains empty" $
|
||||
property $ \lbl a ->
|
||||
not (null lbl) ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = label lbl (char a) <* empty
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 1 mempty)
|
||||
@ -441,7 +441,7 @@ spec = do
|
||||
it "does not alter the hints" $
|
||||
property $ \lbl a ->
|
||||
not (null lbl) ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = label lbl (many (char a)) <* empty
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 1 (etok a))
|
||||
@ -450,7 +450,7 @@ spec = do
|
||||
it "reports parse error without modification" $
|
||||
property $ \lbl a b c ->
|
||||
not (null lbl) && b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = label lbl (char a *> char b)
|
||||
s = [a, c]
|
||||
grs p s (`shouldFailWith` err 1 (utok c <> etok b))
|
||||
@ -460,28 +460,28 @@ spec = do
|
||||
it "collection of hints remains empty" $
|
||||
property $ \lbl a ->
|
||||
not (null lbl) ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = label lbl (return a) <* empty
|
||||
grs p "" (`shouldFailWith` err 0 mempty)
|
||||
context "inner parser produces hints" $
|
||||
it "replaces the last hint with given label" $
|
||||
property $ \lbl a ->
|
||||
not (null lbl) ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = label lbl (many (char a)) <* empty
|
||||
grs p "" (`shouldFailWith` err 0 (elabel lbl))
|
||||
context "when inner parser fails without consuming" $ do
|
||||
it "is mentioned in parse error via its label" $
|
||||
property $ \lbl ->
|
||||
not (null lbl) ==> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = label lbl empty
|
||||
grs p "" (`shouldFailWith` err 0 (elabel lbl))
|
||||
context "when inner parser is composite with 2-hint sources" $
|
||||
it "both hint groups are replaced by the label" $
|
||||
property $ \lbl a b ->
|
||||
not (null lbl) && a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m (Maybe Char)
|
||||
let p :: (MonadParsec Void String m) => m (Maybe Char)
|
||||
p = label lbl (optional (char a) *> optional (char b)) <* empty
|
||||
grs p "" (`shouldFailWith` err 0 (elabel lbl))
|
||||
describe "hidden" $ do
|
||||
@ -489,7 +489,7 @@ spec = do
|
||||
context "inner parser does not produce any hints" $
|
||||
it "collection of hints remains empty" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = hidden (char a) <* empty
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 1 mempty)
|
||||
@ -497,7 +497,7 @@ spec = do
|
||||
context "inner parser produces hints" $
|
||||
it "hides the parser in the error message" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = hidden (many (char a)) <* empty
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 1 mempty)
|
||||
@ -506,7 +506,7 @@ spec = do
|
||||
it "reports parse error without modification" $
|
||||
property $ \a b c ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = hidden (char a *> char b)
|
||||
s = [a, c]
|
||||
grs p s (`shouldFailWith` err 1 (utok c <> etok b))
|
||||
@ -515,19 +515,19 @@ spec = do
|
||||
context "inner parser does not produce any hints" $
|
||||
it "collection of hints remains empty" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = hidden (return a) <* empty
|
||||
grs p "" (`shouldFailWith` err 0 mempty)
|
||||
context "inner parser produces hints" $
|
||||
it "hides the parser in the error message" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = hidden (many (char a)) <* empty
|
||||
grs p "" (`shouldFailWith` err 0 mempty)
|
||||
context "when inner parser fails without consuming" $
|
||||
it "hides the parser in the error message" $
|
||||
do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = hidden empty
|
||||
grs p "" (`shouldFailWith` err 0 mempty)
|
||||
|
||||
@ -535,7 +535,7 @@ spec = do
|
||||
context "when inner parser succeeds consuming" $
|
||||
it "try has no effect" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = try (char a)
|
||||
s = [a]
|
||||
grs p s (`shouldParse` a)
|
||||
@ -544,7 +544,7 @@ spec = do
|
||||
it "backtracks, it appears as if the parser has not consumed anything" $
|
||||
property $ \a b c ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = try (char a *> char b)
|
||||
s = [a, c]
|
||||
grs p s (`shouldFailWith` err 1 (utok c <> etok b))
|
||||
@ -552,7 +552,7 @@ spec = do
|
||||
it "hints from the inner parse error do not leak" $
|
||||
property $ \a b c ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Maybe Char)
|
||||
let p :: (MonadParsec Void String m) => m (Maybe Char)
|
||||
p = (optional . try) (char a *> char b) <* empty
|
||||
s = [a, c]
|
||||
grs p s (`shouldFailWith` err 0 mempty)
|
||||
@ -560,13 +560,13 @@ spec = do
|
||||
context "when inner parser succeeds without consuming" $
|
||||
it "try has no effect" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = try (return a)
|
||||
grs p "" (`shouldParse` a)
|
||||
context "when inner parser fails without consuming" $
|
||||
it "try backtracks parser state anyway" $
|
||||
property $ \w -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = try (setTabWidth w *> empty)
|
||||
grs p "" (`shouldFailWith` err 0 mempty)
|
||||
grs' p "" ((`shouldBe` defaultTabWidth) . grabTabWidth)
|
||||
@ -575,14 +575,14 @@ spec = do
|
||||
context "when inner parser succeeds consuming" $ do
|
||||
it "result is returned but parser state is not changed" $
|
||||
property $ \a w -> do
|
||||
let p :: MonadParsec Void String m => m Pos
|
||||
let p :: (MonadParsec Void String m) => m Pos
|
||||
p = lookAhead (setTabWidth w *> char a) *> getTabWidth
|
||||
s = [a]
|
||||
grs p s (`shouldParse` defaultTabWidth)
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
it "hints are not preserved" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = lookAhead (many (char a)) <* empty
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 0 mempty)
|
||||
@ -591,7 +591,7 @@ spec = do
|
||||
it "error message is reported as usual" $
|
||||
property $ \a b c ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = lookAhead (char a *> char b)
|
||||
s = [a, c]
|
||||
grs p s (`shouldFailWith` err 1 (utok c <> etok b))
|
||||
@ -599,7 +599,7 @@ spec = do
|
||||
context "when inner parser succeeds without consuming" $ do
|
||||
it "result is returned but parser state in not changed" $
|
||||
property $ \a w -> do
|
||||
let p :: MonadParsec Void String m => m Pos
|
||||
let p :: (MonadParsec Void String m) => m Pos
|
||||
p = lookAhead (setTabWidth w *> char a) *> getTabWidth
|
||||
s = [a]
|
||||
grs p s (`shouldParse` defaultTabWidth)
|
||||
@ -607,7 +607,7 @@ spec = do
|
||||
it "hints are not preserved" $
|
||||
property $ \a b ->
|
||||
a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = lookAhead (many (char a)) <* empty
|
||||
s = [b]
|
||||
grs p s (`shouldFailWith` err 0 mempty)
|
||||
@ -615,7 +615,7 @@ spec = do
|
||||
context "when inner parser fails without consuming" $
|
||||
it "error message is reported as usual" $
|
||||
do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = lookAhead empty
|
||||
grs p "" (`shouldFailWith` err 0 mempty)
|
||||
|
||||
@ -623,7 +623,7 @@ spec = do
|
||||
context "when inner parser succeeds consuming" $
|
||||
it "signals correct parse error" $
|
||||
property $ \a w -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = notFollowedBy (setTabWidth w <* char a)
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 0 (utok a))
|
||||
@ -633,7 +633,7 @@ spec = do
|
||||
it "succeeds without consuming" $
|
||||
property $ \a b c w ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = notFollowedBy (setTabWidth w *> char a *> char b)
|
||||
s = [a, c]
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
@ -641,7 +641,7 @@ spec = do
|
||||
it "hints are not preserved" $
|
||||
property $ \a b ->
|
||||
a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = notFollowedBy (char b *> many (char a) <* char a) <* empty
|
||||
s = [b, b]
|
||||
grs p s (`shouldFailWith` err 0 mempty)
|
||||
@ -649,7 +649,7 @@ spec = do
|
||||
context "when inner parser succeeds without consuming" $
|
||||
it "signals correct parse error" $
|
||||
property $ \a w -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = notFollowedBy (setTabWidth w *> return a)
|
||||
s = [a]
|
||||
grs p s (`shouldFailWith` err 0 (utok a))
|
||||
@ -658,13 +658,13 @@ spec = do
|
||||
context "when inner parser fails without consuming" $ do
|
||||
it "succeeds without consuming" $
|
||||
property $ \w -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = notFollowedBy (setTabWidth w *> empty)
|
||||
grs p "" (`shouldParse` ())
|
||||
grs' p "" ((`shouldBe` defaultTabWidth) . grabTabWidth)
|
||||
it "hints are not preserved" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = notFollowedBy (many (char a) <* char a) <* empty
|
||||
s = ""
|
||||
grs p s (`shouldFailWith` err 0 mempty)
|
||||
@ -674,7 +674,7 @@ spec = do
|
||||
context "when inner parser succeeds consuming" $
|
||||
it "the result is returned as usual" $
|
||||
property $ \a as -> do
|
||||
let p :: MonadParsec Void String m => m (Maybe Char)
|
||||
let p :: (MonadParsec Void String m) => m (Maybe Char)
|
||||
p = withRecovery (const $ return Nothing) (pure <$> char a)
|
||||
s = a : as
|
||||
grs p s (`shouldParse` Just a)
|
||||
@ -684,7 +684,7 @@ spec = do
|
||||
it "its result is returned and position is advanced" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p =
|
||||
withRecovery
|
||||
(\e -> Left e <$ string (c : as))
|
||||
@ -695,7 +695,7 @@ spec = do
|
||||
it "hints are not preserved" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p =
|
||||
withRecovery
|
||||
(\e -> Left e <$ string (c : as))
|
||||
@ -708,7 +708,7 @@ spec = do
|
||||
it "the original parse error (and state) is reported" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p =
|
||||
withRecovery
|
||||
(\e -> Left e <$ char c <* empty)
|
||||
@ -720,7 +720,7 @@ spec = do
|
||||
it "its result is returned (and state)" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = withRecovery (return . Left) (Right <$> char a <* char b)
|
||||
s = a : c : as
|
||||
grs p s (`shouldParse` Left (err 1 (utok c <> etok b)))
|
||||
@ -728,7 +728,7 @@ spec = do
|
||||
it "original hints are preserved" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p =
|
||||
withRecovery
|
||||
(return . Left)
|
||||
@ -741,7 +741,7 @@ spec = do
|
||||
it "the original parse error (and state) is reported" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p =
|
||||
withRecovery
|
||||
(\e -> Left e <$ empty)
|
||||
@ -752,7 +752,7 @@ spec = do
|
||||
context "when inner parser succeeds without consuming" $
|
||||
it "the result is returned as usual" $
|
||||
property $ \a s -> do
|
||||
let p :: MonadParsec Void String m => m (Maybe Char)
|
||||
let p :: (MonadParsec Void String m) => m (Maybe Char)
|
||||
p = withRecovery (const $ return Nothing) (return a)
|
||||
grs p s (`shouldParse` a)
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
@ -760,7 +760,7 @@ spec = do
|
||||
context "when recovering parser succeeds consuming input" $
|
||||
it "its result is returned and position is advanced" $
|
||||
property $ \a as -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = withRecovery (\e -> Left e <$ string s) empty
|
||||
s = a : as
|
||||
grs p s (`shouldParse` Left (err 0 mempty))
|
||||
@ -769,7 +769,7 @@ spec = do
|
||||
it "the original parse error (and state) is reported" $
|
||||
property $ \a b as ->
|
||||
a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p =
|
||||
withRecovery
|
||||
(\e -> Left e <$ char a <* char b <* empty)
|
||||
@ -780,14 +780,14 @@ spec = do
|
||||
context "when recovering parser succeeds without consuming" $ do
|
||||
it "its result is returned (and state)" $
|
||||
property $ \s -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = withRecovery (return . Left) empty
|
||||
grs p s (`shouldParse` Left (err 0 mempty))
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
it "original hints are preserved" $
|
||||
property $ \a b as ->
|
||||
a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) String)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) String)
|
||||
p =
|
||||
withRecovery
|
||||
(return . Left)
|
||||
@ -799,13 +799,13 @@ spec = do
|
||||
context "when recovering parser fails without consuming" $
|
||||
it "the original parse error (and state) is reported" $
|
||||
property $ \s -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = withRecovery (\e -> Left e <$ empty) empty
|
||||
grs p s (`shouldFailWith` err 0 mempty)
|
||||
grs' p s (`failsLeaving` s)
|
||||
it "works in complex situations too" $
|
||||
property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) String)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) String)
|
||||
p =
|
||||
let g = count' 1 3 . char
|
||||
in v
|
||||
@ -836,7 +836,7 @@ spec = do
|
||||
context "when inner parser succeeds consuming" $
|
||||
it "returns its result in Right" $
|
||||
property $ \a as -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = observing (char a)
|
||||
s = a : as
|
||||
grs p s (`shouldParse` Right a)
|
||||
@ -845,7 +845,7 @@ spec = do
|
||||
it "returns its parse error in Left preserving state" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = observing (char a *> char b)
|
||||
s = a : c : as
|
||||
grs p s (`shouldParse` Left (err 1 (utok c <> etok b)))
|
||||
@ -853,7 +853,7 @@ spec = do
|
||||
it "does not create any hints" $
|
||||
property $ \a b c as ->
|
||||
b /= c ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = observing (char a *> char b) *> empty
|
||||
s = a : c : as
|
||||
grs p s (`shouldFailWith` err 1 mempty)
|
||||
@ -861,21 +861,21 @@ spec = do
|
||||
context "when inner parser succeeds without consuming" $
|
||||
it "returns its result in Right" $
|
||||
property $ \a s -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = observing (return a)
|
||||
grs p s (`shouldParse` Right a)
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
context "when inner parser fails without consuming" $ do
|
||||
it "returns its parse error in Left preserving state" $
|
||||
property $ \s -> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) ())
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) ())
|
||||
p = observing empty
|
||||
grs p s (`shouldParse` Left (err 0 mempty))
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
it "creates correct hints" $
|
||||
property $ \a b as ->
|
||||
a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m (Either (ParseError String Void) Char)
|
||||
let p :: (MonadParsec Void String m) => m (Either (ParseError String Void) Char)
|
||||
p = observing (char a) <* empty
|
||||
s = b : as
|
||||
grs p s (`shouldFailWith` err 0 (etok a))
|
||||
@ -898,7 +898,7 @@ spec = do
|
||||
context "when supplied predicate is satisfied" $
|
||||
it "succeeds" $
|
||||
property $ \a as -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = token (testChar a) (expected a)
|
||||
s = a : as
|
||||
grs p s (`shouldParse` a)
|
||||
@ -907,7 +907,7 @@ spec = do
|
||||
it "signals correct parse error" $
|
||||
property $ \a b as ->
|
||||
a /= b ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = token (testChar b) (expected b)
|
||||
s = a : as
|
||||
us = pure (Tokens $ nes a)
|
||||
@ -917,7 +917,7 @@ spec = do
|
||||
context "when stream is empty" $
|
||||
it "signals correct parse error" $
|
||||
property $ \a -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = token (testChar a) ps
|
||||
us = pure EndOfInput
|
||||
ps = expected a
|
||||
@ -927,7 +927,7 @@ spec = do
|
||||
context "when stream is prefixed with given string" $
|
||||
it "parses the string" $
|
||||
property $ \str s -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = tokens (==) str
|
||||
s' = str ++ s
|
||||
grs p s' (`shouldParse` str)
|
||||
@ -936,7 +936,7 @@ spec = do
|
||||
it "signals correct parse error" $
|
||||
property $ \str s ->
|
||||
not (str `isPrefixOf` s) ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = tokens (==) str
|
||||
z = take (length str) s
|
||||
grs p s (`shouldFailWith` err 0 (utoks z <> etoks str))
|
||||
@ -944,7 +944,7 @@ spec = do
|
||||
context "when matching the empty string" $
|
||||
it "eok continuation is used" $
|
||||
property $ \str s -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = (tokens (==) "" <* empty) <|> pure str
|
||||
grs p s (`shouldParse` str)
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
@ -954,19 +954,19 @@ spec = do
|
||||
it "consumes all matching tokens, zero or more" $
|
||||
property $ \s ->
|
||||
not (null s) ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhileP Nothing isLetter
|
||||
(z, zs) = DL.span isLetter s
|
||||
grs p s (`shouldParse` z)
|
||||
grs' p s (`succeedsLeaving` zs)
|
||||
context "when stream is empty" $
|
||||
it "succeeds returning empty chunk" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhileP Nothing isLetter
|
||||
grs p "" (`shouldParse` "")
|
||||
grs' p "" (`succeedsLeaving` "")
|
||||
context "with two takeWhileP in a row (testing hints)" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = do
|
||||
void $ takeWhileP (Just "foo") (== 'a')
|
||||
void $ takeWhileP (Just "bar") (== 'b')
|
||||
@ -985,7 +985,7 @@ spec = do
|
||||
grs' p s (`failsLeaving` "")
|
||||
context "without label (testing hints)" $
|
||||
it "there are no hints" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhileP Nothing (== 'a') <* empty
|
||||
s = "aaa"
|
||||
grs p s (`shouldFailWith` err 3 mempty)
|
||||
@ -995,7 +995,7 @@ spec = do
|
||||
context "when stream is prefixed with matching tokens" $
|
||||
it "consumes the tokens" $
|
||||
property $ \s' -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhile1P Nothing isLetter
|
||||
s = 'a' : s'
|
||||
(z, zs) = DL.span isLetter s
|
||||
@ -1004,7 +1004,7 @@ spec = do
|
||||
context "when stream is not prefixed with at least one matching token" $
|
||||
it "signals correct parse error" $
|
||||
property $ \s' -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhile1P (Just "foo") isLetter
|
||||
s = '3' : s'
|
||||
pe = err 0 (utok '3' <> elabel "foo")
|
||||
@ -1013,20 +1013,20 @@ spec = do
|
||||
context "when stream is empty" $ do
|
||||
context "with label" $
|
||||
it "signals correct parse error" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhile1P (Just "foo") isLetter
|
||||
pe = err 0 (ueof <> elabel "foo")
|
||||
grs p "" (`shouldFailWith` pe)
|
||||
grs' p "" (`failsLeaving` "")
|
||||
context "without label" $
|
||||
it "signals correct parse error" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhile1P Nothing isLetter
|
||||
pe = err 0 ueof
|
||||
grs p "" (`shouldFailWith` pe)
|
||||
grs' p "" (`failsLeaving` "")
|
||||
context "with two takeWhile1P in a row (testing hints)" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = do
|
||||
void $ takeWhile1P (Just "foo") (== 'a')
|
||||
void $ takeWhile1P (Just "bar") (== 'b')
|
||||
@ -1045,7 +1045,7 @@ spec = do
|
||||
grs' p s (`failsLeaving` "")
|
||||
context "without label (testing hints)" $
|
||||
it "there are no hints" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeWhile1P Nothing (== 'a') <* empty
|
||||
s = "aaa"
|
||||
grs p s (`shouldFailWith` err 3 mempty)
|
||||
@ -1055,14 +1055,14 @@ spec = do
|
||||
context "when taking 0 tokens" $ do
|
||||
context "when stream is empty" $
|
||||
it "succeeds returning zero-length chunk" $ do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP Nothing 0
|
||||
grs p "" (`shouldParse` "")
|
||||
context "when stream is not empty" $
|
||||
it "succeeds returning zero-length chunk" $
|
||||
property $ \s ->
|
||||
not (null s) ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP Nothing 0
|
||||
grs p s (`shouldParse` "")
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
@ -1070,14 +1070,14 @@ spec = do
|
||||
context "when stream is empty" $
|
||||
it "succeeds returning zero-length chunk" $
|
||||
property $ \(Negative n) -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP Nothing n
|
||||
grs p "" (`shouldParse` "")
|
||||
context "when stream is not empty" $
|
||||
it "succeeds returning zero-length chunk" $
|
||||
property $ \(Negative n) s ->
|
||||
not (null s) ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP Nothing n
|
||||
grs p s (`shouldParse` "")
|
||||
grs' p s (`succeedsLeaving` s)
|
||||
@ -1086,7 +1086,7 @@ spec = do
|
||||
context "with label" $
|
||||
it "signals correct parse error" $
|
||||
property $ \(Positive n) -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP (Just "foo") n
|
||||
pe = err 0 (ueof <> elabel "foo")
|
||||
grs p "" (`shouldFailWith` pe)
|
||||
@ -1094,14 +1094,14 @@ spec = do
|
||||
context "without label" $
|
||||
it "signals correct parse error" $
|
||||
property $ \(Positive n) -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP Nothing n
|
||||
pe = err 0 ueof
|
||||
grs p "" (`shouldFailWith` pe)
|
||||
context "when stream has not enough tokens" $
|
||||
it "signals correct parse error" $
|
||||
property $ \(Positive n) s -> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP (Just "foo") n
|
||||
m = length s
|
||||
pe = err m (ueof <> elabel "foo")
|
||||
@ -1112,7 +1112,7 @@ spec = do
|
||||
it "succeeds returning the extracted tokens" $
|
||||
property $ \(Positive n) s ->
|
||||
length s >= n ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP (Just "foo") n
|
||||
(s0, s1) = splitAt n s
|
||||
grs p s (`shouldParse` s0)
|
||||
@ -1121,7 +1121,7 @@ spec = do
|
||||
it "there are no hints to influence the parse error" $
|
||||
property $ \(Positive n) s ->
|
||||
length s >= n ==> do
|
||||
let p :: MonadParsec Void String m => m String
|
||||
let p :: (MonadParsec Void String m) => m String
|
||||
p = takeP (Just "foo") n <* empty
|
||||
pe = err n mempty
|
||||
grs p s (`shouldFailWith` pe)
|
||||
@ -1131,28 +1131,28 @@ spec = do
|
||||
describe "failure" $
|
||||
it "signals correct parse error" $
|
||||
property $ \us ps -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = void (failure us ps)
|
||||
grs p "" (`shouldFailWith` TrivialError 0 us ps)
|
||||
|
||||
describe "fancyFailure" $
|
||||
it "singals correct parse error" $
|
||||
property $ \xs -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = void (fancyFailure xs)
|
||||
grs p "" (`shouldFailWith` FancyError 0 xs)
|
||||
|
||||
describe "unexpected" $
|
||||
it "signals correct parse error" $
|
||||
property $ \item -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = void (unexpected item)
|
||||
grs p "" (`shouldFailWith` TrivialError 0 (pure item) E.empty)
|
||||
|
||||
describe "customFailure" $
|
||||
it "signals correct parse error" $
|
||||
property $ \n st -> do
|
||||
let p :: MonadParsec Int String m => m ()
|
||||
let p :: (MonadParsec Int String m) => m ()
|
||||
p = void (customFailure n)
|
||||
xs = E.singleton (ErrorCustom n)
|
||||
runParser p "" (stateInput st) `shouldFailWith` FancyError 0 xs
|
||||
@ -1209,7 +1209,7 @@ spec = do
|
||||
describe "registerParseError" $ do
|
||||
it "immediately fails with given parse error" $
|
||||
property $ \st es -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = forM_ (NE.reverse es) registerParseError
|
||||
st' =
|
||||
st
|
||||
@ -1223,14 +1223,14 @@ spec = do
|
||||
describe "registerFailure" $
|
||||
it "signals correct parse error" $
|
||||
property $ \us ps -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = void (registerFailure us ps)
|
||||
grs p "" (`shouldFailWith` TrivialError 0 us ps)
|
||||
|
||||
describe "reisterFancyFailure" $
|
||||
it "singals correct parse error" $
|
||||
property $ \xs -> do
|
||||
let p :: MonadParsec Void String m => m ()
|
||||
let p :: (MonadParsec Void String m) => m ()
|
||||
p = void (registerFancyFailure xs)
|
||||
grs p "" (`shouldFailWith` FancyError 0 xs)
|
||||
|
||||
@ -1239,7 +1239,7 @@ spec = do
|
||||
-- "Text.Megaparsec.Byte".
|
||||
|
||||
describe "anySingle" $ do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = anySingle
|
||||
context "when stream is not empty" $
|
||||
it "succeeds consuming next character in the stream" $
|
||||
@ -1255,7 +1255,7 @@ spec = do
|
||||
context "when stream begins with the character specified as argument" $
|
||||
it "signals correct parse error" $
|
||||
property $ \ch s' -> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = anySingleBut ch
|
||||
s = ch : s'
|
||||
grs p s (`shouldFailWith` err 0 (utok ch))
|
||||
@ -1264,7 +1264,7 @@ spec = do
|
||||
it "parses first character in the stream" $
|
||||
property $ \ch s ->
|
||||
not (null s) && ch /= head s ==> do
|
||||
let p :: MonadParsec Void String m => m Char
|
||||
let p :: (MonadParsec Void String m) => m Char
|
||||
p = anySingleBut ch
|
||||
grs p s (`shouldParse` head s)
|
||||
grs' p s (`succeedsLeaving` tail s)
|
||||
@ -1388,7 +1388,7 @@ spec = do
|
||||
describe "setParserState and getParserState" $
|
||||
it "sets parser state and gets it back" $
|
||||
property $ \s1 s2 -> do
|
||||
let p :: MonadParsec Void String m => m (State String Void)
|
||||
let p :: (MonadParsec Void String m) => m (State String Void)
|
||||
p = do
|
||||
st <- getParserState
|
||||
guard (st == initialState s)
|
||||
|
||||
@ -28,7 +28,7 @@ main = mainWith $ do
|
||||
forM_ jsonFiles $ \file ->
|
||||
bparser "JSON (Megaparsec)" file M.parseJson
|
||||
|
||||
bparser :: NFData a => String -> FilePath -> (ByteString -> a) -> Weigh ()
|
||||
bparser :: (NFData a) => String -> FilePath -> (ByteString -> a) -> Weigh ()
|
||||
bparser pre desc f = io (pre ++ "-" ++ desc) m path
|
||||
where
|
||||
path = "data/" ++ desc
|
||||
|
||||
@ -34,7 +34,7 @@ main =
|
||||
[bparser file M.parseJson | file <- jsonFiles]
|
||||
]
|
||||
|
||||
bparser :: NFData a => FilePath -> (ByteString -> a) -> Benchmark
|
||||
bparser :: (NFData a) => FilePath -> (ByteString -> a) -> Benchmark
|
||||
bparser desc f = env (B.readFile path) (bench desc . nf f)
|
||||
where
|
||||
path = "data/" ++ desc
|
||||
|
||||
Loading…
Reference in New Issue
Block a user