{-# LANGUAGE BangPatterns #-}
-- |
-- Module      :  Data.Binary.Parser
-- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015, Winterland 2016
-- License     :  BSD3
--
-- Maintainer  :  drkoster@qq.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This library provide parsec\/attoparsec style parsing combinators for
-- <http://hackage.haskell.org/package/binary binary>
-- package. By default, this module export combinators in "Data.Binary.Get",
-- "Data.Binary.Parser.Word8" and "Data.Binary.Parser.Numeric", for additional ASCII char parser,
-- please check "Data.Binary.Parser.Char8" module.
--
-- The behaviour of parsers here is different to that of the
-- similarly-named parser in Parsec, as this one is all-or-nothing.
-- To illustrate the difference, the following parser will fail under
-- Parsec given an input of @\"for\"@:
--
-- >string "foo" <|> string "for"
--
-- The reason for its failure is that the first branch is a
-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
-- before failing.  In binary-parsers, the above parser will /succeed/ on
-- that input, because the failed first branch will consume nothing.
--
-- There're some redundant combinators get removed, for example:
--
-- @
-- choice == asum
-- count == replicateM
-- atEnd == isEmpty
-- take == getByteString
-- many1 == some
-- @
--
-- For fast byte set operations, please use <http://hackage.haskell.org/package/charset charset>
-- package.
--
-- It's recommanded to use 'parseOnly', 'parseDetail'... functions to run your parsers since these
-- functions are faster than binary's counter part by avoiding a small constant overhead.
-- Check 'parse' for detail.
--
-- = A few words on performance and backtracking
--
-- There's a common belief that parsers which support backtracking are slow, but it's not neccessarily
-- true in binary, because binary doesn't do book keeping if you doesn't use '<|>', 'lookAhead' or their
-- friends. Combinators in this library like 'peek', 'string'... also try to avoid backtracking so
-- it's faster to use them rather than do backtracking yourself, for example, 'peek' is faster than
-- @'lookAhead' 'getWord8'@. In practice, protocols are often designed to avoid backtracking.
-- For example, if you have following parser:
--
-- >branch1 <|> branch2 <|> (skipN 1 >> branch3)
--
-- And if you can select the right branch just by looking ahead one byte, then you can rewrite it to:
--
-- @
-- w <- peek
-- if  | w == b1 -> branch1
--     | w == b2 -> branch2
--     | w == b3 -> skipN 1 >> branch3
-- @
--
-- Binary performs as fast as a non-backtracking parser as long as you construct your parser
-- without using backtracking. And sometime backtracking is indeed neccessary, for example 'scientifically'
-- is almost impossible to implement correctly if you don't do backtracking.
--
module Data.Binary.Parser
    (
    -- * Running parsers
      Parser
    , parseOnly
    , parseLazy
    , parseDetail
    , parseDetailLazy
    , parse
    -- * Decoder conversion
    , maybeDecoder
    , eitherDecoder
    -- * Combinators
    , (<?>)
    , endOfInput
    , option
    , eitherP
    , match
    , many'
    , some'
    , sepBy
    , sepBy'
    , sepBy1
    , sepBy1'
    , manyTill
    , manyTill'
    , skipMany
    , skipMany1
    -- * Re-exports
    , module Data.Binary.Get
    , module Data.Binary.Parser.Word8
    , module Data.Binary.Parser.Numeric
    ) where

import           Control.Applicative
import           Control.Monad
import           Data.Binary.Get
import qualified Data.Binary.Get.Internal   as I
import           Data.Binary.Parser.Numeric
import           Data.Binary.Parser.Word8
import qualified Data.ByteString            as B
import qualified Data.ByteString.Lazy       as L
import qualified Data.ByteString.Lazy.Internal as L (ByteString(..))

--------------------------------------------------------------------------------

-- | Alias to 'Get' for attoparsec compatibility.
type Parser a = Get a

-- | Run a parser on 'B.ByteString'.
--
-- This function does not force a parser to consume all of its input.
-- Instead, any residual input will be discarded.  To force a parser
-- to consume all of its input, use something like this:
--
-- @parseOnly (myParser <* endOfInput)@
--
parseOnly :: Get a -> B.ByteString -> Either String a
parseOnly :: forall a. Get a -> ByteString -> Either String a
parseOnly Get a
g ByteString
bs =
    case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Get a -> ByteString -> Decoder a
forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) of
        Fail ByteString
_ ByteOffset
_ String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
        Done ByteString
_ ByteOffset
_ a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
        Decoder a
_ -> String -> Either String a
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseOnly #-}


-- | Similar to 'parseOnly', but run a parser on lazy 'L.ByteString'.
--
parseLazy :: Get a -> L.ByteString -> Either String a
parseLazy :: forall a. Get a -> ByteString -> Either String a
parseLazy Get a
g (L.Chunk ByteString
bs ByteString
lbs) =
    case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Decoder a -> ByteString -> Decoder a
forall a. Decoder a -> ByteString -> Decoder a
pushChunks (Get a -> ByteString -> Decoder a
forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) ByteString
lbs) of
        Fail ByteString
_ ByteOffset
_ String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
        Done ByteString
_ ByteOffset
_ a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
        Decoder a
_ -> String -> Either String a
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
parseLazy Get a
g ByteString
L.Empty =
    case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Get a -> ByteString -> Decoder a
forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
B.empty) of
        Fail ByteString
_ ByteOffset
_ String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
        Done ByteString
_ ByteOffset
_ a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
        Decoder a
_ -> String -> Either String a
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseLazy #-}

-- | Run a parser on 'B.ByteString'.
--
-- This function return full parsing results: the rest of input, stop offest and fail
-- message or parsing result.
--
-- /Since: 0.2.1.0/
--
parseDetail :: Get a
            -> B.ByteString
            -> Either (B.ByteString, ByteOffset, String) (B.ByteString, ByteOffset, a)
parseDetail :: forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
parseDetail Get a
g ByteString
bs =
    case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Get a -> ByteString -> Decoder a
forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) of
        Fail ByteString
rest ByteOffset
offset String
err -> (ByteString, ByteOffset, String)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a b. a -> Either a b
Left (ByteString
rest, ByteOffset
offset, String
err)
        Done ByteString
rest ByteOffset
offset a
a   -> (ByteString, ByteOffset, a)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a b. b -> Either a b
Right (ByteString
rest, ByteOffset
offset, a
a)
        Decoder a
_ -> String
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseDetail #-}

-- | Similar to 'parseDetail', but run a parser on lazy 'L.ByteString'.
--
-- /Since: 0.2.1.0/
--
parseDetailLazy :: Get a
                -> L.ByteString
                -> Either (B.ByteString, ByteOffset, String) (B.ByteString, ByteOffset, a)
parseDetailLazy :: forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
parseDetailLazy Get a
g (L.Chunk ByteString
bs ByteString
lbs) =
    case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Decoder a -> ByteString -> Decoder a
forall a. Decoder a -> ByteString -> Decoder a
pushChunks (Get a -> ByteString -> Decoder a
forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) ByteString
lbs) of
        Fail ByteString
rest ByteOffset
offset String
err -> (ByteString, ByteOffset, String)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a b. a -> Either a b
Left (ByteString
rest, ByteOffset
offset, String
err)
        Done ByteString
rest ByteOffset
offset a
a   -> (ByteString, ByteOffset, a)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a b. b -> Either a b
Right (ByteString
rest, ByteOffset
offset, a
a)
        Decoder a
_ -> String
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
parseDetailLazy Get a
g ByteString
L.Empty =
    case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Get a -> ByteString -> Decoder a
forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
B.empty) of
        Fail ByteString
rest ByteOffset
offset String
err -> (ByteString, ByteOffset, String)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a b. a -> Either a b
Left (ByteString
rest, ByteOffset
offset, String
err)
        Done ByteString
rest ByteOffset
offset a
a   -> (ByteString, ByteOffset, a)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a b. b -> Either a b
Right (ByteString
rest, ByteOffset
offset, a
a)
        Decoder a
_ -> String
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseDetailLazy #-}

-- | Run a 'Get' monad. See 'Decoder' for what to do next, like providing
-- input, handling decoding errors and to get the output value.
--
-- This's faster than 'runGetIncremental' becuase it provides an initial chunk rather
-- than feeding 'B.empty' and waiting for chunks, this overhead is noticeable when you're
-- running small getters over short 'ByteString' s.
--
-- /Since: 0.2.1.0/
--
parse :: Get a -> B.ByteString -> Decoder a
parse :: forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs = Decoder a -> ByteOffset -> Decoder a
forall {a}. Decoder a -> ByteOffset -> Decoder a
calculateOffset (Decoder a -> Decoder a
forall {a}. Decoder a -> Decoder a
loop (Get a -> forall r. ByteString -> Success a r -> Decoder r
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
I.runCont Get a
g ByteString
bs Success a a
forall a. ByteString -> a -> Decoder a
I.Done)) (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs)
  where
    calculateOffset :: Decoder a -> ByteOffset -> Decoder a
calculateOffset Decoder a
r !ByteOffset
acc = case Decoder a
r of
        I.Done ByteString
inp a
a -> ByteString -> ByteOffset -> a -> Decoder a
forall a. ByteString -> ByteOffset -> a -> Decoder a
Done ByteString
inp (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
inp)) a
a
        I.Fail ByteString
inp String
s -> ByteString -> ByteOffset -> String -> Decoder a
forall a. ByteString -> ByteOffset -> String -> Decoder a
Fail ByteString
inp (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
inp)) String
s
        I.Partial Maybe ByteString -> Decoder a
k -> (Maybe ByteString -> Decoder a) -> Decoder a
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((Maybe ByteString -> Decoder a) -> Decoder a)
-> (Maybe ByteString -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
ms -> case Maybe ByteString
ms of
                Maybe ByteString
Nothing -> Decoder a -> ByteOffset -> Decoder a
calculateOffset (Maybe ByteString -> Decoder a
k Maybe ByteString
forall a. Maybe a
Nothing) ByteOffset
acc
                Just ByteString
i -> Decoder a -> ByteOffset -> Decoder a
calculateOffset (Maybe ByteString -> Decoder a
k Maybe ByteString
ms) (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
i))
        I.BytesRead ByteOffset
unused ByteOffset -> Decoder a
k -> Decoder a -> ByteOffset -> Decoder a
calculateOffset (ByteOffset -> Decoder a
k (ByteOffset -> Decoder a) -> ByteOffset -> Decoder a
forall a b. (a -> b) -> a -> b
$! (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- ByteOffset
unused)) ByteOffset
acc

    loop :: Decoder a -> Decoder a
loop Decoder a
r = case Decoder a
r of
        I.Partial Maybe ByteString -> Decoder a
k -> (Maybe ByteString -> Decoder a) -> Decoder a
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
I.Partial ((Maybe ByteString -> Decoder a) -> Decoder a)
-> (Maybe ByteString -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
ms -> case Maybe ByteString
ms of Just ByteString
_ -> Decoder a -> Decoder a
loop (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
                                                     Maybe ByteString
Nothing -> Decoder a -> Decoder a
forall {a}. Decoder a -> Decoder a
completeLoop (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
        I.BytesRead ByteOffset
n ByteOffset -> Decoder a
k -> ByteOffset -> (ByteOffset -> Decoder a) -> Decoder a
forall a. ByteOffset -> (ByteOffset -> Decoder a) -> Decoder a
I.BytesRead ByteOffset
n (Decoder a -> Decoder a
loop (Decoder a -> Decoder a)
-> (ByteOffset -> Decoder a) -> ByteOffset -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> Decoder a
k)
        I.Done ByteString
_ a
_ -> Decoder a
r
        I.Fail ByteString
_ String
_ -> Decoder a
r

    completeLoop :: Decoder a -> Decoder a
completeLoop Decoder a
r = case Decoder a
r of
        I.Partial Maybe ByteString -> Decoder a
k -> Decoder a -> Decoder a
completeLoop (Maybe ByteString -> Decoder a
k Maybe ByteString
forall a. Maybe a
Nothing)
        I.BytesRead ByteOffset
n ByteOffset -> Decoder a
k -> ByteOffset -> (ByteOffset -> Decoder a) -> Decoder a
forall a. ByteOffset -> (ByteOffset -> Decoder a) -> Decoder a
I.BytesRead ByteOffset
n (Decoder a -> Decoder a
completeLoop (Decoder a -> Decoder a)
-> (ByteOffset -> Decoder a) -> ByteOffset -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> Decoder a
k)
        I.Fail ByteString
_ String
_ -> Decoder a
r
        I.Done ByteString
_ a
_ -> Decoder a
r

--------------------------------------------------------------------------------

-- | Convert a 'Decoder' value to a 'Maybe' value. A 'Partial' result
-- is treated as failure.
--
-- /Since: 0.2.3.0/
--
maybeDecoder :: Decoder r -> Maybe r
maybeDecoder :: forall r. Decoder r -> Maybe r
maybeDecoder (Done ByteString
_ ByteOffset
_ r
r) = r -> Maybe r
forall a. a -> Maybe a
Just r
r
maybeDecoder Decoder r
_            = Maybe r
forall a. Maybe a
Nothing
{-# INLINE maybeDecoder #-}

-- | Convert a 'Decoder' value to an 'Either' value. A 'Partial'
-- result is treated as failure.
--
-- /Since: 0.2.3.0/
--
eitherDecoder :: Decoder r -> Either String r
eitherDecoder :: forall r. Decoder r -> Either String r
eitherDecoder (Done ByteString
_ ByteOffset
_ r
r)   = r -> Either String r
forall a b. b -> Either a b
Right r
r
eitherDecoder (Fail ByteString
_ ByteOffset
_ String
msg) = String -> Either String r
forall a b. a -> Either a b
Left String
msg
eitherDecoder Decoder r
_              = String -> Either String r
forall a b. a -> Either a b
Left String
"Decoder: incomplete input"
{-# INLINE eitherDecoder #-}

--------------------------------------------------------------------------------

-- | Name the parser, in case failure occurs.
(<?>) :: Get a -> String -> Get a
<?> :: forall a. 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
label
infix 0 <?>
{-# INLINE (<?>) #-}

-- | Match only if all input has been consumed.
endOfInput :: Get ()
endOfInput :: Get ()
endOfInput = do
    Bool
e <- Get Bool
isEmpty
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e (String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"endOfInput")
{-# INLINE endOfInput #-}

-- | @option x p@ tries to apply action @p@. If @p@ fails without
-- consuming input, it returns the value @x@, otherwise the value
-- returned by @p@.
--
-- > priority  = option 0 (digitToInt <$> digit)
option :: Alternative f => a -> f a -> f a
option :: forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option a
x f a
p = f a
p f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# SPECIALIZE option :: a -> Get a -> Get a #-}

-- | Combine two alternatives.
eitherP :: (Alternative f) => f a -> f b -> f (Either a b)
eitherP :: forall (f :: * -> *) a b.
Alternative f =>
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 a. f a -> f a -> f a
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 #-}

-- | Return both the result of a parse and the portion of the input
-- that was consumed while it was being parsed.
match :: Get a -> Get (B.ByteString, a)
match :: forall a. Get a -> Get (ByteString, a)
match Get a
p = do
    ByteOffset
pos1 <- Get ByteOffset
bytesRead
    (a
x, ByteOffset
pos2) <- Get (a, ByteOffset) -> Get (a, ByteOffset)
forall a. Get a -> Get a
lookAhead (Get (a, ByteOffset) -> Get (a, ByteOffset))
-> Get (a, ByteOffset) -> Get (a, ByteOffset)
forall a b. (a -> b) -> a -> b
$ (,) (a -> ByteOffset -> (a, ByteOffset))
-> Get a -> Get (ByteOffset -> (a, ByteOffset))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p Get (ByteOffset -> (a, ByteOffset))
-> Get ByteOffset -> Get (a, ByteOffset)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteOffset
bytesRead
    (,) (ByteString -> a -> (ByteString, a))
-> Get ByteString -> Get (a -> (ByteString, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get ByteString
getByteString (Int -> Get ByteString)
-> (ByteOffset -> Int) -> ByteOffset -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ByteOffset
pos2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- ByteOffset
pos1) Get (a -> (ByteString, a)) -> Get a -> Get (ByteString, a)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE match #-}

-- | A version of 'liftM2' that is strict in the result of its first
-- action.
liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
liftM2' :: forall (m :: * -> *) a b c.
Monad m =>
(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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
x b
y)
{-# INLINE liftM2' #-}

-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a
-- list of the returned values of @p@. The value returned by @p@ is
-- forced to WHNF.
--
-- >  word  = many' letter
many' :: (MonadPlus m) => m a -> m [a]
many' :: forall (m :: * -> *) a. MonadPlus m => 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 a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall a. 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' #-}

-- | @some' p@ applies the action @p@ /one/ or more times. Returns a
-- list of the returned values of @p@. The value returned by @p@ is
-- forced to WHNF.
--
-- >  word  = some' letter
some' :: (MonadPlus m) => m a -> m [a]
some' :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some' 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 some' #-}

-- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated
-- by @sep@. Returns a list of the values returned by @p@.
--
-- > commaSep p  = p `sepBy` (char ',')
sepBy :: Alternative f => f a -> f s -> f [a]
sepBy :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy f a
p f s
s = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall a b c. (a -> b -> c) -> f a -> f b -> f c
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 a b. f a -> f b -> f b
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 a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) f [a] -> f [a] -> f [a]
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# SPECIALIZE sepBy :: Get a -> Get s -> Get [a] #-}

-- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated
-- by @sep@. Returns a list of the values returned by @p@. The value
-- returned by @p@ is forced to WHNF.
--
-- > commaSep p  = p `sepBy'` (char ',')
sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
sepBy' :: forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
sepBy' m a
p m s
s = m [a]
go m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where go :: m [a]
go = (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 a b. m a -> m b -> m b
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 a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
{-# SPECIALIZE sepBy' :: Get a -> Get s -> Get [a] #-}

-- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated
-- by @sep@. Returns a list of the values returned by @p@.
--
-- > commaSep p  = p `sepBy1` (char ',')
sepBy1 :: Alternative f => f a -> f s -> f [a]
sepBy1 :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 f a
p f s
s = f [a]
go
    where go :: f [a]
go = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall a b c. (a -> b -> c) -> f a -> f b -> f c
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 a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f [a]
go) f [a] -> f [a] -> f [a]
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
{-# SPECIALIZE sepBy1 :: Get a -> Get s -> Get [a] #-}

-- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated
-- by @sep@. Returns a list of the values returned by @p@. The value
-- returned by @p@ is forced to WHNF.
--
-- > commaSep p  = p `sepBy1'` (char ',')
sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
sepBy1' :: forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
sepBy1' m a
p m s
s = m [a]
go
    where go :: m [a]
go = (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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [a]
go) m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
{-# SPECIALIZE sepBy1' :: Get a -> Get s -> Get [a] #-}

-- | @manyTill p end@ applies action @p@ /zero/ or more times until
-- action @end@ succeeds, and returns the list of values returned by
-- @p@.  This can be used to scan comments:
--
-- >  simpleComment   = string "<!--" *> manyTill anyChar (string "-->")
--
-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@.
-- While this will work, it is not very efficient, as it will cause a
-- lot of backtracking.)
manyTill :: Alternative f => f a -> f b -> f [a]
manyTill :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill f a
p f b
end = f [a]
go
    where go :: f [a]
go = (f b
end f b -> f [a] -> f [a]
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) f [a] -> f [a] -> f [a]
forall a. 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 a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p f [a]
go
{-# SPECIALIZE manyTill :: Get a -> Get b -> Get [a] #-}

-- | @manyTill' p end@ applies action @p@ /zero/ or more times until
-- action @end@ succeeds, and returns the list of values returned by
-- @p@.  This can be used to scan comments:
--
-- >  simpleComment   = string "<!--" *> manyTill' anyChar (string "-->")
--
-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@.
-- While this will work, it is not very efficient, as it will cause a
-- lot of backtracking.)
--
-- The value returned by @p@ is forced to WHNF.
manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
manyTill' :: forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
manyTill' m a
p m b
end = m [a]
go
    where go :: m [a]
go = (m b
end m b -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []) m [a] -> m [a] -> m [a]
forall a. 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]
go
{-# SPECIALIZE manyTill' :: Get a -> Get b -> Get [a] #-}

-- | Skip zero or more instances of an action.
skipMany :: Alternative f => f a -> f ()
skipMany :: forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany f a
p = f ()
go
    where go :: f ()
go = (f a
p f a -> f () -> f ()
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
go) f () -> f () -> f ()
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# SPECIALIZE skipMany :: Get a -> Get () #-}

-- | Skip one or more instances of an action.
skipMany1 :: Alternative f => f a -> f ()
skipMany1 :: forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 f a
p = f a
p f a -> f () -> f ()
forall a b. f a -> f b -> f b
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 :: Get a -> Get () #-}