{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
#define USE_DEFAULT_SIGNATURES
#endif
#ifdef USE_DEFAULT_SIGNATURES
{-# LANGUAGE DefaultSignatures, TypeFamilies, TypeOperators #-}
#endif
#if !MIN_VERSION_base(4,6,0)
#define ORPHAN_ALTERNATIVE_READP
#endif
#ifdef ORPHAN_ALTERNATIVE_READP
{-# OPTIONS_GHC -fno-warn-orphans #-}
#endif
module Text.Parser.Combinators
(
choice
, option
, optional
, skipOptional
, between
, surroundedBy
, some
, many
, sepBy
, sepBy1
, sepByNonEmpty
, sepEndBy1
, sepEndByNonEmpty
, sepEndBy
, endBy1
, endByNonEmpty
, endBy
, count
, chainl
, chainr
, chainl1
, chainr1
, manyTill
, Parsing(..)
) where
import Control.Applicative
import Control.Monad (MonadPlus(..), void)
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Identity
import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#ifdef ORPHAN_ALTERNATIVE_READP
import Data.Orphans ()
#endif
import Data.Traversable (sequenceA)
#endif
#ifdef MIN_VERSION_parsec
import qualified Text.Parsec as Parsec
#endif
#ifdef MIN_VERSION_attoparsec
import qualified Data.Attoparsec.Types as Att
import qualified Data.Attoparsec.Combinator as Att
#endif
import qualified Text.ParserCombinators.ReadP as ReadP
#ifdef MIN_VERSION_binary
import Control.Monad (when, unless)
import qualified Data.Binary.Get as B
#endif
#if MIN_VERSION_base(4,9,0)
import Control.Monad (replicateM)
#endif
choice :: Alternative m => [m a] -> m a
choice :: [m a] -> m a
choice = [m a] -> m a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum
{-# INLINE choice #-}
option :: Alternative m => a -> m a -> m a
option :: a -> m a -> m a
option a
x m a
p = m a
p m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE option #-}
skipOptional :: Alternative m => m a -> m ()
skipOptional :: m a -> m ()
skipOptional m a
p = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
p m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE skipOptional #-}
between :: Applicative m => m bra -> m ket -> m a -> m a
between :: m bra -> m ket -> m a -> m a
between m bra
bra m ket
ket m a
p = m bra
bra m bra -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
p m a -> m ket -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ket
ket
{-# INLINE between #-}
surroundedBy :: Applicative m => m a -> m sur -> m a
surroundedBy :: m a -> m sur -> m a
surroundedBy m a
p m sur
bound = m sur -> m sur -> m a -> m a
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between m sur
bound m sur
bound m a
p
{-# INLINE surroundedBy #-}
sepBy :: Alternative m => m a -> m sep -> m [a]
sepBy :: m a -> m sep -> m [a]
sepBy m a
p m sep
sep = m a -> m sep -> m [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 m a
p m sep
sep m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# INLINE sepBy #-}
sepBy1 :: Alternative m => m a -> m sep -> m [a]
sepBy1 :: m a -> m sep -> m [a]
sepBy1 m a
p m sep
sep = NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty a -> [a]) -> m (NonEmpty a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m sep -> m (NonEmpty a)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty m a
p m sep
sep
{-# INLINE sepBy1 #-}
sepByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)
sepByNonEmpty :: m a -> m sep -> m (NonEmpty a)
sepByNonEmpty m a
p m sep
sep = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(:|) (a -> [a] -> NonEmpty a) -> m a -> m ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m ([a] -> NonEmpty a) -> m [a] -> m (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m sep
sep m sep -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
p)
{-# INLINE sepByNonEmpty #-}
sepEndBy1 :: Alternative m => m a -> m sep -> m [a]
sepEndBy1 :: m a -> m sep -> m [a]
sepEndBy1 m a
p m sep
sep = NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty a -> [a]) -> m (NonEmpty a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m sep -> m (NonEmpty a)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndByNonEmpty m a
p m sep
sep
sepEndByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)
sepEndByNonEmpty :: m a -> m sep -> m (NonEmpty a)
sepEndByNonEmpty m a
p m sep
sep = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(:|) (a -> [a] -> NonEmpty a) -> m a -> m ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m ([a] -> NonEmpty a) -> m [a] -> m (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((m sep
sep m sep -> m [a] -> m [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m sep -> m [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepEndBy m a
p m sep
sep) m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
sepEndBy :: Alternative m => m a -> m sep -> m [a]
sepEndBy :: m a -> m sep -> m [a]
sepEndBy m a
p m sep
sep = m a -> m sep -> m [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepEndBy1 m a
p m sep
sep m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# INLINE sepEndBy #-}
endBy1 :: Alternative m => m a -> m sep -> m [a]
endBy1 :: m a -> m sep -> m [a]
endBy1 m a
p m sep
sep = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (m a
p m a -> m sep -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m sep
sep)
{-# INLINE endBy1 #-}
endByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)
endByNonEmpty :: m a -> m sep -> m (NonEmpty a)
endByNonEmpty m a
p m sep
sep = m a -> m (NonEmpty a)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NonEmpty.some1 (m a
p m a -> m sep -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m sep
sep)
{-# INLINE endByNonEmpty #-}
endBy :: Alternative m => m a -> m sep -> m [a]
endBy :: m a -> m sep -> m [a]
endBy m a
p m sep
sep = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m a
p m a -> m sep -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m sep
sep)
{-# INLINE endBy #-}
count :: Applicative m => Int -> m a -> m [a]
#if MIN_VERSION_base(4,9,0)
count :: Int -> m a -> m [a]
count = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
#else
count n p | n <= 0 = pure []
| otherwise = sequenceA (replicate n p)
#endif
{-# INLINE count #-}
chainr :: Alternative m => m a -> m (a -> a -> a) -> a -> m a
chainr :: m a -> m (a -> a -> a) -> a -> m a
chainr m a
p m (a -> a -> a)
op a
x = m a -> m (a -> a -> a) -> m a
forall (m :: * -> *) a.
Alternative m =>
m a -> m (a -> a -> a) -> m a
chainr1 m a
p m (a -> a -> a)
op m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE chainr #-}
chainl :: Alternative m => m a -> m (a -> a -> a) -> a -> m a
chainl :: m a -> m (a -> a -> a) -> a -> m a
chainl m a
p m (a -> a -> a)
op a
x = m a -> m (a -> a -> a) -> m a
forall (m :: * -> *) a.
Alternative m =>
m a -> m (a -> a -> a) -> m a
chainl1 m a
p m (a -> a -> a)
op m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE chainl #-}
chainl1 :: Alternative m => m a -> m (a -> a -> a) -> m a
chainl1 :: m a -> m (a -> a -> a) -> m a
chainl1 m a
p m (a -> a -> a)
op = m a
scan where
scan :: m a
scan = m a
p m a -> m (a -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> m (a -> a)
rst
rst :: m (a -> a)
rst = (\a -> a -> a
f a
y a -> a
g a
x -> a -> a
g (a -> a -> a
f a
x a
y)) ((a -> a -> a) -> a -> (a -> a) -> a -> a)
-> m (a -> a -> a) -> m (a -> (a -> a) -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> a -> a)
op m (a -> (a -> a) -> a -> a) -> m a -> m ((a -> a) -> a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
p m ((a -> a) -> a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (a -> a)
rst m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id
{-# INLINE chainl1 #-}
chainr1 :: Alternative m => m a -> m (a -> a -> a) -> m a
chainr1 :: m a -> m (a -> a -> a) -> m a
chainr1 m a
p m (a -> a -> a)
op = m a
scan where
scan :: m a
scan = m a
p m a -> m (a -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> m (a -> a)
rst
rst :: m (a -> a)
rst = ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> a -> a)
-> m (a -> a -> a) -> m (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> a -> a)
op m (a -> a -> a) -> m a -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
scan) m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id
{-# INLINE chainr1 #-}
manyTill :: Alternative m => m a -> m end -> m [a]
manyTill :: m a -> m end -> m [a]
manyTill m a
p m end
end = m [a]
go where go :: m [a]
go = ([] [a] -> m end -> m [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m end
end) m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [a]
go)
{-# INLINE manyTill #-}
infixr 0 <?>
class Alternative m => Parsing m where
try :: m a -> m a
(<?>) :: m a -> String -> m a
skipMany :: m a -> m ()
skipMany m a
p = m [a] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m a
p)
{-# INLINE skipMany #-}
skipSome :: m a -> m ()
skipSome m a
p = m a
p m a -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany m a
p
{-# INLINE skipSome #-}
unexpected :: String -> m a
#ifdef USE_DEFAULT_SIGNATURES
default unexpected :: (MonadTrans t, Monad n, Parsing n, m ~ t n) =>
String -> m a
unexpected = n a -> t n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n a -> t n a) -> (String -> n a) -> String -> t n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> n a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
#endif
eof :: m ()
#ifdef USE_DEFAULT_SIGNATURES
default eof :: (MonadTrans t, Monad n, Parsing n, m ~ t n) => m ()
eof = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
#endif
notFollowedBy :: Show a => m a -> m ()
instance (Parsing m, MonadPlus m) => Parsing (Lazy.StateT s m) where
try :: StateT s m a -> StateT s m a
try (Lazy.StateT s -> m (a, s)
m) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ m (a, s) -> m (a, s)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
m
{-# INLINE try #-}
Lazy.StateT s -> m (a, s)
m <?> :: StateT s m a -> String -> StateT s m a
<?> String
l = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> s -> m (a, s)
m s
s m (a, s) -> String -> m (a, s)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l
{-# INLINE (<?>) #-}
unexpected :: String -> StateT s m a
unexpected = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (String -> m a) -> String -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: StateT s m ()
eof = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: StateT s m a -> StateT s m ()
notFollowedBy (Lazy.StateT s -> m (a, s)
m) = (s -> m ((), s)) -> StateT s m ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT
((s -> m ((), s)) -> StateT s m ())
-> (s -> m ((), s)) -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ((a, s) -> a
forall a b. (a, b) -> a
fst ((a, s) -> a) -> m (a, s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a, s)
m s
s) m () -> m ((), s) -> m ((), s)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((), s) -> m ((), s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((),s
s)
{-# INLINE notFollowedBy #-}
instance (Parsing m, MonadPlus m) => Parsing (Strict.StateT s m) where
try :: StateT s m a -> StateT s m a
try (Strict.StateT s -> m (a, s)
m) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ m (a, s) -> m (a, s)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
m
{-# INLINE try #-}
Strict.StateT s -> m (a, s)
m <?> :: StateT s m a -> String -> StateT s m a
<?> String
l = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> s -> m (a, s)
m s
s m (a, s) -> String -> m (a, s)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l
{-# INLINE (<?>) #-}
unexpected :: String -> StateT s m a
unexpected = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (String -> m a) -> String -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: StateT s m ()
eof = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: StateT s m a -> StateT s m ()
notFollowedBy (Strict.StateT s -> m (a, s)
m) = (s -> m ((), s)) -> StateT s m ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT
((s -> m ((), s)) -> StateT s m ())
-> (s -> m ((), s)) -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ((a, s) -> a
forall a b. (a, b) -> a
fst ((a, s) -> a) -> m (a, s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a, s)
m s
s) m () -> m ((), s) -> m ((), s)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((), s) -> m ((), s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((),s
s)
{-# INLINE notFollowedBy #-}
instance (Parsing m, MonadPlus m) => Parsing (ReaderT e m) where
try :: ReaderT e m a -> ReaderT e m a
try (ReaderT e -> m a
m) = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m a) -> ReaderT e m a) -> (e -> m a) -> ReaderT e m a
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (m a -> m a) -> (e -> m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
m
{-# INLINE try #-}
ReaderT e -> m a
m <?> :: ReaderT e m a -> String -> ReaderT e m a
<?> String
l = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m a) -> ReaderT e m a) -> (e -> m a) -> ReaderT e m a
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> m a
m e
e m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l
{-# INLINE (<?>) #-}
skipMany :: ReaderT e m a -> ReaderT e m ()
skipMany (ReaderT e -> m a
m) = (e -> m ()) -> ReaderT e m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m ()) -> ReaderT e m ()) -> (e -> m ()) -> ReaderT e m ()
forall a b. (a -> b) -> a -> b
$ m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (m a -> m ()) -> (e -> m a) -> e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
m
{-# INLINE skipMany #-}
unexpected :: String -> ReaderT e m a
unexpected = m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT e m a)
-> (String -> m a) -> String -> ReaderT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: ReaderT e m ()
eof = m () -> ReaderT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: ReaderT e m a -> ReaderT e m ()
notFollowedBy (ReaderT e -> m a
m) = (e -> m ()) -> ReaderT e m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m ()) -> ReaderT e m ()) -> (e -> m ()) -> ReaderT e m ()
forall a b. (a -> b) -> a -> b
$ m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (m a -> m ()) -> (e -> m a) -> e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
m
{-# INLINE notFollowedBy #-}
instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Strict.WriterT w m) where
try :: WriterT w m a -> WriterT w m a
try (Strict.WriterT m (a, w)
m) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
forall (m :: * -> *) a. Parsing m => m a -> m a
try m (a, w)
m
{-# INLINE try #-}
Strict.WriterT m (a, w)
m <?> :: WriterT w m a -> String -> WriterT w m a
<?> String
l = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w)
m m (a, w) -> String -> m (a, w)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l)
{-# INLINE (<?>) #-}
unexpected :: String -> WriterT w m a
unexpected = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (String -> m a) -> String -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: WriterT w m ()
eof = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: WriterT w m a -> WriterT w m ()
notFollowedBy (Strict.WriterT m (a, w)
m) = m ((), w) -> WriterT w m ()
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT
(m ((), w) -> WriterT w m ()) -> m ((), w) -> WriterT w m ()
forall a b. (a -> b) -> a -> b
$ m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ((a, w) -> a
forall a b. (a, b) -> a
fst ((a, w) -> a) -> m (a, w) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, w)
m) m () -> (() -> m ((), w)) -> m ((), w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \()
x -> ((), w) -> m ((), w)
forall (m :: * -> *) a. Monad m => a -> m a
return (()
x, w
forall a. Monoid a => a
mempty)
{-# INLINE notFollowedBy #-}
instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Lazy.WriterT w m) where
try :: WriterT w m a -> WriterT w m a
try (Lazy.WriterT m (a, w)
m) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
forall (m :: * -> *) a. Parsing m => m a -> m a
try m (a, w)
m
{-# INLINE try #-}
Lazy.WriterT m (a, w)
m <?> :: WriterT w m a -> String -> WriterT w m a
<?> String
l = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w)
m m (a, w) -> String -> m (a, w)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l)
{-# INLINE (<?>) #-}
unexpected :: String -> WriterT w m a
unexpected = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (String -> m a) -> String -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: WriterT w m ()
eof = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: WriterT w m a -> WriterT w m ()
notFollowedBy (Lazy.WriterT m (a, w)
m) = m ((), w) -> WriterT w m ()
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT
(m ((), w) -> WriterT w m ()) -> m ((), w) -> WriterT w m ()
forall a b. (a -> b) -> a -> b
$ m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ((a, w) -> a
forall a b. (a, b) -> a
fst ((a, w) -> a) -> m (a, w) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, w)
m) m () -> (() -> m ((), w)) -> m ((), w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \()
x -> ((), w) -> m ((), w)
forall (m :: * -> *) a. Monad m => a -> m a
return (()
x, w
forall a. Monoid a => a
mempty)
{-# INLINE notFollowedBy #-}
instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Lazy.RWST r w s m) where
try :: RWST r w s m a -> RWST r w s m a
try (Lazy.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (r -> s -> m (a, s, w)
m r
r s
s)
{-# INLINE try #-}
Lazy.RWST r -> s -> m (a, s, w)
m <?> :: RWST r w s m a -> String -> RWST r w s m a
<?> String
l = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> r -> s -> m (a, s, w)
m r
r s
s m (a, s, w) -> String -> m (a, s, w)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l
{-# INLINE (<?>) #-}
unexpected :: String -> RWST r w s m a
unexpected = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (String -> m a) -> String -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: RWST r w s m ()
eof = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: RWST r w s m a -> RWST r w s m ()
notFollowedBy (Lazy.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m ((), s, w)) -> RWST r w s m ()
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST
((r -> s -> m ((), s, w)) -> RWST r w s m ())
-> (r -> s -> m ((), s, w)) -> RWST r w s m ()
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ((\(a
a,s
_,w
_) -> a
a) ((a, s, w) -> a) -> m (a, s, w) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> s -> m (a, s, w)
m r
r s
s) m () -> (() -> m ((), s, w)) -> m ((), s, w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \()
x -> ((), s, w) -> m ((), s, w)
forall (m :: * -> *) a. Monad m => a -> m a
return (()
x, s
s, w
forall a. Monoid a => a
mempty)
{-# INLINE notFollowedBy #-}
instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Strict.RWST r w s m) where
try :: RWST r w s m a -> RWST r w s m a
try (Strict.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (r -> s -> m (a, s, w)
m r
r s
s)
{-# INLINE try #-}
Strict.RWST r -> s -> m (a, s, w)
m <?> :: RWST r w s m a -> String -> RWST r w s m a
<?> String
l = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> r -> s -> m (a, s, w)
m r
r s
s m (a, s, w) -> String -> m (a, s, w)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l
{-# INLINE (<?>) #-}
unexpected :: String -> RWST r w s m a
unexpected = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (String -> m a) -> String -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: RWST r w s m ()
eof = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: RWST r w s m a -> RWST r w s m ()
notFollowedBy (Strict.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m ((), s, w)) -> RWST r w s m ()
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST
((r -> s -> m ((), s, w)) -> RWST r w s m ())
-> (r -> s -> m ((), s, w)) -> RWST r w s m ()
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ((\(a
a,s
_,w
_) -> a
a) ((a, s, w) -> a) -> m (a, s, w) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> s -> m (a, s, w)
m r
r s
s) m () -> (() -> m ((), s, w)) -> m ((), s, w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \()
x -> ((), s, w) -> m ((), s, w)
forall (m :: * -> *) a. Monad m => a -> m a
return (()
x, s
s, w
forall a. Monoid a => a
mempty)
{-# INLINE notFollowedBy #-}
instance (Parsing m, Monad m) => Parsing (IdentityT m) where
try :: IdentityT m a -> IdentityT m a
try = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a)
-> (IdentityT m a -> m a) -> IdentityT m a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (m a -> m a) -> (IdentityT m a -> m a) -> IdentityT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
{-# INLINE try #-}
IdentityT m a
m <?> :: IdentityT m a -> String -> IdentityT m a
<?> String
l = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a
m m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
l)
{-# INLINE (<?>) #-}
skipMany :: IdentityT m a -> IdentityT m ()
skipMany = m () -> IdentityT m ()
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m () -> IdentityT m ())
-> (IdentityT m a -> m ()) -> IdentityT m a -> IdentityT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (m a -> m ()) -> (IdentityT m a -> m a) -> IdentityT m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
{-# INLINE skipMany #-}
unexpected :: String -> IdentityT m a
unexpected = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> (String -> m a) -> String -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected
{-# INLINE unexpected #-}
eof :: IdentityT m ()
eof = m () -> IdentityT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). Parsing m => m ()
eof
{-# INLINE eof #-}
notFollowedBy :: IdentityT m a -> IdentityT m ()
notFollowedBy (IdentityT m a
m) = m () -> IdentityT m ()
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m () -> IdentityT m ()) -> m () -> IdentityT m ()
forall a b. (a -> b) -> a -> b
$ m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy m a
m
{-# INLINE notFollowedBy #-}
#ifdef MIN_VERSION_parsec
instance (Parsec.Stream s m t, Show t) => Parsing (Parsec.ParsecT s u m) where
try :: ParsecT s u m a -> ParsecT s u m a
try = ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
Parsec.try
<?> :: ParsecT s u m a -> String -> ParsecT s u m a
(<?>) = ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
(Parsec.<?>)
skipMany :: ParsecT s u m a -> ParsecT s u m ()
skipMany = ParsecT s u m a -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
Parsec.skipMany
skipSome :: ParsecT s u m a -> ParsecT s u m ()
skipSome = ParsecT s u m a -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
Parsec.skipMany1
unexpected :: String -> ParsecT s u m a
unexpected = String -> ParsecT s u m a
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
Parsec.unexpected
eof :: ParsecT s u m ()
eof = ParsecT s u m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof
notFollowedBy :: ParsecT s u m a -> ParsecT s u m ()
notFollowedBy = ParsecT s u m a -> ParsecT s u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
Parsec.notFollowedBy
#endif
#ifdef MIN_VERSION_attoparsec
instance Att.Chunk t => Parsing (Att.Parser t) where
try :: Parser t a -> Parser t a
try = Parser t a -> Parser t a
forall i a. Parser i a -> Parser i a
Att.try
<?> :: Parser t a -> String -> Parser t a
(<?>) = Parser t a -> String -> Parser t a
forall i a. Parser i a -> String -> Parser i a
(Att.<?>)
skipMany :: Parser t a -> Parser t ()
skipMany = Parser t a -> Parser t ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
Att.skipMany
skipSome :: Parser t a -> Parser t ()
skipSome = Parser t a -> Parser t ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
Att.skipMany1
unexpected :: String -> Parser t a
unexpected = String -> Parser t a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
eof :: Parser t ()
eof = Parser t ()
forall t. Chunk t => Parser t ()
Att.endOfInput
notFollowedBy :: Parser t a -> Parser t ()
notFollowedBy Parser t a
p = Parser t a -> Parser t (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser t a
p Parser t (Maybe a) -> (Maybe a -> Parser t ()) -> Parser t ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser t () -> (a -> Parser t ()) -> Maybe a -> Parser t ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Parser t ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (String -> Parser t ()
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected (String -> Parser t ()) -> (a -> String) -> a -> Parser t ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
#endif
#ifdef MIN_VERSION_binary
instance Parsing B.Get where
try :: Get a -> Get a
try = Get a -> Get a
forall a. a -> a
id
<?> :: Get a -> String -> Get a
(<?>) = (String -> Get a -> Get a) -> Get a -> String -> Get a
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Get a -> Get a
forall a. String -> Get a -> Get a
B.label
skipMany :: Get a -> Get ()
skipMany Get a
p = do Bool
skipped <- Bool
True Bool -> Get a -> Get Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Get a
p Get Bool -> Get Bool -> Get Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Get Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
skipped (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ Get a -> Get ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany Get a
p
unexpected :: String -> Get a
unexpected = String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
eof :: Get ()
eof = do Bool
isEof <- Get Bool
B.isEmpty
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isEof (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parsing.eof"
notFollowedBy :: Get a -> Get ()
notFollowedBy Get a
p = Get a -> Get (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Get a
p Get (Maybe a) -> (Maybe a -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get () -> (a -> Get ()) -> Maybe a -> Get ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Get ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (String -> Get ()
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected (String -> Get ()) -> (a -> String) -> a -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
#endif
instance Parsing ReadP.ReadP where
try :: ReadP a -> ReadP a
try = ReadP a -> ReadP a
forall a. a -> a
id
<?> :: ReadP a -> String -> ReadP a
(<?>) = ReadP a -> String -> ReadP a
forall a b. a -> b -> a
const
skipMany :: ReadP a -> ReadP ()
skipMany = ReadP a -> ReadP ()
forall a. ReadP a -> ReadP ()
ReadP.skipMany
skipSome :: ReadP a -> ReadP ()
skipSome = ReadP a -> ReadP ()
forall a. ReadP a -> ReadP ()
ReadP.skipMany1
unexpected :: String -> ReadP a
unexpected = ReadP a -> String -> ReadP a
forall a b. a -> b -> a
const ReadP a
forall a. ReadP a
ReadP.pfail
eof :: ReadP ()
eof = ReadP ()
ReadP.eof
notFollowedBy :: ReadP a -> ReadP ()
notFollowedBy ReadP a
p = ((a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ReadP a -> ReadP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP a
p) ReadP (Maybe a) -> ReadP (Maybe a) -> ReadP (Maybe a)
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ Maybe a -> ReadP (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
ReadP (Maybe a) -> (Maybe a -> ReadP ()) -> ReadP ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReadP () -> (a -> ReadP ()) -> Maybe a -> ReadP ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ReadP ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (String -> ReadP ()
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected (String -> ReadP ()) -> (a -> String) -> a -> ReadP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)