mirror of
https://github.com/mrkkrp/megaparsec.git
synced 2024-12-28 18:54:34 +03:00
mrkkrp
parent
b6048d3ec3
commit
3edbe9f54a
@ -67,6 +67,7 @@ module Text.Megaparsec
|
||||
, try
|
||||
, lookAhead
|
||||
, notFollowedBy
|
||||
, withRecovery
|
||||
, eof
|
||||
, token
|
||||
, tokens
|
||||
|
||||
@ -388,9 +388,9 @@ pZero = ParsecT $ \s@(State _ pos _) _ _ _ eerr ->
|
||||
pPlus :: ParsecT s m a -> ParsecT s m a -> ParsecT s m a
|
||||
pPlus m n = ParsecT $ \s cok cerr eok eerr ->
|
||||
let meerr err ms =
|
||||
let ncerr err' s' = cerr (mergeError err' err) (longestMatch ms s')
|
||||
let ncerr err' s' = cerr (err' <> err) (longestMatch ms s')
|
||||
neok x s' hs = eok x s' (toHints err <> hs)
|
||||
neerr err' s' = eerr (mergeError err' err) (longestMatch ms s')
|
||||
neerr err' s' = eerr (err' <> err) (longestMatch ms s')
|
||||
in unParser n s cok ncerr neok neerr
|
||||
in unParser m s cok cerr eok meerr
|
||||
{-# INLINE pPlus #-}
|
||||
@ -474,6 +474,21 @@ class (A.Alternative m, Monad m, Stream s t)
|
||||
|
||||
notFollowedBy :: m a -> m ()
|
||||
|
||||
-- | @withRecovery r p@ allows continue parsing even if parser @p@
|
||||
-- fails. In this case @r@ is called with actual 'ParseError' as its
|
||||
-- argument. Typical usage is to return value signifying failure to parse
|
||||
-- this particular object and to consume some part of input up to start of
|
||||
-- next object.
|
||||
--
|
||||
-- Note that if @r@ fails, original error message is reported as if
|
||||
-- without 'withRecovery'. In no way recovering parser @r@ can influence
|
||||
-- error messages.
|
||||
|
||||
withRecovery
|
||||
:: (ParseError -> m a) -- ^ How to recover from failure
|
||||
-> m a -- ^ Original parser
|
||||
-> m a -- ^ Parser that can recover from failures
|
||||
|
||||
-- | This parser only succeeds at the end of the input.
|
||||
|
||||
eof :: m ()
|
||||
@ -533,6 +548,7 @@ instance Stream s t => MonadParsec s (ParsecT s m) t where
|
||||
try = pTry
|
||||
lookAhead = pLookAhead
|
||||
notFollowedBy = pNotFollowedBy
|
||||
withRecovery = pWithRecovery
|
||||
eof = pEof
|
||||
token = pToken
|
||||
tokens = pTokens
|
||||
@ -570,6 +586,24 @@ pNotFollowedBy p = ParsecT $ \s@(State input pos _) _ _ eok eerr ->
|
||||
eerr' _ _ = eok () s mempty
|
||||
in unParser p s cok' cerr' eok' eerr'
|
||||
|
||||
pWithRecovery :: Stream s t
|
||||
=> (ParseError -> ParsecT s m a)
|
||||
-> ParsecT s m a
|
||||
-> ParsecT s m a
|
||||
pWithRecovery r p = ParsecT $ \s cok cerr eok eerr ->
|
||||
let mcerr err ms =
|
||||
let rcerr _ _ = cerr err ms
|
||||
reok x s' _ = eok x s' (toHints err)
|
||||
reerr _ _ = cerr err ms
|
||||
in unParser (r err) ms cok rcerr reok reerr
|
||||
meerr err ms =
|
||||
let rcerr _ _ = eerr err ms
|
||||
reok x s' _ = eok x s' (toHints err)
|
||||
reerr _ _ = eerr err ms
|
||||
in unParser (r err) ms cok rcerr reok reerr
|
||||
in unParser p s cok mcerr eok meerr
|
||||
{-# INLINE pWithRecovery #-}
|
||||
|
||||
pEof :: Stream s t => ParsecT s m ()
|
||||
pEof = label eoi $ ParsecT $ \s@(State input pos _) _ _ eok eerr ->
|
||||
case uncons input of
|
||||
@ -830,13 +864,15 @@ parseFromFile p filename = runParser p filename <$> fromFile filename
|
||||
|
||||
instance (MonadPlus m, MonadParsec s m t) =>
|
||||
MonadParsec s (L.StateT e m) t where
|
||||
failure = lift . failure
|
||||
label n (L.StateT m) = L.StateT $ label n . m
|
||||
try (L.StateT m) = L.StateT $ try . m
|
||||
lookAhead (L.StateT m) = L.StateT $ \s ->
|
||||
(,s) . fst <$> lookAhead (m s)
|
||||
notFollowedBy (L.StateT m) = L.StateT $ \s ->
|
||||
notFollowedBy (fst <$> m s) >> return ((),s)
|
||||
failure = lift . failure
|
||||
withRecovery r (L.StateT m) = L.StateT $ \s ->
|
||||
withRecovery (\e -> L.runStateT (r e) s) (m s)
|
||||
eof = lift eof
|
||||
token f e = lift $ token f e
|
||||
tokens f e ts = lift $ tokens f e ts
|
||||
@ -845,13 +881,15 @@ instance (MonadPlus m, MonadParsec s m t) =>
|
||||
|
||||
instance (MonadPlus m, MonadParsec s m t)
|
||||
=> MonadParsec s (S.StateT e m) t where
|
||||
failure = lift . failure
|
||||
label n (S.StateT m) = S.StateT $ label n . m
|
||||
try (S.StateT m) = S.StateT $ try . m
|
||||
lookAhead (S.StateT m) = S.StateT $ \s ->
|
||||
(,s) . fst <$> lookAhead (m s)
|
||||
notFollowedBy (S.StateT m) = S.StateT $ \s ->
|
||||
notFollowedBy (fst <$> m s) >> return ((),s)
|
||||
failure = lift . failure
|
||||
withRecovery r (S.StateT m) = S.StateT $ \s ->
|
||||
withRecovery (\e -> S.runStateT (r e) s) (m s)
|
||||
eof = lift eof
|
||||
token f e = lift $ token f e
|
||||
tokens f e ts = lift $ tokens f e ts
|
||||
@ -860,11 +898,13 @@ instance (MonadPlus m, MonadParsec s m t)
|
||||
|
||||
instance (MonadPlus m, MonadParsec s m t)
|
||||
=> MonadParsec s (L.ReaderT e m) t where
|
||||
failure = lift . failure
|
||||
label n (L.ReaderT m) = L.ReaderT $ label n . m
|
||||
try (L.ReaderT m) = L.ReaderT $ try . m
|
||||
lookAhead (L.ReaderT m) = L.ReaderT $ lookAhead . m
|
||||
notFollowedBy (L.ReaderT m) = L.ReaderT $ notFollowedBy . m
|
||||
failure = lift . failure
|
||||
withRecovery r (L.ReaderT m) = L.ReaderT $ \s ->
|
||||
withRecovery (\e -> L.runReaderT (r e) s) (m s)
|
||||
eof = lift eof
|
||||
token f e = lift $ token f e
|
||||
tokens f e ts = lift $ tokens f e ts
|
||||
@ -873,13 +913,15 @@ instance (MonadPlus m, MonadParsec s m t)
|
||||
|
||||
instance (MonadPlus m, Monoid w, MonadParsec s m t)
|
||||
=> MonadParsec s (L.WriterT w m) t where
|
||||
failure = lift . failure
|
||||
label n (L.WriterT m) = L.WriterT $ label n m
|
||||
try (L.WriterT m) = L.WriterT $ try m
|
||||
lookAhead (L.WriterT m) = L.WriterT $
|
||||
(,mempty) . fst <$> lookAhead m
|
||||
notFollowedBy (L.WriterT m) = L.WriterT $
|
||||
(,mempty) <$> notFollowedBy (fst <$> m)
|
||||
failure = lift . failure
|
||||
withRecovery r (L.WriterT m) = L.WriterT $
|
||||
withRecovery (L.runWriterT . r) m
|
||||
eof = lift eof
|
||||
token f e = lift $ token f e
|
||||
tokens f e ts = lift $ tokens f e ts
|
||||
@ -888,13 +930,15 @@ instance (MonadPlus m, Monoid w, MonadParsec s m t)
|
||||
|
||||
instance (MonadPlus m, Monoid w, MonadParsec s m t)
|
||||
=> MonadParsec s (S.WriterT w m) t where
|
||||
failure = lift . failure
|
||||
label n (S.WriterT m) = S.WriterT $ label n m
|
||||
try (S.WriterT m) = S.WriterT $ try m
|
||||
lookAhead (S.WriterT m) = S.WriterT $
|
||||
(,mempty) . fst <$> lookAhead m
|
||||
notFollowedBy (S.WriterT m) = S.WriterT $
|
||||
(,mempty) <$> notFollowedBy (fst <$> m)
|
||||
failure = lift . failure
|
||||
withRecovery r (S.WriterT m) = S.WriterT $
|
||||
withRecovery (S.runWriterT . r) m
|
||||
eof = lift eof
|
||||
token f e = lift $ token f e
|
||||
tokens f e ts = lift $ tokens f e ts
|
||||
@ -903,11 +947,13 @@ instance (MonadPlus m, Monoid w, MonadParsec s m t)
|
||||
|
||||
instance (Monad m, MonadParsec s m t)
|
||||
=> MonadParsec s (IdentityT m) t where
|
||||
failure = lift . failure
|
||||
label n (IdentityT m) = IdentityT $ label n m
|
||||
try = IdentityT . try . runIdentityT
|
||||
lookAhead (IdentityT m) = IdentityT $ lookAhead m
|
||||
notFollowedBy (IdentityT m) = IdentityT $ notFollowedBy m
|
||||
failure = lift . failure
|
||||
withRecovery r (IdentityT m) = IdentityT $
|
||||
withRecovery (runIdentityT . r) m
|
||||
eof = lift eof
|
||||
token f e = lift $ token f e
|
||||
tokens f e ts = lift $ tokens f e ts
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
resolver: lts-4.0
|
||||
resolver: nightly-2016-02-08
|
||||
packages:
|
||||
- '.'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user