{-# language UnboxedTuples #-}

{-|
This module implements a `Parser` supporting custom error types.  If you need efficient indentation
parsing, use "FlatParse.Stateful" instead.

Many internals are exposed for hacking on and extending. These are generally
denoted by a @#@ hash suffix.
-}

module FlatParse.Basic (

  -- * Parser types and constructors
    type Parser(..)
  , type Res#
  , pattern OK#
  , pattern Fail#
  , pattern Err#
  , Result(..)

  -- * Running parsers
  , runParser
  , runParserS

  -- * Errors and failures
  , empty
  , err
  , lookahead
  , fails
  , try
  , optional
  , optional_
  , withOption
  , cut
  , cutting

  -- * Basic lexing and parsing
  , eof
  , takeBs
  , takeRestBs
  , skip
  , char
  , byte
  , bytes
  , string
  , switch
  , switchWithPost
  , rawSwitchWithPost
  , satisfy
  , satisfy_
  , satisfyASCII
  , satisfyASCII_
  , fusedSatisfy
  , fusedSatisfy_
  , anyWord8
  , anyWord8_
  , anyWord16
  , anyWord16_
  , anyWord32
  , anyWord32_
  , anyWord64
  , anyWord64_
  , anyWord
  , anyWord_
  , anyInt8
  , anyInt16
  , anyInt32
  , anyInt64
  , anyInt
  , anyChar
  , anyChar_
  , anyCharASCII
  , anyCharASCII_
  , FlatParse.Internal.isDigit
  , FlatParse.Internal.isGreekLetter
  , FlatParse.Internal.isLatinLetter
  , FlatParse.Basic.readInt
  , FlatParse.Basic.readInteger
  , anyCString

  -- ** Explicit-endianness machine integers
  , anyWord16le
  , anyWord16be
  , anyWord32le
  , anyWord32be
  , anyWord64le
  , anyWord64be
  , anyInt16le
  , anyInt16be
  , anyInt32le
  , anyInt32be
  , anyInt64le
  , anyInt64be

  -- * Combinators
  , (<|>)
  , branch
  , chainl
  , chainr
  , many
  , many_
  , some
  , some_
  , notFollowedBy
  , isolate

  -- * Positions and spans
  , Pos(..)
  , Span(..)
  , getPos
  , setPos
  , endPos
  , spanOf
  , withSpan
  , byteStringOf
  , withByteString
  , inSpan

  -- ** Position and span conversions
  , validPos
  , posLineCols
  , unsafeSpanToByteString
  , unsafeSlice
  , mkPos
  , FlatParse.Basic.lines

  -- * Getting the rest of the input as a 'String'
  , takeLine
  , traceLine
  , takeRest
  , traceRest

  -- * `String` conversions
  , packUTF8
  , unpackUTF8

  -- * Internal functions
  , ensureBytes#

  -- ** Unboxed arguments
  , takeBs#
  , atSkip#

  -- *** Location & address primitives
  , setBack#
  , withAddr#
  , takeBsOffAddr#
  , lookaheadFromAddr#
  , atAddr#

  -- ** Machine integer continuation parsers
  , withAnyWord8#
  , withAnyWord16#
  , withAnyWord32#
  , withAnyWord64#
  , withAnyInt8#
  , withAnyInt16#
  , withAnyInt32#
  , withAnyInt64#

  -- ** Unsafe
  , anyCStringUnsafe
  , scan8#
  , scan16#
  , scan32#
  , scan64#
  , scanAny8#
  , scanBytes#

  ) where

import Control.Monad
import Data.Foldable
import Data.List (sortBy)
import Data.Map (Map)
import Data.Ord (comparing)
import Data.Word
import GHC.Exts
import GHC.Word
import GHC.Int
import GHC.ForeignPtr
import Language.Haskell.TH
import System.IO.Unsafe

import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Internal as B
import qualified Data.Map.Strict as M

import FlatParse.Internal
import FlatParse.Internal.UnboxedNumerics

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

-- | Primitive result of a parser. Possible results are given by `OK#`, `Err#` and `Fail#`
--   pattern synonyms.
type Res# e a =
  (#
    (# a, Addr# #)
  | (# #)
  | (# e #)
  #)

-- | Contains return value and a pointer to the rest of the input buffer.
pattern OK# :: a -> Addr# -> Res# e a
pattern $bOK# :: a -> Addr# -> Res# e a
$mOK# :: forall r a e. Res# e a -> (a -> Addr# -> r) -> (Void# -> r) -> r
OK# a s = (# (# a, s #) | | #)

-- | Constructor for errors which are by default non-recoverable.
pattern Err# :: e -> Res# e a
pattern $bErr# :: e -> Res# e a
$mErr# :: forall r e a. Res# e a -> (e -> r) -> (Void# -> r) -> r
Err# e = (# | | (# e #) #)

-- | Constructor for recoverable failure.
pattern Fail# :: Res# e a
pattern $bFail# :: Void# -> forall e a. Res# e a
$mFail# :: forall r e a. Res# e a -> (Void# -> r) -> (Void# -> r) -> r
Fail# = (# | (# #) | #)
{-# complete OK#, Err#, Fail# #-}

-- | @Parser e a@ has an error type @e@ and a return type @a@.
newtype Parser e a = Parser {Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# :: ForeignPtrContents -> Addr# -> Addr# -> Res# e a}

instance Functor (Parser e) where
  fmap :: (a -> b) -> Parser e a -> Parser e b
fmap a -> b
f (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s -> let !b :: b
b = a -> b
f a
a in b -> Addr# -> Res# e b
forall a e. a -> Addr# -> Res# e a
OK# b
b Addr#
s
    Res# e a
x       -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
  {-# inline fmap #-}

  <$ :: a -> Parser e b -> Parser e a
(<$) a
a' (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
g) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e b
g ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# b
a Addr#
s -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a' Addr#
s
    Res# e b
x       -> Res# e b -> Res# e a
unsafeCoerce# Res# e b
x
  {-# inline (<$) #-}

instance Applicative (Parser e) where
  pure :: a -> Parser e a
pure a
a = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s
  {-# inline pure #-}
  Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e (a -> b)
ff <*> :: Parser e (a -> b) -> Parser e a -> Parser e b
<*> Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e (a -> b)
ff ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a -> b
f Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
      OK# a
a Addr#
s  -> let !b :: b
b = a -> b
f a
a in b -> Addr# -> Res# e b
forall a e. a -> Addr# -> Res# e a
OK# b
b Addr#
s
      Res# e a
x        -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
    Res# e (a -> b)
x -> Res# e (a -> b) -> Res# e b
unsafeCoerce# Res# e (a -> b)
x
  {-# inline (<*>) #-}
  Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa <* :: Parser e a -> Parser e b -> Parser e a
<* Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s   -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb ForeignPtrContents
fp Addr#
eob Addr#
s of
      OK# b
b Addr#
s -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s
      Res# e b
x -> Res# e b -> Res# e a
unsafeCoerce# Res# e b
x
    Res# e a
x -> Res# e a -> Res# e a
unsafeCoerce# Res# e a
x
  {-# inline (<*) #-}
  Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa *> :: Parser e a -> Parser e b -> Parser e b
*> Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
fb ForeignPtrContents
fp Addr#
eob Addr#
s
    Res# e a
x       -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
  {-# inline (*>) #-}

instance Monad (Parser e) where
  return :: a -> Parser e a
return = a -> Parser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# inline return #-}
  Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa >>= :: Parser e a -> (a -> Parser e b) -> Parser e b
>>= a -> Parser e b
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
fa ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> Parser e b
f a
a) ForeignPtrContents
fp Addr#
eob Addr#
s
    Res# e a
x       -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
  {-# inline (>>=) #-}
  >> :: Parser e a -> Parser e b -> Parser e b
(>>) = Parser e a -> Parser e b -> Parser e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# inline (>>) #-}

-- | Higher-level boxed data type for parsing results.
data Result e a =
    OK a !(B.ByteString)  -- ^ Contains return value and unconsumed input.
  | Fail                  -- ^ Recoverable-by-default failure.
  | Err !e                -- ^ Unrecoverble-by-default error.
  deriving Int -> Result e a -> ShowS
[Result e a] -> ShowS
Result e a -> String
(Int -> Result e a -> ShowS)
-> (Result e a -> String)
-> ([Result e a] -> ShowS)
-> Show (Result e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show a, Show e) => Int -> Result e a -> ShowS
forall e a. (Show a, Show e) => [Result e a] -> ShowS
forall e a. (Show a, Show e) => Result e a -> String
showList :: [Result e a] -> ShowS
$cshowList :: forall e a. (Show a, Show e) => [Result e a] -> ShowS
show :: Result e a -> String
$cshow :: forall e a. (Show a, Show e) => Result e a -> String
showsPrec :: Int -> Result e a -> ShowS
$cshowsPrec :: forall e a. (Show a, Show e) => Int -> Result e a -> ShowS
Show

instance Functor (Result e) where
  fmap :: (a -> b) -> Result e a -> Result e b
fmap a -> b
f (OK a
a ByteString
s) = let !b :: b
b = a -> b
f a
a in b -> ByteString -> Result e b
forall e a. a -> ByteString -> Result e a
OK b
b ByteString
s
  fmap a -> b
f Result e a
r        = Result e a -> Result e b
unsafeCoerce# Result e a
r
  {-# inline fmap #-}
  <$ :: a -> Result e b -> Result e a
(<$) a
a (OK b
_ ByteString
s) = a -> ByteString -> Result e a
forall e a. a -> ByteString -> Result e a
OK a
a ByteString
s
  (<$) a
_ Result e b
r        = Result e b -> Result e a
unsafeCoerce# Result e b
r
  {-# inline (<$) #-}


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

-- | Run a parser.
runParser :: Parser e a -> B.ByteString -> Result e a
runParser :: Parser e a -> ByteString -> Result e a
runParser (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) b :: ByteString
b@(B.PS (ForeignPtr Addr#
_ ForeignPtrContents
fp) Int
_ (I# Int#
len)) = IO (Result e a) -> Result e a
forall a. IO a -> a
unsafeDupablePerformIO do
  ByteString -> (CString -> IO (Result e a)) -> IO (Result e a)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
b \(Ptr Addr#
buf) -> do
    let end :: Addr#
end = Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
len
    case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
end Addr#
buf of
      Err# e
e ->
        Result e a -> IO (Result e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Result e a
forall e a. e -> Result e a
Err e
e)
      OK# a
a Addr#
s -> do
        let offset :: Int#
offset = Addr# -> Addr# -> Int#
minusAddr# Addr#
s Addr#
buf
        Result e a -> IO (Result e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ByteString -> Result e a
forall e a. a -> ByteString -> Result e a
OK a
a (Int -> ByteString -> ByteString
B.drop (Int# -> Int
I# Int#
offset) ByteString
b))
      Res# e a
Fail# ->
        Result e a -> IO (Result e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result e a
forall e a. Result e a
Fail
{-# inlinable runParser #-}

-- | Run a parser on a `String` input. Reminder: @OverloadedStrings@ for `B.ByteString` does not
--   yield a valid UTF-8 encoding! For non-ASCII `B.ByteString` literal input, use `runParserS` or
--   `packUTF8` for testing.
runParserS :: Parser e a -> String -> Result e a
runParserS :: Parser e a -> String -> Result e a
runParserS Parser e a
pa String
s = Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
pa (String -> ByteString
packUTF8 String
s)


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

-- | The failing parser. By default, parser choice `(<|>)` arbitrarily backtracks
--   on parser failure.
empty :: Parser e a
empty :: Parser e a
empty = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Res# e a
forall e a. Res# e a
Fail#
{-# inline empty #-}

-- | Throw a parsing error. By default, parser choice `(<|>)` can't backtrack
--   on parser error. Use `try` to convert an error to a recoverable failure.
err :: e -> Parser e a
err :: e -> Parser e a
err e
e = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
{-# inline err #-}

-- | Save the parsing state, then run a parser, then restore the state.
lookahead :: Parser e a -> Parser e a
lookahead :: Parser e a -> Parser e a
lookahead (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
_ -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s
    Res# e a
x       -> Res# e a
x
{-# inline lookahead #-}

-- | Convert a parsing failure to a success.
fails :: Parser e a -> Parser e ()
fails :: Parser e a -> Parser e ()
fails (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
_ Addr#
_ -> Res# e ()
forall e a. Res# e a
Fail#
    Res# e a
Fail#   -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
    Err# e
e  -> e -> Res# e ()
forall e a. e -> Res# e a
Err# e
e
{-# inline fails #-}

-- | Convert a parsing error into failure.
try :: Parser e a -> Parser e a
try :: Parser e a -> Parser e a
try (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  Err# e
_ -> Res# e a
forall e a. Res# e a
Fail#
  Res# e a
x      -> Res# e a
x
{-# inline try #-}

-- | Convert a parsing failure to a `Maybe`. If possible, use `withOption` instead.
optional :: Parser e a -> Parser e (Maybe a)
optional :: Parser e a -> Parser e (Maybe a)
optional Parser e a
p = (a -> Maybe a
forall k1. k1 -> Maybe k1
Just (a -> Maybe a) -> Parser e a -> Parser e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
p) Parser e (Maybe a) -> Parser e (Maybe a) -> Parser e (Maybe a)
forall e a. Parser e a -> Parser e a -> Parser e a
<|> Maybe a -> Parser e (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall k1. Maybe k1
Nothing
{-# inline optional #-}

-- | Convert a parsing failure to a `()`.
optional_ :: Parser e a -> Parser e ()
optional_ :: Parser e a -> Parser e ()
optional_ Parser e a
p = (() () -> Parser e a -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e a
p) Parser e () -> Parser e () -> Parser e ()
forall e a. Parser e a -> Parser e a -> Parser e a
<|> () -> Parser e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# inline optional_ #-}

-- | CPS'd version of `optional`. This is usually more efficient, since it gets rid of the
--   extra `Maybe` allocation.
withOption :: Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b
withOption :: Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b
withOption (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) a -> Parser e b
just (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
nothing) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# a
a Addr#
s -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> Parser e b
just a
a) ForeignPtrContents
fp Addr#
eob Addr#
s
  Res# e a
Fail#   -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
nothing ForeignPtrContents
fp Addr#
eob Addr#
s
  Err# e
e  -> e -> Res# e b
forall e a. e -> Res# e a
Err# e
e
{-# inline withOption #-}

-- | Convert a parsing failure to an error.
cut :: Parser e a -> e -> Parser e a
cut :: Parser e a -> e -> Parser e a
cut (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) e
e = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  Res# e a
Fail# -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
  Res# e a
x     -> Res# e a
x
{-# inline cut #-}

-- | Run the parser, if we get a failure, throw the given error, but if we get an error, merge the
--   inner and the newly given errors using the @e -> e -> e@ function. This can be useful for
--   implementing parsing errors which may propagate hints or accummulate contextual information.
cutting :: Parser e a -> e -> (e -> e -> e) -> Parser e a
cutting :: Parser e a -> e -> (e -> e -> e) -> Parser e a
cutting (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) e
e e -> e -> e
merge = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  Res# e a
Fail#   -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
  Err# e
e' -> let !e'' :: e
e'' = e -> e -> e
merge e
e' e
e in e -> Res# e a
forall e a. e -> Res# e a
Err# e
e''
  Res# e a
x       -> Res# e a
x
{-# inline cutting #-}

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


-- | Succeed if the input is empty.
eof :: Parser e ()
eof :: Parser e ()
eof = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
  Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
  Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline eof #-}

-- | Read the given number of bytes as a 'ByteString'.
--
-- Throws a runtime error if given a negative integer.
takeBs :: Int -> Parser e B.ByteString
takeBs :: Int -> Parser e ByteString
takeBs (I# Int#
n#) = Int# -> Parser e ByteString
forall e. Int# -> Parser e ByteString
takeBs# Int#
n#
{-# inline takeBs #-}

-- | Consume the rest of the input. May return the empty bytestring.
takeRestBs :: Parser e B.ByteString
takeRestBs :: Parser e ByteString
takeRestBs = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString)
-> Parser e ByteString
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  let n# :: Int#
n# = Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s
  in  ByteString -> Addr# -> Res# e ByteString
forall a e. a -> Addr# -> Res# e a
OK# (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# Int#
n#)) Addr#
eob
{-# inline takeRestBs #-}

-- | Skip forward @n@ bytes. Fails if fewer than @n@ bytes are available.
--
-- Throws a runtime error if given a negative integer.
skip :: Int -> Parser e ()
skip :: Int -> Parser e ()
skip (I# Int#
os#) = Int# -> Parser e () -> Parser e ()
forall e a. Int# -> Parser e a -> Parser e a
atSkip# Int#
os# (() -> Parser e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# inline skip #-}

-- | Parse a UTF-8 character literal. This is a template function, you can use it as
--   @$(char \'x\')@, for example, and the splice in this case has type @Parser e ()@.
char :: Char -> Q Exp
char :: Char -> Q Exp
char Char
c = String -> Q Exp
string [Char
c]

-- | Read a `Word8`.
byte :: Word8 -> Parser e ()
byte :: Word8 -> Parser e ()
byte Word8
w = Int -> Parser e ()
forall e. Int -> Parser e ()
ensureBytes# Int
1 Parser e () -> Parser e () -> Parser e ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Parser e ()
forall e. Word8 -> Parser e ()
scan8# Word8
w
{-# inline byte #-}

-- | Read a sequence of bytes. This is a template function, you can use it as @$(bytes [3, 4, 5])@,
--   for example, and the splice has type @Parser e ()@.
bytes :: [Word] -> Q Exp
bytes :: [Word] -> Q Exp
bytes [Word]
bytes = do
  let !len :: Int
len = [Word] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
bytes
  [| ensureBytes# len >> $(scanBytes# bytes) |]

-- | Parse a UTF-8 string literal. This is a template function, you can use it as @$(string "foo")@,
--   for example, and the splice has type @Parser e ()@.
string :: String -> Q Exp
string :: String -> Q Exp
string String
str = [Word] -> Q Exp
bytes (String -> [Word]
strToBytes String
str)

{-|
This is a template function which makes it possible to branch on a collection of string literals in
an efficient way. By using `switch`, such branching is compiled to a trie of primitive parsing
operations, which has optimized control flow, vectorized reads and grouped checking for needed input
bytes.

The syntax is slightly magical, it overloads the usual @case@ expression. An example:

@
    $(switch [| case _ of
        "foo" -> pure True
        "bar" -> pure False |])
@

The underscore is mandatory in @case _ of@. Each branch must be a string literal, but optionally
we may have a default case, like in

@
    $(switch [| case _ of
        "foo" -> pure 10
        "bar" -> pure 20
        _     -> pure 30 |])
@

All case right hand sides must be parsers with the same type. That type is also the type
of the whole `switch` expression.

A `switch` has longest match semantics, and the order of cases does not matter, except for
the default case, which may only appear as the last case.

If a `switch` does not have a default case, and no case matches the input, then it returns with
failure, \without\ having consumed any input. A fallthrough to the default case also does not
consume any input.
-}
switch :: Q Exp -> Q Exp
switch :: Q Exp -> Q Exp
switch = Maybe (Q Exp) -> Q Exp -> Q Exp
switchWithPost Maybe (Q Exp)
forall k1. Maybe k1
Nothing

{-|
Switch expression with an optional first argument for performing a post-processing action after
every successful branch matching, not including the default branch. For example, if we have
@ws :: Parser e ()@ for a whitespace parser, we might want to consume whitespace after matching
on any of the switch cases. For that case, we can define a "lexeme" version of `switch` as
follows.

@
  switch' :: Q Exp -> Q Exp
  switch' = switchWithPost (Just [| ws |])
@

Note that this @switch'@ function cannot be used in the same module it's defined in, because of the
stage restriction of Template Haskell.
-}
switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp
switchWithPost :: Maybe (Q Exp) -> Q Exp -> Q Exp
switchWithPost Maybe (Q Exp)
postAction Q Exp
exp = do
  !Maybe Exp
postAction <- Maybe (Q Exp) -> Q (Maybe Exp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (Q Exp)
postAction
  (![(String, Exp)]
cases, !Maybe Exp
fallback) <- Q Exp -> Q ([(String, Exp)], Maybe Exp)
parseSwitch Q Exp
exp
  (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp
genTrie ((Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp)
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
-> Q Exp
forall a b. (a -> b) -> a -> b
$! Maybe Exp
-> [(String, Exp)]
-> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
genSwitchTrie' Maybe Exp
postAction [(String, Exp)]
cases Maybe Exp
fallback

-- | Version of `switchWithPost` without syntactic sugar. The second argument is the
--   list of cases, the third is the default case.
rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp
rawSwitchWithPost :: Maybe (Q Exp) -> [(String, Q Exp)] -> Maybe (Q Exp) -> Q Exp
rawSwitchWithPost Maybe (Q Exp)
postAction [(String, Q Exp)]
cases Maybe (Q Exp)
fallback = do
  !Maybe Exp
postAction <- Maybe (Q Exp) -> Q (Maybe Exp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (Q Exp)
postAction
  ![(String, Exp)]
cases <- [(String, Q Exp)]
-> ((String, Q Exp) -> Q (String, Exp)) -> Q [(String, Exp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, Q Exp)]
cases \(String
str, Q Exp
rhs) -> (String
str,) (Exp -> (String, Exp)) -> Q Exp -> Q (String, Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Exp
rhs
  !Maybe Exp
fallback <- Maybe (Q Exp) -> Q (Maybe Exp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (Q Exp)
fallback
  (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp
genTrie ((Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp)
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
-> Q Exp
forall a b. (a -> b) -> a -> b
$! Maybe Exp
-> [(String, Exp)]
-> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
genSwitchTrie' Maybe Exp
postAction [(String, Exp)]
cases Maybe Exp
fallback

-- | Parse a UTF-8 `Char` for which a predicate holds.
satisfy :: (Char -> Bool) -> Parser e Char
satisfy :: (Char -> Bool) -> Parser e Char
satisfy Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Parser Any Char
-> ForeignPtrContents -> Addr# -> Addr# -> Res# Any Char
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser Any Char
forall e. Parser e Char
anyChar ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# Char
c Addr#
s | Char -> Bool
f Char
c -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
c Addr#
s
  Res# Any Char
_             -> Res# e Char
forall e a. Res# e a
Fail#
{-#  inline satisfy #-}

-- | Skip a UTF-8 `Char` for which a predicate holds.
satisfy_ :: (Char -> Bool) -> Parser e ()
satisfy_ :: (Char -> Bool) -> Parser e ()
satisfy_ Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Parser Any Char
-> ForeignPtrContents -> Addr# -> Addr# -> Res# Any Char
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser Any Char
forall e. Parser e Char
anyChar ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# Char
c Addr#
s | Char -> Bool
f Char
c -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
  Res# Any Char
_             -> Res# e ()
forall e a. Res# e a
Fail#
{-#  inline satisfy_ #-}

-- | Parse an ASCII `Char` for which a predicate holds. Assumption: the predicate must only return
--   `True` for ASCII-range characters. Otherwise this function might read a 128-255 range byte,
--   thereby breaking UTF-8 decoding.
satisfyASCII :: (Char -> Bool) -> Parser e Char
satisfyASCII :: (Char -> Bool) -> Parser e Char
satisfyASCII Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
  Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Char#
derefChar8# Addr#
s of
    Char#
c1 | Char -> Bool
f (Char# -> Char
C# Char#
c1) -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
       | Bool
otherwise -> Res# e Char
forall e a. Res# e a
Fail#
{-#  inline satisfyASCII #-}

-- | Skip an ASCII `Char` for which a predicate holds. Assumption: the predicate
--   must only return `True` for ASCII-range characters.
satisfyASCII_ :: (Char -> Bool) -> Parser e ()
satisfyASCII_ :: (Char -> Bool) -> Parser e ()
satisfyASCII_ Char -> Bool
f = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
  Int#
1# -> Res# e ()
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Char#
derefChar8# Addr#
s of
    Char#
c1 | Char -> Bool
f (Char# -> Char
C# Char#
c1) -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
       | Bool
otherwise -> Res# e ()
forall e a. Res# e a
Fail#
{-#  inline satisfyASCII_ #-}

-- | This is a variant of `satisfy` which allows more optimization. We can pick four testing
--   functions for the four cases for the possible number of bytes in the UTF-8 character. So in
--   @fusedSatisfy f1 f2 f3 f4@, if we read a one-byte character, the result is scrutinized with
--   @f1@, for two-bytes, with @f2@, and so on. This can result in dramatic lexing speedups.
--
--   For example, if we want to accept any letter, the naive solution would be to use
--   `Data.Char.isLetter`, but this accesses a large lookup table of Unicode character classes. We
--   can do better with @fusedSatisfy isLatinLetter isLetter isLetter isLetter@, since here the
--   `isLatinLetter` is inlined into the UTF-8 decoding, and it probably handles a great majority of
--   all cases without accessing the character table.
fusedSatisfy :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e Char
fusedSatisfy :: (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e Char
fusedSatisfy Char -> Bool
f1 Char -> Bool
f2 Char -> Bool
f3 Char -> Bool
f4 = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
  Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Char#
derefChar8# Addr#
buf of
    Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
      Int#
1# | Char -> Bool
f1 (Char# -> Char
C# Char#
c1) -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
         | Bool
otherwise  -> Res# e Char
forall e a. Res# e a
Fail#
      Int#
_  -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#) of
        Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
        Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
1# of
          Char#
c2 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xDF'# of
            Int#
1# ->
              let resc :: Char
resc = Char# -> Char
C# (Int# -> Char#
chr# (((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xC0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
                                   (Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#)))
              in case Char -> Bool
f2 Char
resc of
                   Bool
True -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
resc (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
                   Bool
_    -> Res# e Char
forall e a. Res# e a
Fail#
            Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#) of
              Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
              Int#
_  -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
2# of
                Char#
c3 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xEF'# of
                  Int#
1# ->
                    let resc :: Char
resc = Char# -> Char
C# (Int# -> Char#
chr# (((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xE0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
                                         ((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#`  Int#
6#) Int# -> Int# -> Int#
`orI#`
                                         (Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#)))
                    in case Char -> Bool
f3 Char
resc of
                         Bool
True -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
resc (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#)
                         Bool
_    -> Res# e Char
forall e a. Res# e a
Fail#
                  Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#) of
                    Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
                    Int#
_  -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
3# of
                      Char#
c4 ->
                        let resc :: Char
resc = Char# -> Char
C# (Int# -> Char#
chr# (((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xF0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
18#) Int# -> Int# -> Int#
`orI#`
                                             ((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
                                             ((Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#`  Int#
6#) Int# -> Int# -> Int#
`orI#`
                                              (Char# -> Int#
ord# Char#
c4 Int# -> Int# -> Int#
-# Int#
0x80#)))
                        in case Char -> Bool
f4 Char
resc of
                             Bool
True -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# Char
resc (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
                             Bool
_    -> Res# e Char
forall e a. Res# e a
Fail#
{-# inline fusedSatisfy #-}

-- | Skipping variant of `fusedSatisfy`.
fusedSatisfy_ :: (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser e ()
fusedSatisfy_ :: (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e ()
fusedSatisfy_ Char -> Bool
f1 Char -> Bool
f2 Char -> Bool
f3 Char -> Bool
f4 = () () -> Parser e Char -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e Char
forall e.
(Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> (Char -> Bool)
-> Parser e Char
fusedSatisfy Char -> Bool
f1 Char -> Bool
f2 Char -> Bool
f3 Char -> Bool
f4
{-# inline fusedSatisfy_ #-}

-- | Parse any UTF-8-encoded `Char`.
anyChar :: Parser e Char
anyChar :: Parser e Char
anyChar = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
  Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Char#
derefChar8# Addr#
buf of
    Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
      Int#
1# -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
      Int#
_  -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#) of
        Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
        Int#
_ -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
1# of
          Char#
c2 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xDF'# of
            Int#
1# ->
              let resc :: Int#
resc = ((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xC0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
                          (Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#)
              in Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# (Int# -> Char#
chr# Int#
resc)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
            Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#) of
              Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
              Int#
_  -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
2# of
                Char#
c3 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xEF'# of
                  Int#
1# ->
                    let resc :: Int#
resc = ((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xE0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
                               ((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#`  Int#
6#) Int# -> Int# -> Int#
`orI#`
                                (Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#)
                    in Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# (Int# -> Char#
chr# Int#
resc)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#)
                  Int#
_ -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#) of
                    Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
                    Int#
_  -> case Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
buf Int#
3# of
                      Char#
c4 ->
                        let resc :: Int#
resc = ((Char# -> Int#
ord# Char#
c1 Int# -> Int# -> Int#
-# Int#
0xF0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
18#) Int# -> Int# -> Int#
`orI#`
                                   ((Char# -> Int#
ord# Char#
c2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
                                   ((Char# -> Int#
ord# Char#
c3 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#`  Int#
6#) Int# -> Int# -> Int#
`orI#`
                                    (Char# -> Int#
ord# Char#
c4 Int# -> Int# -> Int#
-# Int#
0x80#)
                        in Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# (Int# -> Char#
chr# Int#
resc)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
{-# inline anyChar #-}

-- | Skip any UTF-8-encoded `Char`.
anyChar_ :: Parser e ()
anyChar_ :: Parser e ()
anyChar_ = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
  Int#
1# -> Res# e ()
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Char#
derefChar8# Addr#
buf of
    Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
      Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
      Int#
_  ->
        let buf' :: Addr#
buf' =
              case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xDF'# of
                Int#
1# -> Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#
                Int#
_  -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\xEF'# of
                    Int#
1# -> Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
3#
                    Int#
_ ->  Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#
        in case Addr# -> Addr# -> Int#
leAddr# Addr#
buf' Addr#
eob of
             Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
buf'
             Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline anyChar_ #-}


-- | Parse any `Char` in the ASCII range, fail if the next input character is not in the range.
--   This is more efficient than `anyChar` if we are only working with ASCII.
anyCharASCII :: Parser e Char
anyCharASCII :: Parser e Char
anyCharASCII = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Char)
-> Parser e Char
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
  Int#
1# -> Res# e Char
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Char#
derefChar8# Addr#
buf of
    Char#
c1 -> case Char#
c1 Char# -> Char# -> Int#
`leChar#` Char#
'\x7F'# of
      Int#
1# -> Char -> Addr# -> Res# e Char
forall a e. a -> Addr# -> Res# e a
OK# (Char# -> Char
C# Char#
c1) (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
      Int#
_  -> Res# e Char
forall e a. Res# e a
Fail#
{-# inline anyCharASCII #-}

-- | Skip any `Char` in the ASCII range. More efficient than `anyChar_` if we're working only with
--   ASCII.
anyCharASCII_ :: Parser e ()
anyCharASCII_ :: Parser e ()
anyCharASCII_ = () () -> Parser e Char -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Char
forall e. Parser e Char
anyCharASCII
{-# inline anyCharASCII_ #-}

-- | Read a non-negative `Int` from the input, as a non-empty digit sequence.
-- The `Int` may overflow in the result.
readInt :: Parser e Int
readInt :: Parser e Int
readInt = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Int)
-> Parser e Int
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Addr# -> Addr# -> (# (# #) | (# Int#, Addr# #) #)
FlatParse.Internal.readInt Addr#
eob Addr#
s of
  (# (##) | #)        -> Res# e Int
forall e a. Res# e a
Fail#
  (# | (# Int#
n, Addr#
s' #) #) -> Int -> Addr# -> Res# e Int
forall a e. a -> Addr# -> Res# e a
OK# (Int# -> Int
I# Int#
n) Addr#
s'
{-# inline readInt #-}

-- | Read a non-negative `Integer` from the input, as a non-empty digit
-- sequence.
readInteger :: Parser e Integer
readInteger :: Parser e Integer
readInteger = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Integer)
-> Parser e Integer
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents
-> Addr# -> Addr# -> (# (# #) | (# Integer, Addr# #) #)
FlatParse.Internal.readInteger ForeignPtrContents
fp Addr#
eob Addr#
s of
  (# (##) | #)        -> Res# e Integer
forall e a. Res# e a
Fail#
  (# | (# Integer
i, Addr#
s' #) #) -> Integer -> Addr# -> Res# e Integer
forall a e. a -> Addr# -> Res# e a
OK# Integer
i Addr#
s'
{-# inline readInteger #-}

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

-- | Choose between two parsers. If the first parser fails, try the second one, but if the first one
--   throws an error, propagate the error.
infixr 6 <|>
(<|>) :: Parser e a -> Parser e a -> Parser e a
<|> :: Parser e a -> Parser e a -> Parser e a
(<|>) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
    Res# e a
Fail# -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
g ForeignPtrContents
fp Addr#
eob Addr#
s
    Res# e a
x     -> Res# e a
x
{-# inline (<|>) #-}

-- | Branch on a parser: if the first argument succeeds, continue with the second, else with the third.
--   This can produce slightly more efficient code than `(<|>)`. Moreover, `ḃranch` does not
--   backtrack from the true/false cases.
branch :: Parser e a -> Parser e b -> Parser e b -> Parser e b
branch :: Parser e a -> Parser e b -> Parser e b -> Parser e b
branch Parser e a
pa Parser e b
pt Parser e b
pf = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e a
pa ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# a
_ Addr#
s -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e b
pt ForeignPtrContents
fp Addr#
eob Addr#
s
  Res# e a
Fail#   -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e b
pf ForeignPtrContents
fp Addr#
eob Addr#
s
  Err# e
e  -> e -> Res# e b
forall e a. e -> Res# e a
Err# e
e
{-# inline branch #-}

-- | An analogue of the list `foldl` function: first parse a @b@, then parse zero or more @a@-s,
--   and combine the results in a left-nested way by the @b -> a -> b@ function. Note: this is not
--   the usual `chainl` function from the parsec libraries!
chainl :: (b -> a -> b) -> Parser e b -> Parser e a -> Parser e b
chainl :: (b -> a -> b) -> Parser e b -> Parser e a -> Parser e b
chainl b -> a -> b
f Parser e b
start Parser e a
elem = Parser e b
start Parser e b -> (b -> Parser e b) -> Parser e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Parser e b
go where
  go :: b -> Parser e b
go b
b = do {!a
a <- Parser e a
elem; b -> Parser e b
go (b -> Parser e b) -> b -> Parser e b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
b a
a} Parser e b -> Parser e b -> Parser e b
forall e a. Parser e a -> Parser e a -> Parser e a
<|> b -> Parser e b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
{-# inline chainl #-}

-- | An analogue of the list `foldr` function: parse zero or more @a@-s, terminated by a @b@, and
--   combine the results in a right-nested way using the @a -> b -> b@ function. Note: this is not
--   the usual `chainr` function from the parsec libraries!
chainr :: (a -> b -> b) -> Parser e a -> Parser e b -> Parser e b
chainr :: (a -> b -> b) -> Parser e a -> Parser e b -> Parser e b
chainr a -> b -> b
f (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
elem) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
end) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e b
go where
  go :: ForeignPtrContents -> Addr# -> Addr# -> Res# e b
go ForeignPtrContents
fp Addr#
eob Addr#
s = case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
elem ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e b
go ForeignPtrContents
fp Addr#
eob Addr#
s of
      OK# b
b Addr#
s -> let !b' :: b
b' = a -> b -> b
f a
a b
b in b -> Addr# -> Res# e b
forall a e. a -> Addr# -> Res# e a
OK# b
b' Addr#
s
      Res# e b
x       -> Res# e b
x
    Res# e a
Fail# -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
end ForeignPtrContents
fp Addr#
eob Addr#
s
    Err# e
e -> e -> Res# e b
forall e a. e -> Res# e a
Err# e
e
{-# inline chainr #-}

-- | Run a parser zero or more times, collect the results in a list. Note: for optimal performance,
--   try to avoid this. Often it is possible to get rid of the intermediate list by using a
--   combinator or a custom parser.
many :: Parser e a -> Parser e [a]
many :: Parser e a -> Parser e [a]
many (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e [a])
-> Parser e [a]
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e [a]
go where
  go :: ForeignPtrContents -> Addr# -> Addr# -> Res# e [a]
go ForeignPtrContents
fp Addr#
eob Addr#
s = case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e [a]
go ForeignPtrContents
fp Addr#
eob Addr#
s of
                 OK# [a]
as Addr#
s -> [a] -> Addr# -> Res# e [a]
forall a e. a -> Addr# -> Res# e a
OK# (a
aa -> [a] -> [a]
forall k1. k1 -> [k1] -> [k1]
:[a]
as) Addr#
s
                 Res# e [a]
x        -> Res# e [a]
x
    Res# e a
Fail#  -> [a] -> Addr# -> Res# e [a]
forall a e. a -> Addr# -> Res# e a
OK# [] Addr#
s
    Err# e
e -> e -> Res# e [a]
forall e a. e -> Res# e a
Err# e
e
{-# inline many #-}

-- | Skip a parser zero or more times.
many_ :: Parser e a -> Parser e ()
many_ :: Parser e a -> Parser e ()
many_ (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e ()
go where
  go :: ForeignPtrContents -> Addr# -> Addr# -> Res# e ()
go ForeignPtrContents
fp Addr#
eob Addr#
s = case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
    OK# a
a Addr#
s -> ForeignPtrContents -> Addr# -> Addr# -> Res# e ()
go ForeignPtrContents
fp Addr#
eob Addr#
s
    Res# e a
Fail#   -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
    Err# e
e  -> e -> Res# e ()
forall e a. e -> Res# e a
Err# e
e
{-# inline many_ #-}

-- | Run a parser one or more times, collect the results in a list. Note: for optimal performance,
--   try to avoid this. Often it is possible to get rid of the intermediate list by using a
--   combinator or a custom parser.
some :: Parser e a -> Parser e [a]
some :: Parser e a -> Parser e [a]
some Parser e a
p = (:) (a -> [a] -> [a]) -> Parser e a -> Parser e ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
p Parser e ([a] -> [a]) -> Parser e [a] -> Parser e [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e a -> Parser e [a]
forall e a. Parser e a -> Parser e [a]
many Parser e a
p
{-# inline some #-}

-- | Skip a parser one or more times.
some_ :: Parser e a -> Parser e ()
some_ :: Parser e a -> Parser e ()
some_ Parser e a
pa = Parser e a
pa Parser e a -> Parser e () -> Parser e ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser e a -> Parser e ()
forall e a. Parser e a -> Parser e ()
many_ Parser e a
pa
{-# inline some_ #-}

-- | Succeed if the first parser succeeds and the second one fails.
notFollowedBy :: Parser e a -> Parser e b -> Parser e a
notFollowedBy :: Parser e a -> Parser e b -> Parser e a
notFollowedBy Parser e a
p1 Parser e b
p2 = Parser e a
p1 Parser e a -> Parser e () -> Parser e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e b -> Parser e ()
forall e a. Parser e a -> Parser e ()
fails Parser e b
p2
{-# inline notFollowedBy #-}

-- | @isolate n p@ runs the parser @p@ isolated to the next @n@ bytes. All
--   isolated bytes must be consumed.
--
-- Throws a runtime error if given a negative integer.
isolate :: Int -> Parser e a -> Parser e a
isolate :: Int -> Parser e a -> Parser e a
isolate (I# Int#
n#) Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  let s' :: Addr#
s' = Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
n#
  in  case Int#
n# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s of
        Int#
1# -> case Int#
n# Int# -> Int# -> Int#
>=# Int#
0# of
          Int#
1# -> case Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# Parser e a
p ForeignPtrContents
fp Addr#
s' Addr#
s of
            OK# a
a Addr#
s'' -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
s' Addr#
s'' of
              Int#
1# -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s''
              Int#
_  -> Res# e a
forall e a. Res# e a
Fail# -- isolated segment wasn't fully consumed
            Res# e a
Fail#     -> Res# e a
forall e a. Res# e a
Fail#
            Err# e
e    -> e -> Res# e a
forall e a. e -> Res# e a
Err# e
e
          Int#
_  -> String -> Res# e a
forall a. HasCallStack => String -> a
error String
"FlatParse.Basic.isolate: negative integer"
        Int#
_  -> Res# e a
forall e a. Res# e a
Fail# -- you tried to isolate more than we have left
{-# inline isolate #-}


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

-- | Get the current position in the input.
getPos :: Parser e Pos
getPos :: Parser e Pos
getPos = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Pos)
-> Parser e Pos
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Pos -> Addr# -> Res# e Pos
forall a e. a -> Addr# -> Res# e a
OK# (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s) Addr#
s
{-# inline getPos #-}

-- | Set the input position. Warning: this can result in crashes if the position points outside the
--   current buffer. It is always safe to `setPos` values which came from `getPos` with the current
--   input.
setPos :: Pos -> Parser e ()
setPos :: Pos -> Parser e ()
setPos Pos
s = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
_ -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Pos -> Addr#
posToAddr# Addr#
eob Pos
s)
{-# inline setPos #-}

-- | The end of the input.
endPos :: Pos
endPos :: Pos
endPos = Int -> Pos
Pos Int
0
{-# inline endPos #-}

-- | Return the consumed span of a parser.
spanOf :: Parser e a -> Parser e Span
spanOf :: Parser e a -> Parser e Span
spanOf (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Span)
-> Parser e Span
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# a
a Addr#
s' -> Span -> Addr# -> Res# e Span
forall a e. a -> Addr# -> Res# e a
OK# (Pos -> Pos -> Span
Span (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s) (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s')) Addr#
s'
  Res# e a
x        -> Res# e a -> Res# e Span
unsafeCoerce# Res# e a
x
{-# inline spanOf #-}

-- | Bind the result together with the span of the result. CPS'd version of `spanOf`
--   for better unboxing.
withSpan :: Parser e a -> (a -> Span -> Parser e b) -> Parser e b
withSpan :: Parser e a -> (a -> Span -> Parser e b) -> Parser e b
withSpan (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) a -> Span -> Parser e b
g = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# a
a Addr#
s' -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> Span -> Parser e b
g a
a (Pos -> Pos -> Span
Span (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s) (Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s'))) ForeignPtrContents
fp Addr#
eob Addr#
s'
  Res# e a
x        -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline withSpan #-}

-- | Return the `B.ByteString` consumed by a parser. Note: it's more efficient to use `spanOf` and
--   `withSpan` instead.
byteStringOf :: Parser e a -> Parser e B.ByteString
byteStringOf :: Parser e a -> Parser e ByteString
byteStringOf (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString)
-> Parser e ByteString
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# a
a Addr#
s' -> ByteString -> Addr# -> Res# e ByteString
forall a e. a -> Addr# -> Res# e a
OK# (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s))) Addr#
s'
  Res# e a
x        -> Res# e a -> Res# e ByteString
unsafeCoerce# Res# e a
x
{-# inline byteStringOf #-}

-- | CPS'd version of `byteStringOf`. Can be more efficient, because the result is more eagerly unboxed
--   by GHC. It's more efficient to use `spanOf` or `withSpan` instead.
withByteString :: Parser e a -> (a -> B.ByteString -> Parser e b) -> Parser e b
withByteString :: Parser e a -> (a -> ByteString -> Parser e b) -> Parser e b
withByteString (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) a -> ByteString -> Parser e b
g = (ForeignPtrContents -> Addr# -> Addr# -> Res# e b) -> Parser e b
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp Addr#
eob Addr#
s of
  OK# a
a Addr#
s' -> Parser e b -> ForeignPtrContents -> Addr# -> Addr# -> Res# e b
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (a -> ByteString -> Parser e b
g a
a (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
s' Addr#
s)))) ForeignPtrContents
fp Addr#
eob Addr#
s'
  Res# e a
x        -> Res# e a -> Res# e b
unsafeCoerce# Res# e a
x
{-# inline withByteString #-}

-- | Run a parser in a given input span. The input position and the `Int` state is restored after
--   the parser is finished, so `inSpan` does not consume input and has no side effect.  Warning:
--   this operation may crash if the given span points outside the current parsing buffer. It's
--   always safe to use `inSpan` if the span comes from a previous `withSpan` or `spanOf` call on
--   the current input.
inSpan :: Span -> Parser e a -> Parser e a
inSpan :: Span -> Parser e a -> Parser e a
inSpan (Span Pos
s Pos
eob) (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob' Addr#
s' ->
  case ForeignPtrContents -> Addr# -> Addr# -> Res# e a
f ForeignPtrContents
fp (Addr# -> Pos -> Addr#
posToAddr# Addr#
eob' Pos
eob) (Addr# -> Pos -> Addr#
posToAddr# Addr#
eob' Pos
s) of
    OK# a
a Addr#
_ -> a -> Addr# -> Res# e a
forall a e. a -> Addr# -> Res# e a
OK# a
a Addr#
s'
    Res# e a
x       -> Res# e a -> Res# e a
unsafeCoerce# Res# e a
x
{-# inline inSpan #-}

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

-- | Check whether a `Pos` points into a `B.ByteString`.
validPos :: B.ByteString -> Pos -> Bool
validPos :: ByteString -> Pos -> Bool
validPos ByteString
str Pos
pos =
  let go :: Parser e Bool
go = do
        Pos
start <- Parser e Pos
forall e. Parser e Pos
getPos
        Bool -> Parser e Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pos
start Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
pos Bool -> Bool -> Bool
&& Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
endPos)
  in case Parser Any Bool -> ByteString -> Result Any Bool
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Any Bool
forall e. Parser e Bool
go ByteString
str of
    OK Bool
b ByteString
_ -> Bool
b
    Result Any Bool
_      -> String -> Bool
forall a. HasCallStack => String -> a
error String
"impossible"
{-# inline validPos #-}

-- | Compute corresponding line and column numbers for each `Pos` in a list. Throw an error
--   on invalid positions. Note: computing lines and columns may traverse the `B.ByteString`,
--   but it traverses it only once regardless of the length of the position list.
posLineCols :: B.ByteString -> [Pos] -> [(Int, Int)]
posLineCols :: ByteString -> [Pos] -> [(Int, Int)]
posLineCols ByteString
str [Pos]
poss =
  let go :: a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go !a
line !a
col [] = [(a, (a, a))] -> Parser e [(a, (a, a))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      go a
line a
col ((a
i, Pos
pos):[(a, Pos)]
poss) = do
        Pos
p <- Parser e Pos
forall e. Parser e Pos
getPos
        if Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
p then
          ((a
i, (a
line, a
col))(a, (a, a)) -> [(a, (a, a))] -> [(a, (a, a))]
forall k1. k1 -> [k1] -> [k1]
:) ([(a, (a, a))] -> [(a, (a, a))])
-> Parser e [(a, (a, a))] -> Parser e [(a, (a, a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go a
line a
col [(a, Pos)]
poss
        else do
          Char
c <- Parser e Char
forall e. Parser e Char
anyChar
          if Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c then
            a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go (a
line a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
0 ((a
i, Pos
pos)(a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall k1. k1 -> [k1] -> [k1]
:[(a, Pos)]
poss)
          else
            a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go a
line (a
col a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) ((a
i, Pos
pos)(a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall k1. k1 -> [k1] -> [k1]
:[(a, Pos)]
poss)

      sorted :: [(Int, Pos)]
      sorted :: [(Int, Pos)]
sorted = ((Int, Pos) -> (Int, Pos) -> Ordering)
-> [(Int, Pos)] -> [(Int, Pos)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, Pos) -> Pos) -> (Int, Pos) -> (Int, Pos) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, Pos) -> Pos
forall a b. (a, b) -> b
snd) ([Int] -> [Pos] -> [(Int, Pos)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Pos]
poss)

  in case Parser Any [(Int, (Int, Int))]
-> ByteString -> Result Any [(Int, (Int, Int))]
forall e a. Parser e a -> ByteString -> Result e a
runParser (Int -> Int -> [(Int, Pos)] -> Parser Any [(Int, (Int, Int))]
forall a a a e.
(Num a, Num a) =>
a -> a -> [(a, Pos)] -> Parser e [(a, (a, a))]
go Int
0 Int
0 [(Int, Pos)]
sorted) ByteString
str of
       OK [(Int, (Int, Int))]
res ByteString
_ -> (Int, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd ((Int, (Int, Int)) -> (Int, Int))
-> [(Int, (Int, Int))] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, (Int, Int)) -> (Int, (Int, Int)) -> Ordering)
-> [(Int, (Int, Int))] -> [(Int, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (Int, Int)) -> Int)
-> (Int, (Int, Int)) -> (Int, (Int, Int)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (Int, Int)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (Int, Int))]
res
       Result Any [(Int, (Int, Int))]
_        -> String -> [(Int, Int)]
forall a. HasCallStack => String -> a
error String
"invalid position"

-- | Create a `B.ByteString` from a `Span`. The result is invalid if the `Span` points
--   outside the current buffer, or if the `Span` start is greater than the end position.
unsafeSpanToByteString :: Span -> Parser e B.ByteString
unsafeSpanToByteString :: Span -> Parser e ByteString
unsafeSpanToByteString (Span Pos
l Pos
r) =
  Parser e ByteString -> Parser e ByteString
forall e a. Parser e a -> Parser e a
lookahead (Pos -> Parser e ()
forall e. Pos -> Parser e ()
setPos Pos
l Parser e () -> Parser e ByteString -> Parser e ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser e () -> Parser e ByteString
forall e a. Parser e a -> Parser e ByteString
byteStringOf (Pos -> Parser e ()
forall e. Pos -> Parser e ()
setPos Pos
r))
{-# inline unsafeSpanToByteString #-}

-- | Create a `Pos` from a line and column number. Throws an error on out-of-bounds
--   line and column numbers.
mkPos :: B.ByteString -> (Int, Int) -> Pos
mkPos :: ByteString -> (Int, Int) -> Pos
mkPos ByteString
str (Int
line', Int
col') =
  let go :: Int -> Int -> Parser e Pos
go Int
line Int
col | Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line' Bool -> Bool -> Bool
&& Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
col' = Parser e Pos
forall e. Parser e Pos
getPos
      go Int
line Int
col = (do
        Char
c <- Parser e Char
forall e. Parser e Char
anyChar
        if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Int -> Int -> Parser e Pos
go (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
                     else Int -> Int -> Parser e Pos
go Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Parser e Pos -> Parser e Pos -> Parser e Pos
forall e a. Parser e a -> Parser e a -> Parser e a
<|> String -> Parser e Pos
forall a. HasCallStack => String -> a
error String
"mkPos: invalid position"
  in case Parser Any Pos -> ByteString -> Result Any Pos
forall e a. Parser e a -> ByteString -> Result e a
runParser (Int -> Int -> Parser Any Pos
forall e. Int -> Int -> Parser e Pos
go Int
0 Int
0) ByteString
str of
    OK Pos
res ByteString
_ -> Pos
res
    Result Any Pos
_        -> String -> Pos
forall a. HasCallStack => String -> a
error String
"impossible"

-- | Break an UTF-8-coded `B.ByteString` to lines. Throws an error on invalid input.
--   This is mostly useful for grabbing specific source lines for displaying error
--   messages.
lines :: B.ByteString -> [String]
lines :: ByteString -> [String]
lines ByteString
str =
  let go :: Parser e [String]
go = ([] [String] -> Parser e () -> Parser e [String]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e ()
forall e. Parser e ()
eof) Parser e [String] -> Parser e [String] -> Parser e [String]
forall e a. Parser e a -> Parser e a -> Parser e a
<|> ((:) (String -> [String] -> [String])
-> Parser e String -> Parser e ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e String
forall e. Parser e String
takeLine Parser e ([String] -> [String])
-> Parser e [String] -> Parser e [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e [String]
go)
  in case Parser Any [String] -> ByteString -> Result Any [String]
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Any [String]
forall e. Parser e [String]
go ByteString
str of
    OK [String]
ls ByteString
_ -> [String]
ls
    Result Any [String]
_       -> String -> [String]
forall a. HasCallStack => String -> a
error String
"linesUTF8: invalid input"

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

-- | Parse the rest of the current line as a `String`. Assumes UTF-8 encoding,
--   throws an error if the encoding is invalid.
takeLine :: Parser e String
takeLine :: Parser e String
takeLine = Parser e ()
-> Parser e String -> Parser e String -> Parser e String
forall e a b. Parser e a -> Parser e b -> Parser e b -> Parser e b
branch Parser e ()
forall e. Parser e ()
eof (String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") do
  Char
c <- Parser e Char
forall e. Parser e Char
anyChar
  case Char
c of
    Char
'\n' -> String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
    Char
_    -> (Char
cChar -> ShowS
forall k1. k1 -> [k1] -> [k1]
:) ShowS -> Parser e String -> Parser e String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e String
forall e. Parser e String
takeLine

-- | Parse the rest of the current line as a `String`, but restore the parsing state.
--   Assumes UTF-8 encoding. This can be used for debugging.
traceLine :: Parser e String
traceLine :: Parser e String
traceLine = Parser e String -> Parser e String
forall e a. Parser e a -> Parser e a
lookahead Parser e String
forall e. Parser e String
takeLine

-- | Take the rest of the input as a `String`. Assumes UTF-8 encoding.
takeRest :: Parser e String
takeRest :: Parser e String
takeRest = Parser e ()
-> Parser e String -> Parser e String -> Parser e String
forall e a b. Parser e a -> Parser e b -> Parser e b -> Parser e b
branch Parser e ()
forall e. Parser e ()
eof (String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") do
  Char
c <- Parser e Char
forall e. Parser e Char
anyChar
  String
cs <- Parser e String
forall e. Parser e String
takeRest
  String -> Parser e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
cChar -> ShowS
forall k1. k1 -> [k1] -> [k1]
:String
cs)

-- | Get the rest of the input as a `String`, but restore the parsing state. Assumes UTF-8 encoding.
--   This can be used for debugging.
traceRest :: Parser e String
traceRest :: Parser e String
traceRest = Parser e String -> Parser e String
forall e a. Parser e a -> Parser e a
lookahead Parser e String
forall e. Parser e String
takeRest

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

-- | Convert an UTF-8-coded `B.ByteString` to a `String`.
unpackUTF8 :: B.ByteString -> String
unpackUTF8 :: ByteString -> String
unpackUTF8 ByteString
str = case Parser Any String -> ByteString -> Result Any String
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Any String
forall e. Parser e String
takeRest ByteString
str of
  OK String
a ByteString
_ -> String
a
  Result Any String
_      -> ShowS
forall a. HasCallStack => String -> a
error String
"unpackUTF8: invalid encoding"

-- | Check that the input has at least the given number of bytes.
ensureBytes# :: Int -> Parser e ()
ensureBytes# :: Int -> Parser e ()
ensureBytes# (I# Int#
len) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case Int#
len  Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s of
    Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () Addr#
s
    Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline ensureBytes# #-}

-- | Unsafely read a concrete byte from the input. It's not checked that the input has
--   enough bytes.
scan8# :: Word8 -> Parser e ()
scan8# :: Word8 -> Parser e ()
scan8# (W8# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
s Int#
0# of
    Word#
c' -> case Word# -> Word# -> Int#
eqWord8'# Word#
c Word#
c' of
      Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
      Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan8# #-}

-- | Unsafely read two concrete bytes from the input. It's not checked that the input has
--   enough bytes.
scan16# :: Word16 -> Parser e ()
scan16# :: Word16 -> Parser e ()
scan16# (W16# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case Addr# -> Int# -> Word#
indexWord16OffAddr# Addr#
s Int#
0# of
    Word#
c' -> case Word# -> Word# -> Int#
eqWord16'# Word#
c Word#
c' of
      Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
2#)
      Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan16# #-}

-- | Unsafely read four concrete bytes from the input. It's not checked that the input has
--   enough bytes.
scan32# :: Word32 -> Parser e ()
scan32# :: Word32 -> Parser e ()
scan32# (W32# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case Addr# -> Int# -> Word#
indexWord32OffAddr# Addr#
s Int#
0# of
    Word#
c' -> case Word# -> Word# -> Int#
eqWord32'# Word#
c Word#
c' of
      Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
4#)
      Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan32# #-}

-- | Unsafely read eight concrete bytes from the input. It's not checked that the input has
--   enough bytes.
scan64# :: Word -> Parser e ()
scan64# :: Word -> Parser e ()
scan64# (W# Word#
c) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case Addr# -> Int# -> Word#
indexWord64OffAddr# Addr#
s Int#
0# of
    Word#
c' -> case Word# -> Word# -> Int#
eqWord# Word#
c Word#
c' of
      Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
8#)
      Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scan64# #-}

-- | Unsafely read and return a byte from the input. It's not checked that the input is non-empty.
scanAny8# :: Parser e Word8
scanAny8# :: Parser e Word8
scanAny8# = (ForeignPtrContents -> Addr# -> Addr# -> Res# e Word8)
-> Parser e Word8
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Word8 -> Addr# -> Res# e Word8
forall a e. a -> Addr# -> Res# e a
OK# (Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
s Int#
0#)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#)
{-# inline scanAny8# #-}

scanPartial64# :: Int -> Word -> Parser e ()
scanPartial64# :: Int -> Word -> Parser e ()
scanPartial64# (I# Int#
len) (W# Word#
w) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  case Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
s Int#
0# of
    Word#
w' -> case Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
8# Int# -> Int# -> Int#
-# Int#
len) Int#
3# of
      Int#
sh -> case Word# -> Int# -> Word#
uncheckedShiftL# Word#
w' Int#
sh of
        Word#
w' -> case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w' Int#
sh of
          Word#
w' -> case Word# -> Word# -> Int#
eqWord# Word#
w Word#
w' of
            Int#
1# -> () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
len)
            Int#
_  -> Res# e ()
forall e a. Res# e a
Fail#
{-# inline scanPartial64# #-}

-- | Decrease the current input position by the given number of bytes.
setBack# :: Int -> Parser e ()
setBack# :: Int -> Parser e ()
setBack# (I# Int#
i) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ()) -> Parser e ()
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s ->
  () -> Addr# -> Res# e ()
forall a e. a -> Addr# -> Res# e a
OK# () (Addr# -> Int# -> Addr#
plusAddr# Addr#
s (Int# -> Int#
negateInt# Int#
i))
{-# inline setBack# #-}

-- | Template function, creates a @Parser e ()@ which unsafely scans a given
--   sequence of bytes.
scanBytes# :: [Word] -> Q Exp
scanBytes# :: [Word] -> Q Exp
scanBytes# [Word]
bytes = do
  let !([Word]
leading, [Word]
w8s) = [Word] -> ([Word], [Word])
splitBytes [Word]
bytes
      !scanw8s :: Q Exp
scanw8s        = [Word] -> Q Exp
forall t. Lift t => [t] -> Q Exp
go [Word]
w8s where
                         go :: [t] -> Q Exp
go (t
w8:[] ) = [| scan64# w8 |]
                         go (t
w8:[t]
w8s) = [| scan64# w8 >> $(go w8s) |]
                         go []       = [| pure () |]
  case [Word]
w8s of
    [] -> [Word] -> Q Exp
go [Word]
leading
          where
            go :: [Word] -> Q Exp
go (Word
a:Word
b:Word
c:Word
d:[]) = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b, Word
c, Word
d] in [| scan32# w |]
            go (Word
a:Word
b:Word
c:Word
d:[Word]
ws) = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b, Word
c, Word
d] in [| scan32# w >> $(go ws) |]
            go (Word
a:Word
b:[])     = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b]       in [| scan16# w |]
            go (Word
a:Word
b:[Word]
ws)     = let !w :: Word
w = [Word] -> Word
packBytes [Word
a, Word
b]       in [| scan16# w >> $(go ws) |]
            go (Word
a:[])       = [| scan8# a |]
            go []           = [| pure () |]
    [Word]
_  -> case [Word]
leading of

      []              -> Q Exp
scanw8s
      [Word
a]             -> [| scan8# a >> $scanw8s |]
      ws :: [Word]
ws@[Word
a, Word
b]       -> let !w :: Word
w = [Word] -> Word
packBytes [Word]
ws in [| scan16# w >> $scanw8s |]
      ws :: [Word]
ws@[Word
a, Word
b, Word
c, Word
d] -> let !w :: Word
w = [Word] -> Word
packBytes [Word]
ws in [| scan32# w >> $scanw8s |]
      [Word]
ws              -> let !w :: Word
w = [Word] -> Word
packBytes [Word]
ws
                             !l :: Int
l = [Word] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
ws
                         in [| scanPartial64# l w >> $scanw8s |]


-- Switching code generation
--------------------------------------------------------------------------------

#if MIN_VERSION_base(4,15,0)
mkDoE = DoE Nothing
{-# inline mkDoE #-}
#else
mkDoE :: [Stmt] -> Exp
mkDoE = [Stmt] -> Exp
DoE
{-# inline mkDoE #-}
#endif

genTrie :: (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int)) -> Q Exp
genTrie :: (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int)) -> Q Exp
genTrie (Map (Maybe Int) Exp
rules, Trie' (Maybe Int, Int, Maybe Int)
t) = do
  Map (Maybe Int) (Name, Exp)
branches <- (Exp -> Q (Name, Exp))
-> Map (Maybe Int) Exp -> Q (Map (Maybe Int) (Name, Exp))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Exp
e -> (,) (Name -> Exp -> (Name, Exp)) -> Q Name -> Q (Exp -> (Name, Exp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Q Name
newName String
"rule") Q (Exp -> (Name, Exp)) -> Q Exp -> Q (Name, Exp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
e) Map (Maybe Int) Exp
rules

  let ix :: Map a p -> a -> p
ix Map a p
m a
k = case a -> Map a p -> Maybe p
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
k Map a p
m of
        Maybe p
Nothing -> String -> p
forall a. HasCallStack => String -> a
error (String
"key not in map: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k)
        Just p
a  -> p
a

  let ensure :: Maybe Int -> Maybe (Q Exp)
      ensure :: Maybe Int -> Maybe (Q Exp)
ensure = (Int -> Q Exp) -> Maybe Int -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
n -> [| ensureBytes# n |])

      fallback :: Rule -> Int ->  Q Exp
      fallback :: Maybe Int -> Int -> Q Exp
fallback Maybe Int
rule Int
0 = Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ (Name, Exp) -> Name
forall a b. (a, b) -> a
fst ((Name, Exp) -> Name) -> (Name, Exp) -> Name
forall a b. (a -> b) -> a -> b
$ Map (Maybe Int) (Name, Exp) -> Maybe Int -> (Name, Exp)
forall a p. (Ord a, Show a) => Map a p -> a -> p
ix Map (Maybe Int) (Name, Exp)
branches Maybe Int
rule
      fallback Maybe Int
rule Int
n = [| setBack# n >> $(pure $ VarE $ fst $ ix branches rule) |]

  let go :: Trie' (Rule, Int, Maybe Int) -> Q Exp
      go :: Trie' (Maybe Int, Int, Maybe Int) -> Q Exp
go = \case
        Branch' (Maybe Int
r, Int
n, Maybe Int
alloc) Map Word (Trie' (Maybe Int, Int, Maybe Int))
ts
          | Map Word (Trie' (Maybe Int, Int, Maybe Int)) -> Bool
forall k a. Map k a -> Bool
M.null Map Word (Trie' (Maybe Int, Int, Maybe Int))
ts -> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ (Name, Exp) -> Name
forall a b. (a, b) -> a
fst ((Name, Exp) -> Name) -> (Name, Exp) -> Name
forall a b. (a -> b) -> a -> b
$ Map (Maybe Int) (Name, Exp)
branches Map (Maybe Int) (Name, Exp) -> Maybe Int -> (Name, Exp)
forall k a. Ord k => Map k a -> k -> a
M.! Maybe Int
r
          | Bool
otherwise -> do
              ![(Word, Exp)]
next         <- (((Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp))
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))] -> Q [(Word, Exp)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp))
 -> [(Word, Trie' (Maybe Int, Int, Maybe Int))] -> Q [(Word, Exp)])
-> ((Trie' (Maybe Int, Int, Maybe Int) -> Q Exp)
    -> (Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp))
-> (Trie' (Maybe Int, Int, Maybe Int) -> Q Exp)
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))]
-> Q [(Word, Exp)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trie' (Maybe Int, Int, Maybe Int) -> Q Exp)
-> (Word, Trie' (Maybe Int, Int, Maybe Int)) -> Q (Word, Exp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Trie' (Maybe Int, Int, Maybe Int) -> Q Exp
go (Map Word (Trie' (Maybe Int, Int, Maybe Int))
-> [(Word, Trie' (Maybe Int, Int, Maybe Int))]
forall k a. Map k a -> [(k, a)]
M.toList Map Word (Trie' (Maybe Int, Int, Maybe Int))
ts)
              !Exp
defaultCase  <- Maybe Int -> Int -> Q Exp
fallback Maybe Int
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

              let cases :: Exp
cases = [Stmt] -> Exp
mkDoE ([Stmt] -> Exp) -> [Stmt] -> Exp
forall a b. (a -> b) -> a -> b
$
                    [Pat -> Exp -> Stmt
BindS (Name -> Pat
VarP (String -> Name
mkName String
"c")) (Name -> Exp
VarE 'scanAny8#),
                      Exp -> Stmt
NoBindS (Exp -> [Match] -> Exp
CaseE (Name -> Exp
VarE (String -> Name
mkName String
"c"))
                         (((Word, Exp) -> Match) -> [(Word, Exp)] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map (\(Word
w, Exp
t) ->
                                 Pat -> Body -> [Dec] -> Match
Match (Lit -> Pat
LitP (Integer -> Lit
IntegerL (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)))
                                       (Exp -> Body
NormalB Exp
t)
                                       [])
                              [(Word, Exp)]
next
                          [Match] -> [Match] -> [Match]
forall a. [a] -> [a] -> [a]
++ [Pat -> Body -> [Dec] -> Match
Match Pat
WildP (Exp -> Body
NormalB Exp
defaultCase) []]))]

              case Maybe Int -> Maybe (Q Exp)
ensure Maybe Int
alloc of
                Maybe (Q Exp)
Nothing    -> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
cases
                Just Q Exp
alloc -> [| branch $alloc $(pure cases) $(fallback r n) |]

        Path (Maybe Int
r, Int
n, Maybe Int
alloc) [Word]
ws Trie' (Maybe Int, Int, Maybe Int)
t ->
          case Maybe Int -> Maybe (Q Exp)
ensure Maybe Int
alloc of
            Maybe (Q Exp)
Nothing    -> [| branch $(scanBytes# ws) $(go t) $(fallback r n)|]
            Just Q Exp
alloc -> [| branch ($alloc >> $(scanBytes# ws)) $(go t) $(fallback r n) |]

  [DecQ] -> Q Exp -> Q Exp
letE
    (((Name, Exp) -> DecQ) -> [(Name, Exp)] -> [DecQ]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
x, Exp
rhs) -> PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP Name
x) (Q Exp -> BodyQ
normalB (Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
rhs)) []) (Map (Maybe Int) (Name, Exp) -> [(Name, Exp)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Map (Maybe Int) (Name, Exp)
branches))
    (Trie' (Maybe Int, Int, Maybe Int) -> Q Exp
go Trie' (Maybe Int, Int, Maybe Int)
t)

parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)
parseSwitch :: Q Exp -> Q ([(String, Exp)], Maybe Exp)
parseSwitch Q Exp
exp = Q Exp
exp Q Exp
-> (Exp -> Q ([(String, Exp)], Maybe Exp))
-> Q ([(String, Exp)], Maybe Exp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  CaseE (UnboundVarE Name
_) []    -> String -> Q ([(String, Exp)], Maybe Exp)
forall a. HasCallStack => String -> a
error String
"switch: empty clause list"
  CaseE (UnboundVarE Name
_) [Match]
cases -> do
    (![Match]
cases, !Match
last) <- ([Match], Match) -> Q ([Match], Match)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Match] -> [Match]
forall a. [a] -> [a]
init [Match]
cases, [Match] -> Match
forall a. [a] -> a
last [Match]
cases)
    ![(String, Exp)]
cases <- [Match] -> (Match -> Q (String, Exp)) -> Q [(String, Exp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Match]
cases \case
      Match (LitP (StringL String
str)) (NormalB Exp
rhs) [] -> (String, Exp) -> Q (String, Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
str, Exp
rhs)
      Match
_ -> String -> Q (String, Exp)
forall a. HasCallStack => String -> a
error String
"switch: expected a match clause on a string literal"
    (![(String, Exp)]
cases, !Maybe Exp
last) <- case Match
last of
      Match (LitP (StringL String
str)) (NormalB Exp
rhs) [] -> ([(String, Exp)], Maybe Exp) -> Q ([(String, Exp)], Maybe Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Exp)]
cases [(String, Exp)] -> [(String, Exp)] -> [(String, Exp)]
forall a. [a] -> [a] -> [a]
++ [(String
str, Exp
rhs)], Maybe Exp
forall k1. Maybe k1
Nothing)
      Match Pat
WildP                (NormalB Exp
rhs) [] -> ([(String, Exp)], Maybe Exp) -> Q ([(String, Exp)], Maybe Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Exp)]
cases, Exp -> Maybe Exp
forall k1. k1 -> Maybe k1
Just Exp
rhs)
      Match
_ -> String -> Q ([(String, Exp)], Maybe Exp)
forall a. HasCallStack => String -> a
error String
"switch: expected a match clause on a string literal or a wildcard"
    ([(String, Exp)], Maybe Exp) -> Q ([(String, Exp)], Maybe Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Exp)]
cases, Maybe Exp
last)
  Exp
_ -> String -> Q ([(String, Exp)], Maybe Exp)
forall a. HasCallStack => String -> a
error String
"switch: expected a \"case _ of\" expression"

genSwitchTrie' :: Maybe Exp -> [(String, Exp)] -> Maybe Exp
              -> (Map (Maybe Int) Exp, Trie' (Rule, Int, Maybe Int))
genSwitchTrie' :: Maybe Exp
-> [(String, Exp)]
-> Maybe Exp
-> (Map (Maybe Int) Exp, Trie' (Maybe Int, Int, Maybe Int))
genSwitchTrie' Maybe Exp
postAction [(String, Exp)]
cases Maybe Exp
fallback =

  let (![(Maybe Int, Exp)]
branches, ![(Int, String)]
strings) = [((Maybe Int, Exp), (Int, String))]
-> ([(Maybe Int, Exp)], [(Int, String)])
forall a b. [(a, b)] -> ([a], [b])
unzip do
        (!Int
i, (!String
str, !Exp
rhs)) <- [Int] -> [(String, Exp)] -> [(Int, (String, Exp))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(String, Exp)]
cases
        case Maybe Exp
postAction of
          Maybe Exp
Nothing    -> ((Maybe Int, Exp), (Int, String))
-> [((Maybe Int, Exp), (Int, String))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Maybe Int
forall k1. k1 -> Maybe k1
Just Int
i, Exp
rhs), (Int
i, String
str))
          Just !Exp
post -> ((Maybe Int, Exp), (Int, String))
-> [((Maybe Int, Exp), (Int, String))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Maybe Int
forall k1. k1 -> Maybe k1
Just Int
i, (Name -> Exp
VarE '(>>)) Exp -> Exp -> Exp
`AppE` Exp
post Exp -> Exp -> Exp
`AppE` Exp
rhs), (Int
i, String
str))

      !m :: Map (Maybe Int) Exp
m    = [(Maybe Int, Exp)] -> Map (Maybe Int) Exp
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Maybe Int
forall k1. Maybe k1
Nothing, Exp -> (Exp -> Exp) -> Maybe Exp -> Exp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> Exp
VarE 'empty) Exp -> Exp
forall a. a -> a
id Maybe Exp
fallback) (Maybe Int, Exp) -> [(Maybe Int, Exp)] -> [(Maybe Int, Exp)]
forall k1. k1 -> [k1] -> [k1]
: [(Maybe Int, Exp)]
branches)
      !trie :: Trie' (Maybe Int, Int, Maybe Int)
trie = [(Int, String)] -> Trie' (Maybe Int, Int, Maybe Int)
compileTrie [(Int, String)]
strings
  in (Map (Maybe Int) Exp
m , Trie' (Maybe Int, Int, Maybe Int)
trie)

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

withAnyWord8# :: (Word8'# -> Parser e a) -> Parser e a
withAnyWord8# :: (Word# -> Parser e a) -> Parser e a
withAnyWord8# Word# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
  Int#
1# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
buf Int#
0# of
    Word#
w# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Word# -> Parser e a
p Word#
w#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
{-# inline withAnyWord8# #-}

withAnyWord16# :: (Word16'# -> Parser e a) -> Parser e a
withAnyWord16# :: (Word# -> Parser e a) -> Parser e a
withAnyWord16# Word# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
2# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
  Int#
0# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Word#
indexWord16OffAddr# Addr#
buf Int#
0# of
    Word#
w# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Word# -> Parser e a
p Word#
w#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
{-# inline withAnyWord16# #-}

withAnyWord32# :: (Word32'# -> Parser e a) -> Parser e a
withAnyWord32# :: (Word# -> Parser e a) -> Parser e a
withAnyWord32# Word# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
4# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
  Int#
0# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Word#
indexWord32OffAddr# Addr#
buf Int#
0# of
    Word#
w# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Word# -> Parser e a
p Word#
w#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
{-# inline withAnyWord32# #-}

withAnyWord64# :: (Word# -> Parser e a) -> Parser e a
withAnyWord64# :: (Word# -> Parser e a) -> Parser e a
withAnyWord64# Word# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
8# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
  Int#
0# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
buf Int#
0# of
    Word#
w# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Word# -> Parser e a
p Word#
w#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
8#)
{-# inline withAnyWord64# #-}

withAnyInt8# :: (Int8'# -> Parser e a) -> Parser e a
withAnyInt8# :: (Int# -> Parser e a) -> Parser e a
withAnyInt8# Int# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
buf of
  Int#
1# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Int#
indexInt8OffAddr# Addr#
buf Int#
0# of
    Int#
i# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Int# -> Parser e a
p Int#
i#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
1#)
{-# inline withAnyInt8# #-}

withAnyInt16# :: (Int16'# -> Parser e a) -> Parser e a
withAnyInt16# :: (Int# -> Parser e a) -> Parser e a
withAnyInt16# Int# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
2# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
  Int#
0# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Int#
indexInt16OffAddr# Addr#
buf Int#
0# of
    Int#
i# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Int# -> Parser e a
p Int#
i#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
2#)
{-# inline withAnyInt16# #-}

withAnyInt32# :: (Int32'# -> Parser e a) -> Parser e a
withAnyInt32# :: (Int# -> Parser e a) -> Parser e a
withAnyInt32# Int# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
4# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
  Int#
0# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Int#
indexInt32OffAddr# Addr#
buf Int#
0# of
    Int#
i# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Int# -> Parser e a
p Int#
i#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
4#)
{-# inline withAnyInt32# #-}

withAnyInt64# :: (Int# -> Parser e a) -> Parser e a
withAnyInt64# :: (Int# -> Parser e a) -> Parser e a
withAnyInt64# Int# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
buf -> case Int#
8# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
buf of
  Int#
0# -> Res# e a
forall e a. Res# e a
Fail#
  Int#
_  -> case Addr# -> Int# -> Int#
indexInt64OffAddr# Addr#
buf Int#
0# of
    Int#
i# -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Int# -> Parser e a
p Int#
i#) ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
buf Int#
8#)
{-# inline withAnyInt64# #-}

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

-- | Parse any 'Word8' (byte).
anyWord8 :: Parser e Word8
anyWord8 :: Parser e Word8
anyWord8 = (Word# -> Parser e Word8) -> Parser e Word8
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord8# (\Word#
w# -> Word8 -> Parser e Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word8
W8# Word#
w#))
{-# inline anyWord8 #-}

-- | Skip any 'Word8' (byte).
anyWord8_ :: Parser e ()
anyWord8_ :: Parser e ()
anyWord8_ = () () -> Parser e Word8 -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word8
forall e. Parser e Word8
anyWord8
{-# inline anyWord8_ #-}

-- | Parse any 'Word16'.
anyWord16 :: Parser e Word16
anyWord16 :: Parser e Word16
anyWord16 = (Word# -> Parser e Word16) -> Parser e Word16
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord16# (\Word#
w# -> Word16 -> Parser e Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word16
W16# Word#
w#))
{-# inline anyWord16 #-}

-- | Skip any 'Word16'.
anyWord16_ :: Parser e ()
anyWord16_ :: Parser e ()
anyWord16_ = () () -> Parser e Word16 -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word16
forall e. Parser e Word16
anyWord16
{-# inline anyWord16_ #-}

-- | Parse any 'Word32'.
anyWord32 :: Parser e Word32
anyWord32 :: Parser e Word32
anyWord32 = (Word# -> Parser e Word32) -> Parser e Word32
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord32# (\Word#
w# -> Word32 -> Parser e Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word32
W32# Word#
w#))
{-# inline anyWord32 #-}

-- | Skip any 'Word32'.
anyWord32_ :: Parser e ()
anyWord32_ :: Parser e ()
anyWord32_ = () () -> Parser e Word32 -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word32
forall e. Parser e Word32
anyWord32
{-# inline anyWord32_ #-}

-- | Parse any 'Word64'.
anyWord64 :: Parser e Word64
anyWord64 :: Parser e Word64
anyWord64 = (Word# -> Parser e Word64) -> Parser e Word64
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord64# (\Word#
w# -> Word64 -> Parser e Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word64
W64# Word#
w#))
{-# inline anyWord64 #-}

-- | Skip any 'Word64'.
anyWord64_ :: Parser e ()
anyWord64_ :: Parser e ()
anyWord64_ = () () -> Parser e Word64 -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word64
forall e. Parser e Word64
anyWord64
{-# inline anyWord64_ #-}

-- | Parse any 'Word'.
anyWord :: Parser e Word
anyWord :: Parser e Word
anyWord = (Word# -> Parser e Word) -> Parser e Word
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord64# (\Word#
w# -> Word -> Parser e Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word
W# Word#
w#))
{-# inline anyWord #-}

-- | Skip any 'Word'.
anyWord_ :: Parser e ()
anyWord_ :: Parser e ()
anyWord_ = () () -> Parser e Word -> Parser e ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser e Word
forall e. Parser e Word
anyWord
{-# inline anyWord_ #-}

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

-- | Parse any 'Int8'.
anyInt8 :: Parser e Int8
anyInt8 :: Parser e Int8
anyInt8 = (Int# -> Parser e Int8) -> Parser e Int8
forall e a. (Int# -> Parser e a) -> Parser e a
withAnyInt8# (\Int#
i# -> Int8 -> Parser e Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int8
I8# Int#
i#))
{-# inline anyInt8 #-}

-- | Parse any 'Int16'.
anyInt16 :: Parser e Int16
anyInt16 :: Parser e Int16
anyInt16 = (Int# -> Parser e Int16) -> Parser e Int16
forall e a. (Int# -> Parser e a) -> Parser e a
withAnyInt16# (\Int#
i# -> Int16 -> Parser e Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int16
I16# Int#
i#))
{-# inline anyInt16 #-}

-- | Parse any 'Int32'.
anyInt32 :: Parser e Int32
anyInt32 :: Parser e Int32
anyInt32 = (Int# -> Parser e Int32) -> Parser e Int32
forall e a. (Int# -> Parser e a) -> Parser e a
withAnyInt32# (\Int#
i# -> Int32 -> Parser e Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int32
I32# Int#
i#))
{-# inline anyInt32 #-}

-- | Parse any 'Int64'.
anyInt64 :: Parser e Int64
anyInt64 :: Parser e Int64
anyInt64 = (Int# -> Parser e Int64) -> Parser e Int64
forall e a. (Int# -> Parser e a) -> Parser e a
withAnyInt64# (\Int#
i# -> Int64 -> Parser e Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int64
I64# Int#
i#))
{-# inline anyInt64 #-}

-- | Parse any 'Int'.
anyInt :: Parser e Int
anyInt :: Parser e Int
anyInt = (Int# -> Parser e Int) -> Parser e Int
forall e a. (Int# -> Parser e a) -> Parser e a
withAnyInt64# (\Int#
i# -> Int -> Parser e Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int
I# Int#
i#))
{-# inline anyInt #-}

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

-- | Parse any 'Word16' (little-endian).
anyWord16le :: Parser e Word16
anyWord16le :: Parser e Word16
anyWord16le = Parser e Word16
forall e. Parser e Word16
anyWord16
{-# inline anyWord16le #-}

-- | Parse any 'Word16' (big-endian).
anyWord16be :: Parser e Word16
anyWord16be :: Parser e Word16
anyWord16be = (Word# -> Parser e Word16) -> Parser e Word16
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord16# (\Word#
w# -> Word16 -> Parser e Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word16
W16# (Word# -> Word#
byteSwap16'# Word#
w#)))
{-# inline anyWord16be #-}

-- | Parse any 'Word32' (little-endian).
anyWord32le :: Parser e Word32
anyWord32le :: Parser e Word32
anyWord32le = Parser e Word32
forall e. Parser e Word32
anyWord32
{-# inline anyWord32le #-}

-- | Parse any 'Word32' (big-endian).
anyWord32be :: Parser e Word32
anyWord32be :: Parser e Word32
anyWord32be = (Word# -> Parser e Word32) -> Parser e Word32
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord32# (\Word#
w# -> Word32 -> Parser e Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word32
W32# (Word# -> Word#
byteSwap32'# Word#
w#)))
{-# inline anyWord32be #-}

-- | Parse any 'Word64' (little-endian).
anyWord64le :: Parser e Word64
anyWord64le :: Parser e Word64
anyWord64le = Parser e Word64
forall e. Parser e Word64
anyWord64
{-# inline anyWord64le #-}

-- | Parse any 'Word64' (big-endian).
anyWord64be :: Parser e Word64
anyWord64be :: Parser e Word64
anyWord64be = (Word# -> Parser e Word64) -> Parser e Word64
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord64# (\Word#
w# -> Word64 -> Parser e Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word# -> Word64
W64# (Word# -> Word#
byteSwap# Word#
w#)))
{-# inline anyWord64be #-}

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

-- | Parse any 'Int16' (little-endian).
anyInt16le :: Parser e Int16
anyInt16le :: Parser e Int16
anyInt16le = Parser e Int16
forall e. Parser e Int16
anyInt16
{-# inline anyInt16le #-}

-- | Parse any 'Int16' (big-endian).
anyInt16be :: Parser e Int16
anyInt16be :: Parser e Int16
anyInt16be = (Word# -> Parser e Int16) -> Parser e Int16
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord16# (\Word#
w# -> Int16 -> Parser e Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int16
I16# (Word# -> Int#
word16ToInt16# (Word# -> Word#
byteSwap16'# Word#
w#))))
{-# inline anyInt16be #-}

-- | Parse any 'Int32' (little-endian).
anyInt32le :: Parser e Int32
anyInt32le :: Parser e Int32
anyInt32le = Parser e Int32
forall e. Parser e Int32
anyInt32
{-# inline anyInt32le #-}

-- | Parse any 'Int32' (big-endian).
anyInt32be :: Parser e Int32
anyInt32be :: Parser e Int32
anyInt32be = (Word# -> Parser e Int32) -> Parser e Int32
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord32# (\Word#
w# -> Int32 -> Parser e Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int32
I32# (Word# -> Int#
word32ToInt32# (Word# -> Word#
byteSwap32'# Word#
w#))))
{-# inline anyInt32be #-}

-- | Parse any 'Int64' (little-endian).
anyInt64le :: Parser e Int64
anyInt64le :: Parser e Int64
anyInt64le = Parser e Int64
forall e. Parser e Int64
anyInt64
{-# inline anyInt64le #-}

-- | Parse any 'Int64' (big-endian).
anyInt64be :: Parser e Int64
anyInt64be :: Parser e Int64
anyInt64be = (Word# -> Parser e Int64) -> Parser e Int64
forall e a. (Word# -> Parser e a) -> Parser e a
withAnyWord64# (\Word#
w# -> Int64 -> Parser e Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int# -> Int64
I64# (Word# -> Int#
word2Int# (Word# -> Word#
byteSwap# Word#
w#))))
{-# inline anyInt64be #-}

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

-- | Skip forward @n@ bytes and run the given parser. Fails if fewer than @n@
--   bytes are available.
--
-- Throws a runtime error if given a negative integer.
atSkip# :: Int# -> Parser e a -> Parser e a
atSkip# :: Int# -> Parser e a -> Parser e a
atSkip# Int#
os# (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
p) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Int#
os# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s of
  Int#
1# -> case Int#
os# Int# -> Int# -> Int#
>=# Int#
0# of
    Int#
1# -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
p ForeignPtrContents
fp Addr#
eob (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
os#)
    Int#
_  -> String -> Res# e a
forall a. HasCallStack => String -> a
error String
"FlatParse.Basic.atSkip#: negative integer"
  Int#
_  -> Res# e a
forall e a. Res# e a
Fail#
{-# inline atSkip# #-}

-- | Read the given number of bytes as a 'ByteString'.
--
-- Throws a runtime error if given a negative integer.
takeBs# :: Int# -> Parser e B.ByteString
takeBs# :: Int# -> Parser e ByteString
takeBs# Int#
n# = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString)
-> Parser e ByteString
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> case Int#
n# Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s of
  Int#
1# -> -- have to runtime check for negative values, because they cause a hang
    case Int#
n# Int# -> Int# -> Int#
>=# Int#
0# of
      Int#
1# -> ByteString -> Addr# -> Res# e ByteString
forall a e. a -> Addr# -> Res# e a
OK# (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s ForeignPtrContents
fp) Int
0 (Int# -> Int
I# Int#
n#)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
n#)
      Int#
_  -> String -> Res# e ByteString
forall a. HasCallStack => String -> a
error String
"FlatParse.Basic.takeBs: negative integer"
  Int#
_  -> Res# e ByteString
forall e a. Res# e a
Fail#
{-# inline takeBs# #-}

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

-- | Run a parser, passing it the current address the parser is at.
--
-- Useful for parsing offset-based data tables. For example, you may use this to
-- save the base address to use together with various 0-indexed offsets.
withAddr# :: (Addr# -> Parser e a) -> Parser e a
withAddr# :: (Addr# -> Parser e a) -> Parser e a
withAddr# Addr# -> Parser e a
p = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
forall e a.
Parser e a -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
runParser# (Addr# -> Parser e a
p Addr#
s) ForeignPtrContents
fp Addr#
eob Addr#
s
{-# inline withAddr# #-}

-- | @takeBsOffAddr# addr# offset# len#@ moves to @addr#@, skips @offset#@
--   bytes, reads @len#@ bytes into a 'ByteString', and restores the original
--   address.
--
-- The 'Addr#' should be from 'withAddr#'.
--
-- Useful for parsing offset-based data tables. For example, you may use this
-- together with 'withAddr#' to jump to an offset in your input and read some
-- data.
takeBsOffAddr# :: Addr# -> Int# -> Int# -> Parser e B.ByteString
takeBsOffAddr# :: Addr# -> Int# -> Int# -> Parser e ByteString
takeBsOffAddr# Addr#
addr# Int#
offset# Int#
len# =
    Addr# -> Parser e ByteString -> Parser e ByteString
forall e a. Addr# -> Parser e a -> Parser e a
lookaheadFromAddr# Addr#
addr# (Parser e ByteString -> Parser e ByteString)
-> Parser e ByteString -> Parser e ByteString
forall a b. (a -> b) -> a -> b
$ Int# -> Parser e ByteString -> Parser e ByteString
forall e a. Int# -> Parser e a -> Parser e a
atSkip# Int#
offset# (Parser e ByteString -> Parser e ByteString)
-> Parser e ByteString -> Parser e ByteString
forall a b. (a -> b) -> a -> b
$ Int# -> Parser e ByteString
forall e. Int# -> Parser e ByteString
takeBs# Int#
len#
{-# inline takeBsOffAddr# #-}

-- | 'lookahead', but specify the address to lookahead from.
--
-- The 'Addr#' should be from 'withAddr#'.
lookaheadFromAddr# :: Addr# -> Parser e a -> Parser e a
lookaheadFromAddr# :: Addr# -> Parser e a -> Parser e a
lookaheadFromAddr# Addr#
s = Parser e a -> Parser e a
forall e a. Parser e a -> Parser e a
lookahead (Parser e a -> Parser e a)
-> (Parser e a -> Parser e a) -> Parser e a -> Parser e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr# -> Parser e a -> Parser e a
forall e a. Addr# -> Parser e a -> Parser e a
atAddr# Addr#
s
{-# inline lookaheadFromAddr# #-}

-- | Run a parser at the given address.
--
-- The 'Addr#' should be from 'withAddr#'.
--
-- This is a highly internal function -- you likely want 'lookaheadFromAddr#',
-- which will reset the address after running the parser.
atAddr# :: Addr# -> Parser e a -> Parser e a
atAddr# :: Addr# -> Parser e a -> Parser e a
atAddr# Addr#
s (Parser ForeignPtrContents -> Addr# -> Addr# -> Res# e a
p) = (ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
_ -> ForeignPtrContents -> Addr# -> Addr# -> Res# e a
p ForeignPtrContents
fp Addr#
eob Addr#
s
{-# inline atAddr# #-}

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

-- | Read a null-terminated bytestring (a C-style string).
--
-- Consumes the null terminator.
anyCString :: Parser e B.ByteString
anyCString :: Parser e ByteString
anyCString = (ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString)
-> Parser e ByteString
forall e a.
(ForeignPtrContents -> Addr# -> Addr# -> Res# e a) -> Parser e a
Parser \ForeignPtrContents
fp Addr#
eob Addr#
s -> ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString
forall e. ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString
go' ForeignPtrContents
fp Addr#
eob Addr#
s
  where
    go' :: ForeignPtrContents -> Addr# -> Addr# -> Res# e ByteString
go' ForeignPtrContents
fp Addr#
eob Addr#
s0 = Int# -> Addr# -> Res# e ByteString
forall e. Int# -> Addr# -> Res# e ByteString
go Int#
0# Addr#
s0
      where
        go :: Int# -> Addr# -> Res# e ByteString
go Int#
n# Addr#
s = case Addr# -> Addr# -> Int#
eqAddr# Addr#
eob Addr#
s of
          Int#
1# -> Res# e ByteString
forall e a. Res# e a
Fail#
          Int#
_  ->
            let s' :: Addr#
s' = Addr# -> Int# -> Addr#
plusAddr# Addr#
s Int#
1#
            -- TODO below is a candidate for improving with ExtendedLiterals!
            in  case Word8# -> Word8# -> Int#
eqWord8# (Addr# -> Int# -> Word8#
indexWord8OffAddr''# Addr#
s Int#
0#) (Word# -> Word8#
wordToWord8''# Word#
0##) of
                  Int#
1# -> ByteString -> Addr# -> Res# e ByteString
forall a e. a -> Addr# -> Res# e a
OK# (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
s0 ForeignPtrContents
fp) Int
0 (Int# -> Int
I# Int#
n#)) Addr#
s'
                  Int#
_  -> Int# -> Addr# -> Res# e ByteString
go (Int#
n# Int# -> Int# -> Int#
+# Int#
1#) Addr#
s'
{-# inline anyCString #-}

-- | Read a null-terminated bytestring (a C-style string), where the bytestring
--   is known to be null-terminated somewhere in the input.
--
-- Highly unsafe. Unless you have a guarantee that the string will be null
-- terminated before the input ends, use 'anyCString' instead. Honestly, I'm not
-- sure if this is a good function to define. But here it is.
--
-- Fails on GHC versions older than 9.0, since we make use of the
-- 'cstringLength#' primop introduced in GHC 9.0, and we aren't very useful
-- without it.
--
-- Consumes the null terminator.
anyCStringUnsafe :: Parser e B.ByteString
{-# inline anyCStringUnsafe #-}
#if MIN_VERSION_base(4,15,0)
anyCStringUnsafe = Parser \fp eob s ->
  case eqAddr# eob s of
    1# -> Fail#
    _  -> let n#  = cstringLength# s
              s'# = plusAddr# s (n# +# 1#)
           in OK# (B.PS (ForeignPtr s fp) 0 (I# n#)) s'#
#else
anyCStringUnsafe :: Parser e ByteString
anyCStringUnsafe = String -> Parser e ByteString
forall a. HasCallStack => String -> a
error String
"Flatparse.Basic.anyCStringUnsafe: requires GHC 9.0 / base-4.15, not available on this compiler"
#endif