-- |
-- Module      :  Data.ByteString.Parser
-- License     :  CC0-1.0
--
-- Maintainer  :  mordae@anilinux.org
-- Stability   :  unstable
-- Portability :  non-portable (ghc)
--
-- This module provides a parser for 'ByteString'.
--
--   * If you\'d like to parse ASCII text, you might want to take a look at
--     "Data.ByteString.Parser.Char8". It reuses the same 'Parser', but
--     provides functions working with 'Char' instead of 'Word8' as well as
--     more string utilities.
--
--   * If you\'d like to parse Unicode text, look instead at the
--     "Data.Text.Parser". Is is slower, but in a way more correct.
--

module Data.ByteString.Parser
  ( Parser(..)
  , Result(..)
  , parseOnly

    -- * Bytes
  , byte
  , notByte
  , anyByte
  , satisfy
  , peekByte

    -- * Strings
  , string
  , Data.ByteString.Parser.take
  , scan
  , runScanner
  , Data.ByteString.Parser.takeWhile
  , takeWhile1
  , takeTill
  , takeTill1

    -- * Combinators
  , provided
  , choice
  , branch
  , Snack.Combinators.count
  , optional
  , eitherP
  , option
  , many
  , many1
  , manyTill
  , sepBy
  , sepBy1
  , wrap
  , match
  , label
  , unlabel
  , validate

    -- * End Of Input
  , takeByteString
  , peekByteString
  , endOfInput
  , atEnd

    -- * Position
  , offset

    -- * Miscelaneous
    -- |
    -- These are all generic methods, but since I sometimes forget about them,
    -- it is nice to have them listed here for reference what writing parsers.
  , Control.Applicative.empty
  , pure
  , guard
  , when
  , unless
  , void
  )
where
  import Prelude hiding (null, length, splitAt, take)

  import Control.Applicative
  import Control.Monad

  import Data.List qualified as List
  import Data.Maybe
  import Data.Word

  import Data.ByteString as BS
  import Data.ByteString.Unsafe as BS

  import Snack.Combinators


  -- |
  -- Result represents either success or some kind of failure.
  --
  -- You can find the problematic offset by subtracting length of the
  -- remainder from length of the original input.
  --
  data Result a
    = Success a {-# UNPACK #-} !ByteString
      -- ^ Parser successfully matched the input.
      --   Produces the parsing result and the remainder of the input.

    | Failure [String] {-# UNPACK #-} !ByteString
      -- ^ Parser failed to match the input.
      --   Produces list of expected inputs and the corresponding remainder.

    | Error String {-# UNPACK #-} !ByteString {-# UNPACK #-} !Int
      -- ^ Parser ran into an error. Either syntactic or a validation one.

    deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show)

  instance Functor Result where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Result a -> Result b
fmap a -> b
fn (Success a
res ByteString
more) = b -> ByteString -> Result b
forall a. a -> ByteString -> Result a
Success (a -> b
fn a
res) ByteString
more
    fmap a -> b
_  (Failure [String]
expected ByteString
more) = [String] -> ByteString -> Result b
forall a. [String] -> ByteString -> Result a
Failure [String]
expected ByteString
more
    fmap a -> b
_  (Error String
reason ByteString
more Int
len) = String -> ByteString -> Int -> Result b
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len


  -- |
  -- Parser for 'ByteString' inputs.
  --
  newtype Parser a =
    Parser
      { Parser a -> ByteString -> Result a
runParser :: ByteString -> Result a
        -- ^ Run the parser on specified input.
      }

  instance Functor Parser where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
fn Parser{ByteString -> Result a
runParser :: ByteString -> Result a
runParser :: forall a. Parser a -> ByteString -> Result a
runParser} = (ByteString -> Result b) -> Parser b
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
      (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (ByteString -> Result a
runParser ByteString
inp)

  instance Applicative Parser where
    {-# INLINE pure #-}
    pure :: a -> Parser a
pure a
x = (ByteString -> Result a) -> Parser a
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> a -> ByteString -> Result a
forall a. a -> ByteString -> Result a
Success a
x ByteString
inp

    {-# INLINE (<*>) #-}
    (Parser ByteString -> Result (a -> b)
runFn) <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> (Parser ByteString -> Result a
runArg) = (ByteString -> Result b) -> Parser b
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
      case ByteString -> Result (a -> b)
runFn ByteString
inp of
        Error String
reason ByteString
more Int
len -> String -> ByteString -> Int -> Result b
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len
        Failure [String]
expected ByteString
more -> [String] -> ByteString -> Result b
forall a. [String] -> ByteString -> Result a
Failure [String]
expected ByteString
more
        Success a -> b
fn ByteString
rest -> (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (ByteString -> Result a
runArg ByteString
rest)

  instance Alternative Parser where
    {-# INLINE empty #-}
    empty :: Parser a
empty = (ByteString -> Result a) -> Parser a
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> [String] -> ByteString -> Result a
forall a. [String] -> ByteString -> Result a
Failure [] ByteString
inp

    -- |
    -- Tries the right branch only if the left brach produces Failure.
    -- Does not mask Error.
    --
    {-# INLINE (<|>) #-}
    (Parser ByteString -> Result a
runLeft) <|> :: Parser a -> Parser a -> Parser a
<|> (Parser ByteString -> Result a
runRight) = (ByteString -> Result a) -> Parser a
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
      case ByteString -> Result a
runLeft ByteString
inp of
        Success a
res ByteString
more -> a -> ByteString -> Result a
forall a. a -> ByteString -> Result a
Success a
res ByteString
more
        Error String
reason ByteString
more Int
len -> String -> ByteString -> Int -> Result a
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len
        Failure [String]
expected ByteString
more ->
          case ByteString -> Result a
runRight ByteString
inp of
            Success a
res' ByteString
more' -> a -> ByteString -> Result a
forall a. a -> ByteString -> Result a
Success a
res' ByteString
more'
            Error String
reason' ByteString
more' Int
len' -> String -> ByteString -> Int -> Result a
forall a. String -> ByteString -> Int -> Result a
Error String
reason' ByteString
more' Int
len'
            Failure [String]
expected' ByteString
more' ->
              -- Longer match (shorter remainder) wins.
              case ByteString -> Int
length ByteString
more Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ByteString -> Int
length ByteString
more' of
                Ordering
LT -> [String] -> ByteString -> Result a
forall a. [String] -> ByteString -> Result a
Failure [String]
expected ByteString
more
                Ordering
EQ -> [String] -> ByteString -> Result a
forall a. [String] -> ByteString -> Result a
Failure ([String]
expected [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
expected') ByteString
more
                Ordering
GT -> [String] -> ByteString -> Result a
forall a. [String] -> ByteString -> Result a
Failure [String]
expected' ByteString
more'

  instance Monad Parser where
    {-# INLINE (>>=) #-}
    (Parser ByteString -> Result a
runLeft) >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
right = (ByteString -> Result b) -> Parser b
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
      case ByteString -> Result a
runLeft ByteString
inp of
        Error String
reason ByteString
more Int
len -> String -> ByteString -> Int -> Result b
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len
        Failure [String]
expected ByteString
more -> [String] -> ByteString -> Result b
forall a. [String] -> ByteString -> Result a
Failure [String]
expected ByteString
more
        Success a
res ByteString
more -> Parser b -> ByteString -> Result b
forall a. Parser a -> ByteString -> Result a
runParser (a -> Parser b
right a
res) ByteString
more

  instance MonadPlus Parser

  instance MonadFail Parser where
    -- |
    -- Fail the whole parser with given reason.
    --
    -- If you want the best error report possible, fail at the end of a
    -- relevant 'extent'.
    --
    -- For example, if you are parsing a mapping that is syntactically valid,
    -- but does not contain some mandatory keys, fail after parsing the whole
    -- mapping and make sure that the maaping parser and the 'fail' call are
    -- enclosed in an 'extent'.
    --
    -- That way, the error will indicate the extent remainder and length.
    --
    {-# INLINE CONLIKE fail #-}
    fail :: String -> Parser a
fail String
reason = (ByteString -> Result a) -> Parser a
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> String -> ByteString -> Int -> Result a
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
inp Int
0


  -- |
  -- Accepts a single, matching byte.
  --
  {-# INLINE CONLIKE byte #-}
  byte :: Word8 -> Parser Word8
  byte :: Word8 -> Parser Word8
byte Word8
c = (Word8 -> Bool) -> Parser Word8
satisfy (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==)


  -- |
  -- Accepts a single, differing byte.
  --
  {-# INLINE CONLIKE notByte #-}
  notByte :: Word8 -> Parser Word8
  notByte :: Word8 -> Parser Word8
notByte Word8
c = (Word8 -> Bool) -> Parser Word8
satisfy (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=)


  -- |
  -- Discards the remaining input and returns just the parse result.
  -- You might want to combine it with 'endOfInput' for the best effect.
  --
  -- Example:
  --
  -- @
  -- parseOnly (pContacts \<* endOfInput) bstr
  -- @
  --
  {-# INLINE CONLIKE parseOnly #-}
  parseOnly :: Parser a -> ByteString -> Either String a
  parseOnly :: Parser a -> ByteString -> Either String a
parseOnly Parser a
par = \ByteString
inp ->
    case Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
runParser Parser a
par ByteString
inp of
      Success a
res ByteString
_ -> a -> Either String a
forall a b. b -> Either a b
Right a
res
      Error String
reason ByteString
_ Int
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
reason
      Failure [String]
expected ByteString
_ ->
        case [String]
expected of
          [] -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected input."
          [String]
ex -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
ex String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."


  -- |
  -- Accepts a single byte.
  --
  {-# INLINE anyByte #-}
  anyByte :: Parser Word8
  anyByte :: Parser Word8
anyByte = (ByteString -> Result Word8) -> Parser Word8
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    if ByteString -> Bool
null ByteString
inp
       then [String] -> ByteString -> Result Word8
forall a. [String] -> ByteString -> Result a
Failure [String
"any byte"] ByteString
inp
       else Word8 -> ByteString -> Result Word8
forall a. a -> ByteString -> Result a
Success (ByteString -> Word8
unsafeHead ByteString
inp) (ByteString -> ByteString
unsafeTail ByteString
inp)


  -- |
  -- Accepts a single byte matching the predicate.
  --
  {-# INLINE CONLIKE satisfy #-}
  satisfy :: (Word8 -> Bool) -> Parser Word8
  satisfy :: (Word8 -> Bool) -> Parser Word8
satisfy Word8 -> Bool
isOk = (ByteString -> Result Word8) -> Parser Word8
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    if ByteString -> Bool
null ByteString
inp
       then [String] -> ByteString -> Result Word8
forall a. [String] -> ByteString -> Result a
Failure [String
"more input"] ByteString
inp
       else let c :: Word8
c = ByteString -> Word8
unsafeHead ByteString
inp
             in if Word8 -> Bool
isOk Word8
c
                   then Word8 -> ByteString -> Result Word8
forall a. a -> ByteString -> Result a
Success Word8
c (ByteString -> ByteString
unsafeTail ByteString
inp)
                   else [String] -> ByteString -> Result Word8
forall a. [String] -> ByteString -> Result a
Failure [] ByteString
inp


  -- |
  -- Peeks ahead, but does not consume.
  --
  -- Be careful, peeking behind end of the input fails.
  -- You might want to check using 'atEnd' beforehand.
  --
  {-# INLINE peekByte #-}
  peekByte :: Parser Word8
  peekByte :: Parser Word8
peekByte = (ByteString -> Result Word8) -> Parser Word8
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    if ByteString -> Bool
null ByteString
inp
       then [String] -> ByteString -> Result Word8
forall a. [String] -> ByteString -> Result a
Failure [String
"more input"] ByteString
inp
       else Word8 -> ByteString -> Result Word8
forall a. a -> ByteString -> Result a
Success (ByteString -> Word8
unsafeHead ByteString
inp) ByteString
inp


  -- |
  -- Accepts a matching string.
  --
  {-# INLINE CONLIKE string #-}
  string :: ByteString -> Parser ByteString
  string :: ByteString -> Parser ByteString
string ByteString
str = (ByteString -> Result ByteString) -> Parser ByteString
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    let (ByteString
pfx, ByteString
sfx) = Int -> ByteString -> (ByteString, ByteString)
splitAt (ByteString -> Int
length ByteString
str) ByteString
inp
     in case ByteString
pfx ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
str of
          Bool
True -> ByteString -> ByteString -> Result ByteString
forall a. a -> ByteString -> Result a
Success ByteString
pfx ByteString
sfx
          Bool
False -> [String] -> ByteString -> Result ByteString
forall a. [String] -> ByteString -> Result a
Failure [ByteString -> String
forall a. Show a => a -> String
show ByteString
str] ByteString
inp


  -- |
  -- Accepts given number of bytes.
  -- Fails when not enough bytes are available.
  --
  {-# INLINE CONLIKE take #-}
  take :: Int -> Parser ByteString
  take :: Int -> Parser ByteString
take Int
n = (ByteString -> Result ByteString) -> Parser ByteString
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
length ByteString
inp
       then [String] -> ByteString -> Result ByteString
forall a. [String] -> ByteString -> Result a
Failure [Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" more bytes"] ByteString
inp
       else ByteString -> ByteString -> Result ByteString
forall a. a -> ByteString -> Result a
Success (Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
inp) (Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
inp)


  -- |
  -- Scans ahead statefully and then accepts whatever bytes the scanner liked.
  -- Scanner returns 'Nothing' to mark end of the acceptable extent.
  --
  {-# INLINE CONLIKE scan #-}
  scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
  scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
scan s
state s -> Word8 -> Maybe s
scanner = (ByteString, s) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, s) -> ByteString)
-> Parser (ByteString, s) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
forall s. s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
runScanner s
state s -> Word8 -> Maybe s
scanner


  -- |
  -- Like 'scan', but also returns the final scanner state.
  --
  {-# INLINE CONLIKE runScanner #-}
  runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
  runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
runScanner s
state s -> Word8 -> Maybe s
scanner = (ByteString -> Result (ByteString, s)) -> Parser (ByteString, s)
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    let (s
state', Int
n) = s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)
forall s.
s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)
scanBytes s
state s -> Word8 -> Maybe s
scanner Int
0 (ByteString -> [Word8]
unpack ByteString
inp)
        (ByteString
res, ByteString
more) = Int -> ByteString -> (ByteString, ByteString)
splitAt Int
n ByteString
inp
     in (ByteString, s) -> ByteString -> Result (ByteString, s)
forall a. a -> ByteString -> Result a
Success (ByteString
res, s
state') ByteString
more


  {-# INLINE scanBytes #-}
  scanBytes :: s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)
  scanBytes :: s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)
scanBytes !s
state s -> Word8 -> Maybe s
_scanner !Int
n [] = (s
state, Int
n)
  scanBytes !s
state s -> Word8 -> Maybe s
scanner !Int
n (Word8
x:[Word8]
more) =
    case s -> Word8 -> Maybe s
scanner s
state Word8
x of
      Just s
state' -> s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)
forall s.
s -> (s -> Word8 -> Maybe s) -> Int -> [Word8] -> (s, Int)
scanBytes s
state' s -> Word8 -> Maybe s
scanner (Int -> Int
forall a. Enum a => a -> a
succ Int
n) [Word8]
more
      Maybe s
Nothing -> (s
state, Int
n)


  -- |
  -- Efficiently consume as long as the input bytes match the predicate.
  -- An inverse of 'takeTill'.
  --
  {-# INLINE CONLIKE takeWhile #-}
  takeWhile :: (Word8 -> Bool) -> Parser ByteString
  takeWhile :: (Word8 -> Bool) -> Parser ByteString
takeWhile Word8 -> Bool
test = (Word8 -> Bool) -> Parser ByteString
takeTill (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
test)


  -- |
  -- Like 'Data.ByteString.Parser.takeWhile', but requires at least a single byte.
  --
  {-# INLINE CONLIKE takeWhile1 #-}
  takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
  takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
test = (Word8 -> Bool) -> Parser ByteString
Data.ByteString.Parser.takeWhile Word8 -> Bool
test Parser ByteString -> (ByteString -> Bool) -> Parser ByteString
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
m a -> (a -> Bool) -> m a
`provided` (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
null)


  -- |
  -- Efficiently consume until a byte matching the predicate is found.
  -- An inverse of 'Data.ByteString.Parser.takeWhile'.
  --
  {-# INLINE CONLIKE takeTill #-}
  takeTill :: (Word8 -> Bool) -> Parser ByteString
  takeTill :: (Word8 -> Bool) -> Parser ByteString
takeTill Word8 -> Bool
test = (ByteString -> Result ByteString) -> Parser ByteString
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    let n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (ByteString -> Int
length ByteString
inp) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex Word8 -> Bool
test ByteString
inp
     in ByteString -> ByteString -> Result ByteString
forall a. a -> ByteString -> Result a
Success (Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
inp) (Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
inp)


  -- |
  -- Same as 'takeTill', but requires at least a single byte.
  --
  {-# INLINE CONLIKE takeTill1 #-}
  takeTill1 :: (Word8 -> Bool) -> Parser ByteString
  takeTill1 :: (Word8 -> Bool) -> Parser ByteString
takeTill1 Word8 -> Bool
test = (Word8 -> Bool) -> Parser ByteString
Data.ByteString.Parser.takeTill Word8 -> Bool
test Parser ByteString -> (ByteString -> Bool) -> Parser ByteString
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
m a -> (a -> Bool) -> m a
`provided` (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
null)


  -- |
  -- Makes the parser not only return the result, but also the original
  -- matched extent.
  --
  {-# INLINE CONLIKE match #-}
  match :: Parser a -> Parser (ByteString, a)
  match :: Parser a -> Parser (ByteString, a)
match Parser a
par = (ByteString -> Result (ByteString, a)) -> Parser (ByteString, a)
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    case Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
runParser Parser a
par ByteString
inp of
      Failure [String]
expected ByteString
more -> [String] -> ByteString -> Result (ByteString, a)
forall a. [String] -> ByteString -> Result a
Failure [String]
expected ByteString
more
      Error String
reason ByteString
more Int
len -> String -> ByteString -> Int -> Result (ByteString, a)
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len
      Success a
res ByteString
more ->
        let n :: Int
n = ByteString -> Int
length ByteString
more
         in (ByteString, a) -> ByteString -> Result (ByteString, a)
forall a. a -> ByteString -> Result a
Success (Int -> ByteString -> ByteString
BS.take Int
n ByteString
inp, a
res) ByteString
more


  -- |
  -- Names an extent of the parser.
  --
  -- When the extent returns a Failure, details are discarded and replaced
  -- with the extent as a whole.
  --
  -- When the extent returns an Error, it is adjusted to cover the whole
  -- extent, but the reason is left intact.
  --
  -- You should strive to make labeled extents as small as possible,
  -- approximately of a typical token size. For example:
  --
  -- @
  -- pString = label \"string\" $ pStringContents \`wrap\` char \'\"\'
  -- @
  --
  {-# INLINE CONLIKE label #-}
  label :: String -> Parser a -> Parser a
  label :: String -> Parser a -> Parser a
label String
lbl Parser a
par = (ByteString -> Result a) -> Parser a
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    case Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
runParser Parser a
par ByteString
inp of
      Success a
res ByteString
more -> a -> ByteString -> Result a
forall a. a -> ByteString -> Result a
Success a
res ByteString
more
      Failure [String]
_expected ByteString
_more -> [String] -> ByteString -> Result a
forall a. [String] -> ByteString -> Result a
Failure [String
lbl] ByteString
inp
      Error String
reason ByteString
more Int
len ->
        let len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (ByteString -> Int
length ByteString
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
length ByteString
more)
         in String -> ByteString -> Int -> Result a
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
inp Int
len'


  -- |
  -- Un-names an extent of the parser.
  --
  -- Same as 'label', but removes any expected values upon Failure.
  -- Very useful to mark comments and optional whitespace with.
  --
  {-# INLINE CONLIKE unlabel #-}
  unlabel :: Parser a -> Parser a
  unlabel :: Parser a -> Parser a
unlabel Parser a
par = (ByteString -> Result a) -> Parser a
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    case Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
runParser Parser a
par ByteString
inp of
      Success a
res ByteString
more -> a -> ByteString -> Result a
forall a. a -> ByteString -> Result a
Success a
res ByteString
more
      Failure [String]
_expected ByteString
_more -> [String] -> ByteString -> Result a
forall a. [String] -> ByteString -> Result a
Failure [] ByteString
inp
      Error String
reason ByteString
more Int
len ->
        let len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (ByteString -> Int
length ByteString
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
length ByteString
more)
         in String -> ByteString -> Int -> Result a
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
inp Int
len'


  -- |
  -- Validate parser result and turn it into an Error upon failure.
  --
  {-# INLINE CONLIKE validate #-}
  validate :: (a -> Either String b) -> Parser a -> Parser b
  validate :: (a -> Either String b) -> Parser a -> Parser b
validate a -> Either String b
test Parser a
par = (ByteString -> Result b) -> Parser b
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
    case Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
runParser Parser a
par ByteString
inp of
      Failure [String]
expected ByteString
more -> [String] -> ByteString -> Result b
forall a. [String] -> ByteString -> Result a
Failure [String]
expected ByteString
more
      Error String
reason ByteString
more Int
len -> String -> ByteString -> Int -> Result b
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len
      Success a
res ByteString
more ->
        case a -> Either String b
test a
res of
          Right b
res' -> b -> ByteString -> Result b
forall a. a -> ByteString -> Result a
Success b
res' ByteString
more
          Left String
reason -> String -> ByteString -> Int -> Result b
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
inp (ByteString -> Int
length ByteString
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
length ByteString
more)


  -- |
  -- Given list of matchers and parsers, runs the first parser whose matcher
  -- succeeds on the input. This pattern makes for a simpler alternative to
  -- @try@ used in other parser combinator libraries.
  --
  -- Example:
  --
  -- @
  -- pProperty = branch [ ( string "public" <* skipSpace
  --                      , \_ -> Property Public <$> pToken
  --                      )
  --                    , ( string "private" <* skipSpace
  --                      , \_ -> Property Private <$> pToken
  --                      )
  --                    ]
  -- @
  --
  {-# INLINE CONLIKE branch #-}
  branch :: [(Parser a, a -> Parser b)] -> Parser b
  branch :: [(Parser a, a -> Parser b)] -> Parser b
branch [] = (ByteString -> Result b) -> Parser b
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> [String] -> ByteString -> Result b
forall a. [String] -> ByteString -> Result a
Failure [] ByteString
inp
  branch ((Parser ByteString -> Result a
test, a -> Parser b
finish) : [(Parser a, a -> Parser b)]
alts) =
    (ByteString -> Result b) -> Parser b
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp ->
      case ByteString -> Result a
test ByteString
inp of
        Success a
res ByteString
more -> Parser b -> ByteString -> Result b
forall a. Parser a -> ByteString -> Result a
runParser (a -> Parser b
finish a
res) ByteString
more
        Error String
reason ByteString
more Int
len -> String -> ByteString -> Int -> Result b
forall a. String -> ByteString -> Int -> Result a
Error String
reason ByteString
more Int
len
        Failure [String]
_expected ByteString
_more -> Parser b -> ByteString -> Result b
forall a. Parser a -> ByteString -> Result a
runParser ([(Parser a, a -> Parser b)] -> Parser b
forall a b. [(Parser a, a -> Parser b)] -> Parser b
branch [(Parser a, a -> Parser b)]
alts) ByteString
inp


  -- |
  -- Accept whatever input remains.
  --
  {-# INLINE takeByteString #-}
  takeByteString :: Parser ByteString
  takeByteString :: Parser ByteString
takeByteString = (ByteString -> Result ByteString) -> Parser ByteString
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> ByteString -> ByteString -> Result ByteString
forall a. a -> ByteString -> Result a
Success ByteString
inp ByteString
forall a. Monoid a => a
mempty


  -- |
  -- Peek at whatever input remains.
  --
  {-# INLINE peekByteString #-}
  peekByteString :: Parser ByteString
  peekByteString :: Parser ByteString
peekByteString = (ByteString -> Result ByteString) -> Parser ByteString
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> ByteString -> ByteString -> Result ByteString
forall a. a -> ByteString -> Result a
Success ByteString
inp ByteString
inp


  -- |
  -- Accepts end of input and fails if we are not there yet.
  --
  {-# INLINE endOfInput #-}
  endOfInput :: Parser ()
  endOfInput :: Parser ()
endOfInput = (ByteString -> Result ()) -> Parser ()
forall a. (ByteString -> Result a) -> Parser a
Parser \case
    ByteString
inp | ByteString -> Bool
null ByteString
inp  -> () -> ByteString -> Result ()
forall a. a -> ByteString -> Result a
Success () ByteString
inp
    ByteString
inp             -> [String] -> ByteString -> Result ()
forall a. [String] -> ByteString -> Result a
Failure [String
"end of input"] ByteString
inp


  -- |
  -- Returns whether we are at the end of the input yet.
  --
  {-# INLINE atEnd #-}
  atEnd :: Parser Bool
  atEnd :: Parser Bool
atEnd = (ByteString -> Result Bool) -> Parser Bool
forall a. (ByteString -> Result a) -> Parser a
Parser \ByteString
inp -> Bool -> ByteString -> Result Bool
forall a. a -> ByteString -> Result a
Success (ByteString -> Bool
null ByteString
inp) ByteString
inp


  -- |
  -- Calculate offset from the original input and the remainder.
  --
  offset :: ByteString -> ByteString -> Int
  offset :: ByteString -> ByteString -> Int
offset ByteString
inp ByteString
more = ByteString -> Int
length ByteString
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
length ByteString
more


-- vim:set ft=haskell sw=2 ts=2 et: