{-# LANGUAGE BangPatterns, CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Attoparsec.Combinator
(
try
, (<?>)
, choice
, count
, option
, many'
, many1
, many1'
, manyTill
, manyTill'
, sepBy
, sepBy'
, sepBy1
, sepBy1'
, skipMany
, skipMany1
, eitherP
, feed
, satisfyElem
, endOfInput
, atEnd
, lookAhead
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..), (<$>))
import Data.Monoid (Monoid(mappend))
#endif
import Control.Applicative (Alternative(..), liftA2, many, (<|>))
import Control.Monad (MonadPlus(..))
import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))
import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)
import Data.ByteString (ByteString)
import Data.Foldable (asum)
import Data.Text (Text)
import qualified Data.Attoparsec.Zepto as Z
import Prelude hiding (succ)
try :: Parser i a -> Parser i a
try :: Parser i a -> Parser i a
try = Parser i a -> Parser i a
forall a. a -> a
id
{-# INLINE try #-}
(<?>) :: Parser i a
-> String
-> Parser i a
Parser i a
p <?> :: Parser i a -> String -> Parser i a
<?> String
msg0 = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a)
-> (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
forall a b. (a -> b) -> a -> b
$ \State i
t Pos
pos More
more Failure i (State i) r
lose Success i (State i) a r
succ ->
let lose' :: Failure i (State i) r
lose' State i
t' Pos
pos' More
more' [String]
strs String
msg = Failure i (State i) r
lose State i
t' Pos
pos' More
more' (String
msg0String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
strs) String
msg
in Parser i a
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
runParser Parser i a
p State i
t Pos
pos More
more Failure i (State i) r
lose' Success i (State i) a r
succ
{-# INLINE (<?>) #-}
infix 0 <?>
choice :: Alternative f => [f a] -> f a
choice :: [f a] -> f a
choice = [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
{-# SPECIALIZE choice :: [Parser ByteString a]
-> Parser ByteString a #-}
{-# SPECIALIZE choice :: [Parser Text a] -> Parser Text a #-}
{-# SPECIALIZE choice :: [Z.Parser a] -> Z.Parser a #-}
option :: Alternative f => a -> f a -> f a
option :: a -> f a -> f a
option a
x f a
p = f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-}
{-# SPECIALIZE option :: a -> Parser Text a -> Parser Text a #-}
{-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}
liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
liftM2' :: (a -> b -> c) -> m a -> m b -> m c
liftM2' a -> b -> c
f m a
a m b
b = do
!a
x <- m a
a
b
y <- m b
b
c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
x b
y)
{-# INLINE liftM2' #-}
many' :: (MonadPlus m) => m a -> m [a]
many' :: m a -> m [a]
many' m a
p = m [a]
many_p
where many_p :: m [a]
many_p = m [a]
some_p m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
some_p :: m [a]
some_p = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p m [a]
many_p
{-# INLINE many' #-}
many1 :: Alternative f => f a -> f [a]
many1 :: f a -> f [a]
many1 f a
p = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p (f a -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many f a
p)
{-# INLINE many1 #-}
many1' :: (MonadPlus m) => m a -> m [a]
many1' :: m a -> m [a]
many1' m a
p = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p (m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' m a
p)
{-# INLINE many1' #-}
sepBy :: Alternative f => f a -> f s -> f [a]
sepBy :: f a -> f s -> f [a]
sepBy f a
p f s
s = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p ((f s
s f s -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a -> f s -> f [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 f a
p f s
s) f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s
-> Parser ByteString [a] #-}
{-# SPECIALIZE sepBy :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
sepBy' :: m a -> m s -> m [a]
sepBy' m a
p m s
s = m [a]
scan m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where scan :: m [a]
scan = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p ((m s
s m s -> m [a] -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a -> m s -> m [a]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
sepBy1' m a
p m s
s) m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
-> Parser ByteString [a] #-}
{-# SPECIALIZE sepBy' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
sepBy1 :: Alternative f => f a -> f s -> f [a]
sepBy1 :: f a -> f s -> f [a]
sepBy1 f a
p f s
s = f [a]
scan
where scan :: f [a]
scan = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p ((f s
s f s -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f [a]
scan) f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s
-> Parser ByteString [a] #-}
{-# SPECIALIZE sepBy1 :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy1 :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
sepBy1' :: m a -> m s -> m [a]
sepBy1' m a
p m s
s = m [a]
scan
where scan :: m [a]
scan = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p ((m s
s m s -> m [a] -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [a]
scan) m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
-> Parser ByteString [a] #-}
{-# SPECIALIZE sepBy1' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy1' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
manyTill :: Alternative f => f a -> f b -> f [a]
manyTill :: f a -> f b -> f [a]
manyTill f a
p f b
end = f [a]
scan
where scan :: f [a]
scan = (f b
end f b -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p f [a]
scan
{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b
-> Parser ByteString [a] #-}
{-# SPECIALIZE manyTill :: Parser Text a -> Parser Text b -> Parser Text [a] #-}
{-# SPECIALIZE manyTill :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}
manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
manyTill' :: m a -> m b -> m [a]
manyTill' m a
p m b
end = m [a]
scan
where scan :: m [a]
scan = (m b
end m b -> m [a] -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []) m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p m [a]
scan
{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
-> Parser ByteString [a] #-}
{-# SPECIALIZE manyTill' :: Parser Text a -> Parser Text b -> Parser Text [a] #-}
{-# SPECIALIZE manyTill' :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}
skipMany :: Alternative f => f a -> f ()
skipMany :: f a -> f ()
skipMany f a
p = f ()
scan
where scan :: f ()
scan = (f a
p f a -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
scan) f () -> f () -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-}
{-# SPECIALIZE skipMany :: Parser Text a -> Parser Text () #-}
{-# SPECIALIZE skipMany :: Z.Parser a -> Z.Parser () #-}
skipMany1 :: Alternative f => f a -> f ()
skipMany1 :: f a -> f ()
skipMany1 f a
p = f a
p f a -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany f a
p
{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-}
{-# SPECIALIZE skipMany1 :: Parser Text a -> Parser Text () #-}
{-# SPECIALIZE skipMany1 :: Z.Parser a -> Z.Parser () #-}
count :: Monad m => Int -> m a -> m [a]
count :: Int -> m a -> m [a]
count Int
n m a
p = [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Int -> m a -> [m a]
forall a. Int -> a -> [a]
replicate Int
n m a
p)
{-# INLINE count #-}
eitherP :: (Alternative f) => f a -> f b -> f (Either a b)
eitherP :: f a -> f b -> f (Either a b)
eitherP f a
a f b
b = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a) f (Either a b) -> f (Either a b) -> f (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b)
{-# INLINE eitherP #-}
feed :: Monoid i => IResult i r -> i -> IResult i r
feed :: IResult i r -> i -> IResult i r
feed (Fail i
t [String]
ctxs String
msg) i
d = i -> [String] -> String -> IResult i r
forall i r. i -> [String] -> String -> IResult i r
Fail (i -> i -> i
forall a. Monoid a => a -> a -> a
mappend i
t i
d) [String]
ctxs String
msg
feed (Partial i -> IResult i r
k) i
d = i -> IResult i r
k i
d
feed (Done i
t r
r) i
d = i -> r -> IResult i r
forall i r. i -> r -> IResult i r
Done (i -> i -> i
forall a. Monoid a => a -> a -> a
mappend i
t i
d) r
r
{-# INLINE feed #-}
lookAhead :: Parser i a -> Parser i a
lookAhead :: Parser i a -> Parser i a
lookAhead Parser i a
p = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a)
-> (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
forall a b. (a -> b) -> a -> b
$ \State i
t Pos
pos More
more Failure i (State i) r
lose Success i (State i) a r
succ ->
let succ' :: State i -> p -> More -> a -> IResult i r
succ' State i
t' p
_pos' More
more' = Success i (State i) a r
succ State i
t' Pos
pos More
more'
in Parser i a
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
runParser Parser i a
p State i
t Pos
pos More
more Failure i (State i) r
lose Success i (State i) a r
forall p. State i -> p -> More -> a -> IResult i r
succ'
{-# INLINE lookAhead #-}