{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-|
Module      : Z.Data.Parser.Base
Description : Efficient deserialization/parse.
Copyright   : (c) Dong Han, 2017-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provide a simple resumable 'Parser', which is suitable for binary protocol and simple textual protocol parsing. Both binary parsers ('decodePrim' ,etc) and textual parsers are provided, and they all work on 'V.Bytes'.

You can use 'Alternative' instance to do backtracking, each branch will either succeed and may consume some input, or fail without consume anything. It's recommend to use 'peek' or 'peekMaybe' to avoid backtracking if possible to get high performance.

Error message can be attached using '<?>', which have very small overhead, so it's recommended to attach a message in front of a composed parser like @xPacket = "Foo.Bar.xPacket" <?> do ...@, following is an example message when parsing an integer failed:

@
    >parse int "foo"
    ([102,111,111],Left ["Z.Data.Parser.Numeric.int","Std.Data.Parser.Base.takeWhile1: no satisfied byte"])
    -- It's easy to see we're trying to match a leading sign or digit here
@

-}

module Z.Data.Parser.Base
  ( -- * Parser types
    Result(..)
  , ParseError
  , ParseStep
  , Parser(..)
  , (<?>)
    -- * Running a parser
  , parse, parse_, parseChunk, parseChunks, finishParsing
  , runAndKeepTrack, match
    -- * Basic parsers
  , ensureN, endOfInput, atEnd
    -- * Primitive decoders
  , decodePrim, decodePrimLE, decodePrimBE
    -- * More parsers
  , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith
  , word8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces
  , take, takeTill, takeWhile, takeWhile1, bytes, bytesCI
  , text
    -- * Misc
  , isSpace
  ) where

import           Control.Applicative
import           Control.Monad
import qualified Control.Monad.Fail                 as Fail
import qualified Data.CaseInsensitive               as CI
import qualified Data.Primitive.PrimArray           as A
import           Data.Int
import           Data.Word
import           GHC.Types
import           Prelude                            hiding (take, takeWhile)
import           Z.Data.Array.UnalignedAccess
import qualified Z.Data.Text.Base                 as T
import qualified Z.Data.Vector.Base               as V
import qualified Z.Data.Vector.Extra              as V

-- | Simple parsing result, that represent respectively:
--
-- * Success: the remaining unparsed data and the parsed value
--
-- * Failure: the remaining unparsed data and the error message
--
-- * Partial: that need for more input data, supply empty bytes to indicate 'endOfInput'
--
data Result a
    = Success a          !V.Bytes
    | Failure ParseError !V.Bytes
    | Partial (ParseStep a)

-- | A parse step consumes 'V.Bytes' and produce 'Result'.
type ParseStep r = V.Bytes -> Result r

-- | Type alias for error message
type ParseError = [T.Text]

instance Functor Result where
    fmap :: (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
a Bytes
s)   = b -> Bytes -> Result b
forall a. a -> Bytes -> Result a
Success (a -> b
f a
a) Bytes
s
    fmap a -> b
f (Partial ParseStep a
k)     = (Bytes -> Result b) -> Result b
forall a. (Bytes -> Result a) -> Result a
Partial ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result a -> Result b) -> ParseStep a -> Bytes -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseStep a
k)
    fmap a -> b
_ (Failure ParseError
e Bytes
v)   = ParseError -> Bytes -> Result b
forall a. ParseError -> Bytes -> Result a
Failure ParseError
e Bytes
v

instance Show a => Show (Result a) where
    show :: Result a -> String
show (Success a
a Bytes
_)    = String
"Success " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a
    show (Partial ParseStep a
_)      = String
"Partial _"
    show (Failure ParseError
errs Bytes
_) = String
"Failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
errs


-- | Simple CPSed parser
--
-- A parser takes a failure continuation, and a success one, while the success continuation is
-- usually composed by 'Monad' instance, the failure one is more like a reader part, which can
-- be modified via '<?>'. If you build parsers from ground, a pattern like this can be used:
--
--  @
--    xxParser = do
--      ensureN errMsg ...            -- make sure we have some bytes
--      Parser $ \ kf k inp ->        -- fail continuation, success continuation and input
--        ...
--        ... kf errMsg (if input not OK)
--        ... k ... (if we get something useful for next parser)
--  @
newtype Parser a = Parser {
        Parser a
-> forall r.
   (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
runParser :: forall r . (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
    }

-- It seems eta-expand all params to ensure parsers are saturated is helpful
instance Functor Parser where
    fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa) = (forall r.
 (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r)
-> Parser b
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf b -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa ParseError -> ParseStep r
kf (b -> ParseStep r
k (b -> ParseStep r) -> (a -> b) -> a -> ParseStep r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Bytes
inp)
    {-# INLINE fmap #-}
    a
a <$ :: a -> Parser b -> Parser a
<$ Parser forall r.
(ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
pb = (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf a -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
pb ParseError -> ParseStep r
kf (\ b
_ -> a -> ParseStep r
k a
a) Bytes
inp)
    {-# INLINE (<$) #-}

instance Applicative Parser where
    pure :: a -> Parser a
pure a
x = (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ a -> ParseStep r
k Bytes
inp -> a -> ParseStep r
k a
x Bytes
inp)
    {-# INLINE pure #-}
    Parser forall r.
(ParseError -> ParseStep r)
-> ((a -> b) -> ParseStep r) -> ParseStep r
pf <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa = (forall r.
 (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r)
-> Parser b
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf b -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r)
-> ((a -> b) -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r)
-> ((a -> b) -> ParseStep r) -> ParseStep r
pf ParseError -> ParseStep r
kf (\ a -> b
f -> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa ParseError -> ParseStep r
kf (b -> ParseStep r
k (b -> ParseStep r) -> (a -> b) -> a -> ParseStep r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)) Bytes
inp)
    {-# INLINE (<*>) #-}
    Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa *> :: Parser a -> Parser b -> Parser b
*> Parser forall r.
(ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
pb = (forall r.
 (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r)
-> Parser b
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf b -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa ParseError -> ParseStep r
kf (\ a
_ Bytes
inp' -> (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
pb ParseError -> ParseStep r
kf b -> ParseStep r
k Bytes
inp') Bytes
inp)
    {-# INLINE (*>) #-}
    Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa <* :: Parser a -> Parser b -> Parser a
<* Parser forall r.
(ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
pb = (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf a -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa ParseError -> ParseStep r
kf (\ a
x Bytes
inp' -> (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
pb ParseError -> ParseStep r
kf (\ b
_ -> a -> ParseStep r
k a
x) Bytes
inp') Bytes
inp)
    {-# INLINE (<*) #-}

instance Monad Parser where
    return :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
f = (forall r.
 (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r)
-> Parser b
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf b -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa ParseError -> ParseStep r
kf (\ a
a -> Parser b
-> (ParseError -> ParseStep r) -> (b -> ParseStep r) -> ParseStep r
forall a.
Parser a
-> forall r.
   (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
runParser (a -> Parser b
f a
a) ParseError -> ParseStep r
kf b -> ParseStep r
k) Bytes
inp)
    {-# INLINE (>>=) #-}
    >> :: Parser a -> Parser b -> Parser b
(>>) = Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}

instance Fail.MonadFail Parser where
    fail :: String -> Parser a
fail = Text -> Parser a
forall a. Text -> Parser a
fail' (Text -> Parser a) -> (String -> Text) -> String -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    {-# INLINE fail #-}

instance MonadPlus Parser where
    mzero :: Parser a
mzero = Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
    {-# INLINE mzero #-}
    mplus :: Parser a -> Parser a -> Parser a
mplus = Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
    {-# INLINE mplus #-}

instance Alternative Parser where
    empty :: Parser a
empty = Text -> Parser a
forall a. Text -> Parser a
fail' Text
"Z.Data.Parser.Base(Alternative).empty"
    {-# INLINE empty #-}
    Parser a
f <|> :: Parser a -> Parser a -> Parser a
<|> Parser a
g = do
        (Result a
r, [Bytes]
bss) <- Parser a -> Parser (Result a, [Bytes])
forall a. Parser a -> Parser (Result a, [Bytes])
runAndKeepTrack Parser a
f
        case Result a
r of
            Success a
x Bytes
inp   -> (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ a -> ParseStep r
k Bytes
_ -> a -> ParseStep r
k a
x Bytes
inp)
            Failure ParseError
_ Bytes
_     -> let !bs :: Bytes
bs = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
bss)
                               in (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf a -> ParseStep r
k Bytes
_ -> Parser a
-> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall a.
Parser a
-> forall r.
   (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
runParser Parser a
g ParseError -> ParseStep r
kf a -> ParseStep r
k Bytes
bs)
            Result a
_               -> String -> Parser a
forall a. HasCallStack => String -> a
error String
"Z.Data.Parser.Base: impossible"
    {-# INLINE (<|>) #-}

-- | 'T.Text' version of 'fail'.
fail' :: T.Text -> Parser a
{-# INLINE fail' #-}
fail' :: Text -> Parser a
fail' Text
msg = (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf a -> ParseStep r
_ Bytes
inp -> ParseError -> ParseStep r
kf [Text
msg] Bytes
inp)

-- | Parse the complete input, without resupplying
parse_ :: Parser a -> V.Bytes -> Either ParseError a
{-# INLINE parse_ #-}
parse_ :: Parser a -> Bytes -> Either ParseError a
parse_ (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p) Bytes
inp = (Bytes, Either ParseError a) -> Either ParseError a
forall a b. (a, b) -> b
snd ((Bytes, Either ParseError a) -> Either ParseError a)
-> (Bytes, Either ParseError a) -> Either ParseError a
forall a b. (a -> b) -> a -> b
$ Result a -> (Bytes, Either ParseError a)
forall a. Result a -> (Bytes, Either ParseError a)
finishParsing ((ParseError -> ParseStep a) -> (a -> ParseStep a) -> ParseStep a
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p ParseError -> ParseStep a
forall a. ParseError -> Bytes -> Result a
Failure a -> ParseStep a
forall a. a -> Bytes -> Result a
Success Bytes
inp)

-- | Parse the complete input, without resupplying, return the rest bytes
parse :: Parser a -> V.Bytes -> (V.Bytes, Either ParseError a)
{-# INLINE parse #-}
parse :: Parser a -> Bytes -> (Bytes, Either ParseError a)
parse (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p) Bytes
inp = Result a -> (Bytes, Either ParseError a)
forall a. Result a -> (Bytes, Either ParseError a)
finishParsing ((ParseError -> ParseStep a) -> (a -> ParseStep a) -> ParseStep a
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p ParseError -> ParseStep a
forall a. ParseError -> Bytes -> Result a
Failure a -> ParseStep a
forall a. a -> Bytes -> Result a
Success Bytes
inp)

-- | Parse an input chunk
parseChunk :: Parser a -> V.Bytes -> Result a
{-# INLINE parseChunk #-}
parseChunk :: Parser a -> Bytes -> Result a
parseChunk (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p) = (ParseError -> Bytes -> Result a)
-> (a -> Bytes -> Result a) -> Bytes -> Result a
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p ParseError -> Bytes -> Result a
forall a. ParseError -> Bytes -> Result a
Failure a -> Bytes -> Result a
forall a. a -> Bytes -> Result a
Success

-- | Finish parsing and fetch result, feed empty bytes if it's 'Partial' result.
finishParsing :: Result a -> (V.Bytes, Either ParseError a)
{-# INLINABLE finishParsing #-}
finishParsing :: Result a -> (Bytes, Either ParseError a)
finishParsing Result a
r = case Result a
r of
    Success a
a Bytes
rest    -> (Bytes
rest, a -> Either ParseError a
forall a b. b -> Either a b
Right a
a)
    Failure ParseError
errs Bytes
rest -> (Bytes
rest, ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
errs)
    Partial ParseStep a
f         -> Result a -> (Bytes, Either ParseError a)
forall a. Result a -> (Bytes, Either ParseError a)
finishParsing (ParseStep a
f Bytes
forall (v :: * -> *) a. Vec v a => v a
V.empty)

-- | Run a parser with an initial input string, and a monadic action
-- that can supply more input if needed.
--
-- Note, once the monadic action return empty bytes, parsers will stop drawing
-- more bytes (take it as 'endOfInput').
parseChunks :: Monad m => Parser a -> m V.Bytes -> V.Bytes -> m (V.Bytes, Either ParseError a)
{-# INLINABLE parseChunks #-}
parseChunks :: Parser a -> m Bytes -> Bytes -> m (Bytes, Either ParseError a)
parseChunks (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p) m Bytes
m0 Bytes
inp = m Bytes -> Result a -> m (Bytes, Either ParseError a)
forall (f :: * -> *) b.
Monad f =>
f Bytes -> Result b -> f (Bytes, Either ParseError b)
go m Bytes
m0 ((ParseError -> ParseStep a) -> (a -> ParseStep a) -> ParseStep a
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p ParseError -> ParseStep a
forall a. ParseError -> Bytes -> Result a
Failure a -> ParseStep a
forall a. a -> Bytes -> Result a
Success Bytes
inp)
  where
    go :: f Bytes -> Result b -> f (Bytes, Either ParseError b)
go f Bytes
m Result b
r = case Result b
r of
        Partial ParseStep b
f -> do
            Bytes
inp' <- f Bytes
m
            if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp'
            then f Bytes -> Result b -> f (Bytes, Either ParseError b)
go (Bytes -> f Bytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes
forall (v :: * -> *) a. Vec v a => v a
V.empty) (ParseStep b
f Bytes
forall (v :: * -> *) a. Vec v a => v a
V.empty)
            else f Bytes -> Result b -> f (Bytes, Either ParseError b)
go f Bytes
m (ParseStep b
f Bytes
inp')
        Success b
a Bytes
rest    -> (Bytes, Either ParseError b) -> f (Bytes, Either ParseError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes
rest, b -> Either ParseError b
forall a b. b -> Either a b
Right b
a)
        Failure ParseError
errs Bytes
rest -> (Bytes, Either ParseError b) -> f (Bytes, Either ParseError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes
rest, ParseError -> Either ParseError b
forall a b. a -> Either a b
Left ParseError
errs)

(<?>) :: T.Text -> Parser a -> Parser a
{-# INLINE (<?>) #-}
Text
msg <?> :: Text -> Parser a -> Parser a
<?> (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p) = (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf a -> ParseStep r
k Bytes
inp -> (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
p (ParseError -> ParseStep r
kf (ParseError -> ParseStep r)
-> (ParseError -> ParseError) -> ParseError -> ParseStep r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
msgText -> ParseError -> ParseError
forall a. a -> [a] -> [a]
:)) a -> ParseStep r
k Bytes
inp)
infixr 0 <?>

-- | Run a parser and keep track of all the input chunks it consumes.
-- Once it's finished, return the final result (always 'Success' or 'Failure') and
-- all consumed chunks.
--
runAndKeepTrack :: Parser a -> Parser (Result a, [V.Bytes])
{-# INLINE runAndKeepTrack #-}
runAndKeepTrack :: Parser a -> Parser (Result a, [Bytes])
runAndKeepTrack (Parser forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa) = (forall r.
 (ParseError -> ParseStep r)
 -> ((Result a, [Bytes]) -> ParseStep r) -> ParseStep r)
-> Parser (Result a, [Bytes])
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r)
  -> ((Result a, [Bytes]) -> ParseStep r) -> ParseStep r)
 -> Parser (Result a, [Bytes]))
-> (forall r.
    (ParseError -> ParseStep r)
    -> ((Result a, [Bytes]) -> ParseStep r) -> ParseStep r)
-> Parser (Result a, [Bytes])
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
_ (Result a, [Bytes]) -> ParseStep r
k0 Bytes
inp ->
    let go :: [Bytes]
-> Result a
-> ((Result a, [Bytes]) -> Bytes -> Result a)
-> Result a
go ![Bytes]
acc Result a
r (Result a, [Bytes]) -> Bytes -> Result a
k = case Result a
r of
            Partial ParseStep a
k'      -> (Bytes -> Result a) -> Result a
forall a. (Bytes -> Result a) -> Result a
Partial (\ Bytes
inp' -> [Bytes]
-> Result a
-> ((Result a, [Bytes]) -> Bytes -> Result a)
-> Result a
go (Bytes
inp'Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc) (ParseStep a
k' Bytes
inp') (Result a, [Bytes]) -> Bytes -> Result a
k)
            Success a
_ Bytes
inp' -> (Result a, [Bytes]) -> Bytes -> Result a
k (Result a
r, [Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc) Bytes
inp'
            Failure ParseError
_ Bytes
inp' -> (Result a, [Bytes]) -> Bytes -> Result a
k (Result a
r, [Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc) Bytes
inp'
        r0 :: Result a
r0 = (ParseError -> ParseStep a) -> (a -> ParseStep a) -> ParseStep a
forall r.
(ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r
pa ParseError -> ParseStep a
forall a. ParseError -> Bytes -> Result a
Failure a -> ParseStep a
forall a. a -> Bytes -> Result a
Success Bytes
inp
    in [Bytes]
-> Result a -> ((Result a, [Bytes]) -> ParseStep r) -> Result r
forall a a.
[Bytes]
-> Result a
-> ((Result a, [Bytes]) -> Bytes -> Result a)
-> Result a
go [Bytes
inp] Result a
r0 (Result a, [Bytes]) -> ParseStep r
k0

-- | Return both the result of a parse and the portion of the input
-- that was consumed while it was being parsed.
match :: Parser a -> Parser (V.Bytes, a)
{-# INLINE match #-}
match :: Parser a -> Parser (Bytes, a)
match Parser a
p = do
    (Result a
r, [Bytes]
bss) <- Parser a -> Parser (Result a, [Bytes])
forall a. Parser a -> Parser (Result a, [Bytes])
runAndKeepTrack Parser a
p
    (forall r.
 (ParseError -> ParseStep r)
 -> ((Bytes, a) -> ParseStep r) -> ParseStep r)
-> Parser (Bytes, a)
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ (Bytes, a) -> ParseStep r
k Bytes
_ ->
        case Result a
r of
            Success a
r' Bytes
inp'  -> let !consumed :: Bytes
consumed = Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.dropR (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
inp') ([Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
bss))
                                in (Bytes, a) -> ParseStep r
k (Bytes
consumed , a
r') Bytes
inp'
            Failure ParseError
err Bytes
inp' -> ParseError -> ParseStep r
forall a. ParseError -> Bytes -> Result a
Failure ParseError
err Bytes
inp'
            Partial ParseStep a
_        -> String -> Result r
forall a. HasCallStack => String -> a
error String
"Z.Data.Parser.Base.match: impossible")

-- | Ensure that there are at least @n@ bytes available. If not, the
-- computation will escape with 'Partial'.
--
-- Since this parser is used in many other parsers, an extra error param is provide
-- to attach custom error info.
ensureN :: Int -> ParseError -> Parser ()
{-# INLINE ensureN #-}
ensureN :: Int -> ParseError -> Parser ()
ensureN Int
n0 ParseError
err = (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
 -> Parser ())
-> (forall r.
    (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp -> do
    let l :: Int
l = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
inp
    if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n0
    then () -> ParseStep r
k () Bytes
inp
    else ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (Int
-> Bytes
-> (ParseError -> ParseStep r)
-> (() -> ParseStep r)
-> ParseStep r
forall a.
Int
-> Bytes
-> (ParseError -> Bytes -> Result a)
-> (() -> Bytes -> Result a)
-> Bytes
-> Result a
ensureNPartial Int
l Bytes
inp ParseError -> ParseStep r
kf () -> ParseStep r
k)
  where
    {-# INLINABLE ensureNPartial #-}
    ensureNPartial :: Int
-> Bytes
-> (ParseError -> Bytes -> Result a)
-> (() -> Bytes -> Result a)
-> Bytes
-> Result a
ensureNPartial Int
l0 Bytes
inp0 ParseError -> Bytes -> Result a
kf () -> Bytes -> Result a
k =
        let go :: [Bytes] -> Int -> Bytes -> Result a
go [Bytes]
acc !Int
l = \ Bytes
inp -> do
                let l' :: Int
l' = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
inp
                if Int
l' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then ParseError -> Bytes -> Result a
kf ParseError
err ([Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse (Bytes
inpBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc)))
                else do
                    let l'' :: Int
l'' = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l'
                    if Int
l'' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n0
                    then (Bytes -> Result a) -> Result a
forall a. (Bytes -> Result a) -> Result a
Partial ([Bytes] -> Int -> Bytes -> Result a
go (Bytes
inpBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc) Int
l'')
                    else
                        let !inp' :: Bytes
inp' = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse (Bytes
inpBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc))
                        in () -> Bytes -> Result a
k () Bytes
inp'
        in [Bytes] -> Int -> Bytes -> Result a
go [Bytes
inp0] Int
l0

-- | Test whether all input has been consumed, i.e. there are no remaining
-- undecoded bytes. Fail if not 'atEnd'.
endOfInput :: Parser ()
{-# INLINE endOfInput #-}
endOfInput :: Parser ()
endOfInput = (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
 -> Parser ())
-> (forall r.
    (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp ->
    if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
    then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (\ Bytes
inp' ->
        if (Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp')
        then () -> ParseStep r
k () Bytes
inp'
        else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.endOfInput: end not reached yet"] Bytes
inp)
    else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.endOfInput: end not reached yet"] Bytes
inp

-- | Test whether all input has been consumed, i.e. there are no remaining
-- undecoded bytes.
atEnd :: Parser Bool
{-# INLINE atEnd #-}
atEnd :: Parser Bool
atEnd = (forall r.
 (ParseError -> ParseStep r)
 -> (Bool -> ParseStep r) -> ParseStep r)
-> Parser Bool
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r)
  -> (Bool -> ParseStep r) -> ParseStep r)
 -> Parser Bool)
-> (forall r.
    (ParseError -> ParseStep r)
    -> (Bool -> ParseStep r) -> ParseStep r)
-> Parser Bool
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
_ Bool -> ParseStep r
k Bytes
inp ->
    if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
    then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (\ Bytes
inp' -> Bool -> ParseStep r
k (Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp') Bytes
inp')
    else Bool -> ParseStep r
k Bool
False Bytes
inp

decodePrim :: forall a. (UnalignedAccess a) => Parser a
{-# INLINE decodePrim #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Word   #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Word64 #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Word32 #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Word16 #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Word8  #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Int   #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Int64 #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Int32 #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Int16 #-}
{-# SPECIALIZE INLINE decodePrim :: Parser Int8  #-}
decodePrim :: Parser a
decodePrim = do
    Int -> ParseError -> Parser ()
ensureN Int
n [Text
"Z.Data.Parser.Base.decodePrim: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ a -> ParseStep r
k (V.PrimVector (A.PrimArray ByteArray#
ba#) i :: Int
i@(I# Int#
i#) Int
len) ->
        let !r :: a
r = ByteArray# -> Int# -> a
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in a -> ParseStep r
k a
r (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
A.PrimArray ByteArray#
ba#) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)))
  where
    n :: Int
n = UnalignedSize a -> Int
forall a. UnalignedSize a -> Int
getUnalignedSize (UnalignedSize a
forall a. UnalignedAccess a => UnalignedSize a
unalignedSize :: UnalignedSize a)

decodePrimLE :: forall a. (UnalignedAccess (LE a)) => Parser a
{-# INLINE decodePrimLE #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Word   #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Word64 #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Word32 #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Word16 #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Int   #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Int64 #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Int32 #-}
{-# SPECIALIZE INLINE decodePrimLE :: Parser Int16 #-}
decodePrimLE :: Parser a
decodePrimLE = do
    Int -> ParseError -> Parser ()
ensureN Int
n [Text
"Z.Data.Parser.Base.decodePrimLE: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ a -> ParseStep r
k (V.PrimVector (A.PrimArray ByteArray#
ba#) i :: Int
i@(I# Int#
i#) Int
len) ->
        let !r :: LE a
r = ByteArray# -> Int# -> LE a
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in a -> ParseStep r
k (LE a -> a
forall a. LE a -> a
getLE LE a
r) (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
A.PrimArray ByteArray#
ba#) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)))
  where
    n :: Int
n = UnalignedSize (LE a) -> Int
forall a. UnalignedSize a -> Int
getUnalignedSize (UnalignedSize (LE a)
forall a. UnalignedAccess a => UnalignedSize a
unalignedSize :: UnalignedSize (LE a))

decodePrimBE :: forall a. (UnalignedAccess (BE a)) => Parser a
{-# INLINE decodePrimBE #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Word   #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Word64 #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Word32 #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Word16 #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Int   #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Int64 #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Int32 #-}
{-# SPECIALIZE INLINE decodePrimBE :: Parser Int16 #-}
decodePrimBE :: Parser a
decodePrimBE = do
    Int -> ParseError -> Parser ()
ensureN Int
n [Text
"Z.Data.Parser.Base.decodePrimBE: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ a -> ParseStep r
k (V.PrimVector (A.PrimArray ByteArray#
ba#) i :: Int
i@(I# Int#
i#) Int
len) ->
        let !r :: BE a
r = ByteArray# -> Int# -> BE a
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in a -> ParseStep r
k (BE a -> a
forall a. BE a -> a
getBE BE a
r) (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
A.PrimArray ByteArray#
ba#) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)))
  where
    n :: Int
n = UnalignedSize (BE a) -> Int
forall a. UnalignedSize a -> Int
getUnalignedSize (UnalignedSize (BE a)
forall a. UnalignedAccess a => UnalignedSize a
unalignedSize :: UnalignedSize (BE a))

-- | A stateful scanner.  The predicate consumes and transforms a
-- state argument, and each transformed state is passed to successive
-- invocations of the predicate on each byte of the input until one
-- returns 'Nothing' or the input ends.
--
-- This parser does not fail.  It will return an empty string if the
-- predicate returns 'Nothing' on the first byte of input.
--
scan :: s -> (s -> Word8 -> Maybe s) -> Parser (V.Bytes, s)
{-# INLINE scan #-}
scan :: s -> (s -> Word8 -> Maybe s) -> Parser (Bytes, s)
scan s
s0 s -> Word8 -> Maybe s
f = s
-> (s -> Bytes -> Either s (Bytes, Bytes, s)) -> Parser (Bytes, s)
forall s.
s
-> (s -> Bytes -> Either s (Bytes, Bytes, s)) -> Parser (Bytes, s)
scanChunks s
s0 s -> Bytes -> Either s (Bytes, Bytes, s)
f'
  where
    f' :: s -> Bytes -> Either s (Bytes, Bytes, s)
f' s
s0' (V.PrimVector PrimArray Word8
arr Int
off Int
l) =
        let !end :: Int
end = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
            go :: s -> Int -> Either s (Bytes, Bytes, s)
go !s
st !Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = do
                    let !w :: Word8
w = PrimArray Word8 -> Int -> Word8
forall a. Prim a => PrimArray a -> Int -> a
A.indexPrimArray PrimArray Word8
arr Int
i
                    case s -> Word8 -> Maybe s
f s
st Word8
w of
                        Just s
st' -> s -> Int -> Either s (Bytes, Bytes, s)
go s
st' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                        Maybe s
_        ->
                            let !len1 :: Int
len1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off
                                !len2 :: Int
len2 = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off
                            in (Bytes, Bytes, s) -> Either s (Bytes, Bytes, s)
forall a b. b -> Either a b
Right (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
off Int
len1, PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
i Int
len2, s
st)
                | Bool
otherwise = s -> Either s (Bytes, Bytes, s)
forall a b. a -> Either a b
Left s
st
        in s -> Int -> Either s (Bytes, Bytes, s)
go s
s0' Int
off

-- | Similar to 'scan', but working on 'V.Bytes' chunks, The predicate
-- consumes a 'V.Bytes' chunk and transforms a state argument,
-- and each transformed state is passed to successive invocations of
-- the predicate on each chunk of the input until one chunk got splited to
-- @Right (V.Bytes, V.Bytes)@ or the input ends.
--
scanChunks :: s -> (s -> V.Bytes -> Either s (V.Bytes, V.Bytes, s)) -> Parser (V.Bytes, s)
{-# INLINE scanChunks #-}
scanChunks :: s
-> (s -> Bytes -> Either s (Bytes, Bytes, s)) -> Parser (Bytes, s)
scanChunks s
s0 s -> Bytes -> Either s (Bytes, Bytes, s)
consume = (forall r.
 (ParseError -> ParseStep r)
 -> ((Bytes, s) -> ParseStep r) -> ParseStep r)
-> Parser (Bytes, s)
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ (Bytes, s) -> ParseStep r
k Bytes
inp ->
    case s -> Bytes -> Either s (Bytes, Bytes, s)
consume s
s0 Bytes
inp of
        Right (Bytes
want, Bytes
rest, s
s') -> (Bytes, s) -> ParseStep r
k (Bytes
want, s
s') Bytes
rest
        Left s
s' -> ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (s -> ((Bytes, s) -> ParseStep r) -> Bytes -> ParseStep r
forall a.
s
-> ((Bytes, s) -> Bytes -> Result a) -> Bytes -> Bytes -> Result a
scanChunksPartial s
s' (Bytes, s) -> ParseStep r
k Bytes
inp))
  where
    -- we want to inline consume if possible
    {-# INLINABLE scanChunksPartial #-}
    scanChunksPartial :: s
-> ((Bytes, s) -> Bytes -> Result a) -> Bytes -> Bytes -> Result a
scanChunksPartial s
s0' (Bytes, s) -> Bytes -> Result a
k Bytes
inp0 =
        let go :: s -> [Bytes] -> Bytes -> Result a
go s
s [Bytes]
acc = \ Bytes
inp ->
                if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
                then (Bytes, s) -> Bytes -> Result a
k ([Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc), s
s) Bytes
inp
                else case s -> Bytes -> Either s (Bytes, Bytes, s)
consume s
s Bytes
inp of
                        Left s
s' -> do
                            let acc' :: [Bytes]
acc' = Bytes
inp Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
: [Bytes]
acc
                            (Bytes -> Result a) -> Result a
forall a. (Bytes -> Result a) -> Result a
Partial (s -> [Bytes] -> Bytes -> Result a
go s
s' [Bytes]
acc')
                        Right (Bytes
want,Bytes
rest,s
s') ->
                            let !r :: Bytes
r = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse (Bytes
wantBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc)) in (Bytes, s) -> Bytes -> Result a
k (Bytes
r, s
s') Bytes
rest
        in s -> [Bytes] -> Bytes -> Result a
go s
s0' [Bytes
inp0]

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

-- | Match any byte, to perform lookahead. Returns 'Nothing' if end of
-- input has been reached. Does not consume any input.
--
peekMaybe :: Parser (Maybe Word8)
{-# INLINE peekMaybe #-}
peekMaybe :: Parser (Maybe Word8)
peekMaybe =
    (forall r.
 (ParseError -> ParseStep r)
 -> (Maybe Word8 -> ParseStep r) -> ParseStep r)
-> Parser (Maybe Word8)
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r)
  -> (Maybe Word8 -> ParseStep r) -> ParseStep r)
 -> Parser (Maybe Word8))
-> (forall r.
    (ParseError -> ParseStep r)
    -> (Maybe Word8 -> ParseStep r) -> ParseStep r)
-> Parser (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
_ Maybe Word8 -> ParseStep r
k Bytes
inp ->
        if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
        then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (\ Bytes
inp' -> Maybe Word8 -> ParseStep r
k (if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp'
            then Maybe Word8
forall a. Maybe a
Nothing
            else Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp)) Bytes
inp')
        else Maybe Word8 -> ParseStep r
k (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp)) Bytes
inp

-- | Match any byte, to perform lookahead.  Does not consume any
-- input, but will fail if end of input has been reached.
--
peek :: Parser Word8
{-# INLINE peek #-}
peek :: Parser Word8
peek =
    (forall r.
 (ParseError -> ParseStep r)
 -> (Word8 -> ParseStep r) -> ParseStep r)
-> Parser Word8
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r)
  -> (Word8 -> ParseStep r) -> ParseStep r)
 -> Parser Word8)
-> (forall r.
    (ParseError -> ParseStep r)
    -> (Word8 -> ParseStep r) -> ParseStep r)
-> Parser Word8
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
kf Word8 -> ParseStep r
k Bytes
inp ->
        if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
        then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (\ Bytes
inp' ->
            if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp'
            then ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.peek: not enough bytes"] Bytes
inp'
            else Word8 -> ParseStep r
k (Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp') Bytes
inp')
        else Word8 -> ParseStep r
k (Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp) Bytes
inp

-- | The parser @satisfy p@ succeeds for any byte for which the
-- predicate @p@ returns 'True'. Returns the byte that is actually
-- parsed.
--
-- >digit = satisfy isDigit
-- >    where isDigit w = w >= 48 && w <= 57
--
satisfy :: (Word8 -> Bool) -> Parser Word8
{-# INLINE satisfy #-}
satisfy :: (Word8 -> Bool) -> Parser Word8
satisfy Word8 -> Bool
p = do
    Int -> ParseError -> Parser ()
ensureN Int
1 [Text
"Z.Data.Parser.Base.satisfy: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r)
 -> (Word8 -> ParseStep r) -> ParseStep r)
-> Parser Word8
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r)
  -> (Word8 -> ParseStep r) -> ParseStep r)
 -> Parser Word8)
-> (forall r.
    (ParseError -> ParseStep r)
    -> (Word8 -> ParseStep r) -> ParseStep r)
-> Parser Word8
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
kf Word8 -> ParseStep r
k Bytes
inp ->
        let w :: Word8
w = Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp
        in if Word8 -> Bool
p Word8
w
            then Word8 -> ParseStep r
k Word8
w (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp)
            else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.satisfy: unsatisfied byte"] (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp)

-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
-- the predicate @p@ returns 'True' on the transformed value. The
-- parser returns the transformed byte that was parsed.
--
satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
{-# INLINE satisfyWith #-}
satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
satisfyWith Word8 -> a
f a -> Bool
p = do
    Int -> ParseError -> Parser ()
ensureN Int
1 [Text
"Z.Data.Parser.Base.satisfyWith: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
 -> Parser a)
-> (forall r.
    (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
kf a -> ParseStep r
k Bytes
inp ->
        let a :: a
a = Word8 -> a
f (Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp)
        in if a -> Bool
p a
a
            then a -> ParseStep r
k a
a (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp)
            else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.satisfyWith: unsatisfied byte"] (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp)

-- | Match a specific byte.
--
word8 :: Word8 -> Parser ()
{-# INLINE word8 #-}
word8 :: Word8 -> Parser ()
word8 Word8
w' = do
    Int -> ParseError -> Parser ()
ensureN Int
1 [Text
"Z.Data.Parser.Base.word8: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp ->
        let w :: Word8
w = Bytes -> Word8
forall (v :: * -> *) a. Vec v a => v a -> a
V.unsafeHead Bytes
inp
        in if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w'
            then () -> ParseStep r
k () (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp)
            else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.word8: mismatch byte"] Bytes
inp)

-- | Match a specific 8bit char.
--
char8 :: Char -> Parser ()
{-# INLINE char8 #-}
char8 :: Char -> Parser ()
char8 = Word8 -> Parser ()
word8 (Word8 -> Parser ()) -> (Char -> Word8) -> Char -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
V.c2w


-- | Match either a single newline byte @\'\\n\'@, or a carriage
-- return followed by a newline byte @\"\\r\\n\"@.
endOfLine :: Parser ()
{-# INLINE endOfLine #-}
endOfLine :: Parser ()
endOfLine = do
    Word8
w <- Parser Word8
forall a. UnalignedAccess a => Parser a
decodePrim :: Parser Word8
    case Word8
w of
        Word8
10 -> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Word8
13 -> Word8 -> Parser ()
word8 Word8
10
        Word8
_  -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Z.Data.Parser.Base.endOfLine: mismatch byte"

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

-- | 'skip' N bytes.
--
skip :: Int -> Parser ()
{-# INLINE skip #-}
skip :: Int -> Parser ()
skip Int
n =
    (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp ->
        let l :: Int
l = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
inp
            !n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0
        in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n'
            then () -> ParseStep r
k () ParseStep r -> ParseStep r
forall a b. (a -> b) -> a -> b
$! Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeDrop Int
n' Bytes
inp
            else ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (Int
-> (ParseError -> ParseStep r)
-> (() -> ParseStep r)
-> ParseStep r
forall r.
Int
-> (ParseError -> ParseStep r)
-> (() -> ParseStep r)
-> ParseStep r
skipPartial (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l) ParseError -> ParseStep r
kf () -> ParseStep r
k))

skipPartial :: Int -> (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r
{-# INLINABLE skipPartial #-}
skipPartial :: Int
-> (ParseError -> ParseStep r)
-> (() -> ParseStep r)
-> ParseStep r
skipPartial Int
n ParseError -> ParseStep r
kf () -> ParseStep r
k =
    let go :: Int -> ParseStep r
go !Int
n' = \ Bytes
inp ->
            let l :: Int
l = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
inp
            in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n'
                then () -> ParseStep r
k () ParseStep r -> ParseStep r
forall a b. (a -> b) -> a -> b
$! Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeDrop Int
n' Bytes
inp
                else if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    then ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.skip: not enough bytes"] Bytes
inp
                    else ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (Int -> ParseStep r
go (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l))
    in Int -> ParseStep r
go Int
n

-- | Skip a byte.
--
skipWord8 :: Parser ()
{-# INLINE skipWord8 #-}
skipWord8 :: Parser ()
skipWord8 =
    (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser ((forall r.
  (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
 -> Parser ())
-> (forall r.
    (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp ->
        if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
        then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial (\ Bytes
inp' ->
            if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp'
            then ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.skipWord8: not enough bytes"] Bytes
inp'
            else () -> ParseStep r
k () (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp'))
        else () -> ParseStep r
k () (Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeTail Bytes
inp)

-- | Skip past input for as long as the predicate returns 'True'.
--
skipWhile :: (Word8 -> Bool) -> Parser ()
{-# INLINE skipWhile #-}
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile Word8 -> Bool
p =
    (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ () -> ParseStep r
k Bytes
inp ->
        let rest :: Bytes
rest = (Word8 -> Bool) -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> v a
V.dropWhile Word8 -> Bool
p Bytes
inp
        in if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest
            then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial ((() -> ParseStep r) -> ParseStep r
forall a. (() -> Bytes -> Result a) -> Bytes -> Result a
skipWhilePartial () -> ParseStep r
k)
            else () -> ParseStep r
k () Bytes
rest)
  where
    -- we want to inline p if possible
    {-# INLINABLE skipWhilePartial #-}
    skipWhilePartial :: (() -> Bytes -> Result a) -> Bytes -> Result a
skipWhilePartial () -> Bytes -> Result a
k =
        let go :: Bytes -> Result a
go = \ Bytes
inp ->
                if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
                then () -> Bytes -> Result a
k () Bytes
inp
                else
                    let !rest :: Bytes
rest = (Word8 -> Bool) -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> v a
V.dropWhile Word8 -> Bool
p Bytes
inp
                    in if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest then (Bytes -> Result a) -> Result a
forall a. (Bytes -> Result a) -> Result a
Partial Bytes -> Result a
go else () -> Bytes -> Result a
k () Bytes
rest
        in Bytes -> Result a
go

-- | Skip over white space using 'isSpace'.
--
skipSpaces :: Parser ()
{-# INLINE skipSpaces #-}
skipSpaces :: Parser ()
skipSpaces = (Word8 -> Bool) -> Parser ()
skipWhile Word8 -> Bool
isSpace

-- | @isSpace w = w == 32 || w - 9 <= 4 || w == 0xA0@
isSpace :: Word8 -> Bool
{-# INLINE isSpace #-}
isSpace :: Word8 -> Bool
isSpace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
9 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
4 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xA0

take :: Int -> Parser V.Bytes
{-# INLINE take #-}
take :: Int -> Parser Bytes
take Int
n = do
    -- we use unsafe slice, guard negative n here
    Int -> ParseError -> Parser ()
ensureN Int
n' [Text
"Z.Data.Parser.Base.take: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r)
 -> (Bytes -> ParseStep r) -> ParseStep r)
-> Parser Bytes
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ Bytes -> ParseStep r
k Bytes
inp ->
        let !r :: Bytes
r = Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeTake Int
n' Bytes
inp
            !inp' :: Bytes
inp' = Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeDrop Int
n' Bytes
inp
        in Bytes -> ParseStep r
k Bytes
r Bytes
inp')
  where !n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n

-- | Consume input as long as the predicate returns 'False' or reach the end of input,
-- and return the consumed input.
--
takeTill :: (Word8 -> Bool) -> Parser V.Bytes
{-# INLINE takeTill #-}
takeTill :: (Word8 -> Bool) -> Parser Bytes
takeTill Word8 -> Bool
p = (forall r.
 (ParseError -> ParseStep r)
 -> (Bytes -> ParseStep r) -> ParseStep r)
-> Parser Bytes
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ Bytes -> ParseStep r
k Bytes
inp ->
    let (Bytes
want, Bytes
rest) = (Word8 -> Bool) -> Bytes -> (Bytes, Bytes)
forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> (v a, v a)
V.break Word8 -> Bool
p Bytes
inp
    in if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest
        then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial ((Bytes -> ParseStep r) -> Bytes -> ParseStep r
forall a.
(Bytes -> Bytes -> Result a) -> Bytes -> Bytes -> Result a
takeTillPartial Bytes -> ParseStep r
k Bytes
want)
        else Bytes -> ParseStep r
k Bytes
want Bytes
rest)
  where
    {-# INLINABLE takeTillPartial #-}
    takeTillPartial :: (Bytes -> Bytes -> Result a) -> Bytes -> Bytes -> Result a
takeTillPartial Bytes -> Bytes -> Result a
k Bytes
want =
        let go :: [Bytes] -> Bytes -> Result a
go [Bytes]
acc = \ Bytes
inp ->
                if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
                then let !r :: Bytes
r = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc) in Bytes -> Bytes -> Result a
k Bytes
r Bytes
inp
                else
                    let (Bytes
want', Bytes
rest) = (Word8 -> Bool) -> Bytes -> (Bytes, Bytes)
forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> (v a, v a)
V.break Word8 -> Bool
p Bytes
inp
                        acc' :: [Bytes]
acc' = Bytes
want' Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
: [Bytes]
acc
                    in if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest
                        then (Bytes -> Result a) -> Result a
forall a. (Bytes -> Result a) -> Result a
Partial ([Bytes] -> Bytes -> Result a
go [Bytes]
acc')
                        else let !r :: Bytes
r = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc') in Bytes -> Bytes -> Result a
k Bytes
r Bytes
rest
        in [Bytes] -> Bytes -> Result a
go [Bytes
want]

-- | Consume input as long as the predicate returns 'True' or reach the end of input,
-- and return the consumed input.
--
takeWhile :: (Word8 -> Bool) -> Parser V.Bytes
{-# INLINE takeWhile #-}
takeWhile :: (Word8 -> Bool) -> Parser Bytes
takeWhile Word8 -> Bool
p = (forall r.
 (ParseError -> ParseStep r)
 -> (Bytes -> ParseStep r) -> ParseStep r)
-> Parser Bytes
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
_ Bytes -> ParseStep r
k Bytes
inp ->
    let (Bytes
want, Bytes
rest) = (Word8 -> Bool) -> Bytes -> (Bytes, Bytes)
forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> (v a, v a)
V.span Word8 -> Bool
p Bytes
inp
    in if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest
        then ParseStep r -> Result r
forall a. (Bytes -> Result a) -> Result a
Partial ((Bytes -> ParseStep r) -> Bytes -> ParseStep r
forall a.
(Bytes -> Bytes -> Result a) -> Bytes -> Bytes -> Result a
takeWhilePartial Bytes -> ParseStep r
k Bytes
want)
        else Bytes -> ParseStep r
k Bytes
want Bytes
rest)
  where
    -- we want to inline p if possible
    {-# INLINABLE takeWhilePartial #-}
    takeWhilePartial :: (Bytes -> Bytes -> Result a) -> Bytes -> Bytes -> Result a
takeWhilePartial Bytes -> Bytes -> Result a
k Bytes
want =
        let go :: [Bytes] -> Bytes -> Result a
go [Bytes]
acc = \ Bytes
inp ->
                if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
inp
                then let !r :: Bytes
r = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc) in Bytes -> Bytes -> Result a
k Bytes
r Bytes
inp
                else
                    let (Bytes
want', Bytes
rest) = (Word8 -> Bool) -> Bytes -> (Bytes, Bytes)
forall (v :: * -> *) a. Vec v a => (a -> Bool) -> v a -> (v a, v a)
V.span Word8 -> Bool
p Bytes
inp
                        acc' :: [Bytes]
acc' = Bytes
want' Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
: [Bytes]
acc
                    in if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest
                        then (Bytes -> Result a) -> Result a
forall a. (Bytes -> Result a) -> Result a
Partial ([Bytes] -> Bytes -> Result a
go [Bytes]
acc')
                        else let !r :: Bytes
r = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
acc') in Bytes -> Bytes -> Result a
k Bytes
r Bytes
rest
        in [Bytes] -> Bytes -> Result a
go [Bytes
want]

-- | Similar to 'takeWhile', but requires the predicate to succeed on at least one byte
-- of input: it will fail if the predicate never returns 'True' or reach the end of input
--
takeWhile1 :: (Word8 -> Bool) -> Parser V.Bytes
{-# INLINE takeWhile1 #-}
takeWhile1 :: (Word8 -> Bool) -> Parser Bytes
takeWhile1 Word8 -> Bool
p = do
    Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
takeWhile Word8 -> Bool
p
    if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
bs
    then String -> Parser Bytes
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Z.Data.Parser.Base.takeWhile1: no satisfied byte"
    else Bytes -> Parser Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bs

-- | @bytes s@ parses a sequence of bytes that identically match @s@.
--
bytes :: V.Bytes -> Parser ()
{-# INLINE bytes #-}
bytes :: Bytes -> Parser ()
bytes Bytes
bs = do
    let n :: Int
n = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs
    Int -> ParseError -> Parser ()
ensureN Int
n [Text
"Z.Data.Parser.Base.bytes: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp ->
        if Bytes
bs Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeTake Int
n Bytes
inp
        then () -> ParseStep r
k () ParseStep r -> ParseStep r
forall a b. (a -> b) -> a -> b
$! Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeDrop Int
n Bytes
inp
        else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.bytes: mismatch bytes"] Bytes
inp)


-- | Same as 'bytes' but ignoring case.
bytesCI :: V.Bytes -> Parser ()
{-# INLINE bytesCI #-}
bytesCI :: Bytes -> Parser ()
bytesCI Bytes
bs = do
    let n :: Int
n = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs
    -- casefold an ASCII string should not change it's length
    Int -> ParseError -> Parser ()
ensureN Int
n [Text
"Z.Data.Parser.Base.bytesCI: not enough bytes"]
    (forall r.
 (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r)
-> Parser ()
forall a.
(forall r.
 (ParseError -> ParseStep r) -> (a -> ParseStep r) -> ParseStep r)
-> Parser a
Parser (\ ParseError -> ParseStep r
kf () -> ParseStep r
k Bytes
inp ->
        if Bytes
bs' Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes -> Bytes
forall s. FoldCase s => s -> s
CI.foldCase (Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeTake Int
n Bytes
inp)
        then () -> ParseStep r
k () ParseStep r -> ParseStep r
forall a b. (a -> b) -> a -> b
$! Int -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => Int -> v a -> v a
V.unsafeDrop Int
n Bytes
inp
        else ParseError -> ParseStep r
kf [Text
"Z.Data.Parser.Base.bytesCI: mismatch bytes"] Bytes
inp)
  where
    bs' :: Bytes
bs' = Bytes -> Bytes
forall s. FoldCase s => s -> s
CI.foldCase Bytes
bs

-- | @text s@ parses a sequence of UTF8 bytes that identically match @s@.
--
text :: T.Text -> Parser ()
{-# INLINE text #-}
text :: Text -> Parser ()
text (T.Text Bytes
bs) = Bytes -> Parser ()
bytes Bytes
bs