{-# language CPP #-}
{-# language PatternSynonyms #-}
{-# language OverloadedStrings #-}
{-# language MagicHash #-}
{-# language TypeFamilies #-}
{-# language UnboxedSums #-}
{-# language StandaloneDeriving #-}
{-# language UnboxedTuples #-}
{-# language ImplicitParams #-}
{-# language ConstraintKinds #-}
{-# language LambdaCase #-}
{-# language ScopedTypeVariables #-}
{-# language RankNTypes #-}
{-# language BangPatterns #-}
{-# language ForeignFunctionInterface #-}
{-# language KindSignatures #-}
{-# language UnliftedFFITypes #-}
{-# language TypeApplications #-}
{-# language AllowAmbiguousTypes #-}
{-# language BlockArguments #-}
{-# language ViewPatterns #-}
{-# language UnboxedTuples #-}
{-# language MagicHash #-}
{-# language PatternSynonyms #-}
{-# language UnliftedNewtypes #-}
{-# options_ghc -O2 #-}

module Text.Parsnip.Internal.Parser
(
-- * Parser
  Parser(..)
, Option(Option#,Some,None)
, mapOption, setOption
, Result, pattern OK, pattern Fail
, mapResult, setResult
, try
-- * Unsafe literals
, lit, litN, word8
-- * Guts
, Base(..), bytes, start, end
, KnownBase(..)
, parse
) where

import Control.Applicative
import Control.Monad
import Control.Monad.Primitive
import qualified Data.ByteString as B
import Data.ByteString.Internal (ByteString(..))
import qualified Data.ByteString.Internal as B
import Data.Primitive.ByteArray
import Data.String
import Foreign.C.Types
import Foreign.ForeignPtr
import GHC.ForeignPtr
import GHC.Prim
import GHC.Ptr
import GHC.Types
import GHC.Word
import System.IO.Unsafe

import Text.Parsnip.Location
import Text.Parsnip.Internal.Private

--------------------------------------------------------------------------------
-- * Option
--------------------------------------------------------------------------------

-- | Unlifted 'Maybe'
newtype Option a = Option# (# a | (##) #)

pattern Some :: a -> Option a
pattern $bSome :: forall a. a -> Option a
$mSome :: forall {r} {a}. Option a -> (a -> r) -> (Void# -> r) -> r
Some a = Option# (# a | #)

pattern None :: Option a
pattern $bNone :: Void# -> forall a. Option a
$mNone :: forall {r} {a}. Option a -> (Void# -> r) -> (Void# -> r) -> r
None = Option# (# | (##) #)

{-# complete Some, None #-} -- these don't work outside this module =(

mapOption :: (a -> b) -> Option a -> Option b
mapOption :: forall a b. (a -> b) -> Option a -> Option b
mapOption a -> b
f (Some a
a) = b -> Option b
forall a. a -> Option a
Some (b -> Option b) -> b -> Option b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
mapOption a -> b
_ Option a
None = Option b
forall a. Option a
None
{-# inline mapOption #-}

setOption :: b -> Option a -> Option b
setOption :: forall b a. b -> Option a -> Option b
setOption b
b (Some a
_) = b -> Option b
forall a. a -> Option a
Some b
b
setOption b
_ Option a
None = Option b
forall a. Option a
None
{-# inline setOption #-}

--------------------------------------------------------------------------------
-- * Result
--------------------------------------------------------------------------------

type Result s a = (# Option a, Addr#, State# s #)

pattern OK :: a -> Addr# -> State# s -> Result s a
pattern $bOK :: forall a s. a -> Addr# -> State# s -> Result s a
$mOK :: forall {r} {a} {s}.
Result s a -> (a -> Addr# -> State# s -> r) -> (Void# -> r) -> r
OK a p s = (# Some a, p, s #)

pattern Fail :: Addr# -> State# s -> Result s a
pattern $bFail :: forall s a. Addr# -> State# s -> Result s a
$mFail :: forall {r} {s} {a}.
Result s a -> (Addr# -> State# s -> r) -> (Void# -> r) -> r
Fail p s = (# None, p, s #)

{-# complete OK, Fail #-}

mapResult :: (a -> b) -> Result s a -> Result s b
mapResult :: forall a b s. (a -> b) -> Result s a -> Result s b
mapResult a -> b
f (# Option a
o, Addr#
p, State# s
s #) = (# (a -> b) -> Option a -> Option b
forall a b. (a -> b) -> Option a -> Option b
mapOption a -> b
f Option a
o, Addr#
p, State# s
s #)
{-# inline mapResult #-}

setResult :: b -> Result s a -> Result s b
setResult :: forall b s a. b -> Result s a -> Result s b
setResult b
b (# Option a
o, Addr#
p, State# s
s #) = (# b -> Option a -> Option b
forall b a. b -> Option a -> Option b
setOption b
b Option a
o, Addr#
p, State# s
s #)
{-# inline setResult #-}

--------------------------------------------------------------------------------
-- * Result
--------------------------------------------------------------------------------

newtype Parser s a = Parser
 { forall s a. Parser s a -> Addr# -> State# s -> Result s a
runParser :: Addr# -> State# s -> Result s a
 }

instance Functor (Parser s) where
  fmap :: forall a b. (a -> b) -> Parser s a -> Parser s b
fmap a -> b
f (Parser Addr# -> State# s -> Result s a
m) = (Addr# -> State# s -> Result s b) -> Parser s b
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \ Addr#
p State# s
s -> (a -> b) -> Result s a -> Result s b
forall a b s. (a -> b) -> Result s a -> Result s b
mapResult a -> b
f (Addr# -> State# s -> Result s a
m Addr#
p State# s
s)
  {-# inline fmap #-}
  a
b <$ :: forall a b. a -> Parser s b -> Parser s a
<$ Parser Addr# -> State# s -> Result s b
m = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \ Addr#
p State# s
s -> case Addr# -> State# s -> Result s b
m Addr#
p State# s
s of
    OK b
_ Addr#
q State# s
t -> a -> Addr# -> State# s -> Result s a
forall a s. a -> Addr# -> State# s -> Result s a
OK a
b Addr#
q State# s
t
    Fail Addr#
q State# s
t -> Addr# -> State# s -> Result s a
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
q State# s
t
  {-# inline (<$) #-}

instance Applicative (Parser s) where
  pure :: forall a. a -> Parser s a
pure a
a = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \ Addr#
p State# s
s -> a -> Addr# -> State# s -> Result s a
forall a s. a -> Addr# -> State# s -> Result s a
OK a
a Addr#
p State# s
s
  {-# inline pure #-}
  Parser Addr# -> State# s -> Result s (a -> b)
m <*> :: forall a b. Parser s (a -> b) -> Parser s a -> Parser s b
<*> Parser Addr# -> State# s -> Result s a
n = (Addr# -> State# s -> Result s b) -> Parser s b
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> State# s -> Result s (a -> b)
m Addr#
p State# s
s of
    Fail Addr#
q State# s
t -> Addr# -> State# s -> Result s b
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
q State# s
t
    OK a -> b
f Addr#
q State# s
t -> (a -> b) -> Result s a -> Result s b
forall a b s. (a -> b) -> Result s a -> Result s b
mapResult a -> b
f (Addr# -> State# s -> Result s a
n Addr#
q State# s
t)
  {-# inline (<*>) #-}
  Parser Addr# -> State# s -> Result s a
m *> :: forall a b. Parser s a -> Parser s b -> Parser s b
*> Parser Addr# -> State# s -> Result s b
n = (Addr# -> State# s -> Result s b) -> Parser s b
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> State# s -> Result s a
m Addr#
p State# s
s of
    Fail Addr#
q State# s
t -> Addr# -> State# s -> Result s b
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
q State# s
t
    OK a
_ Addr#
q State# s
t -> Addr# -> State# s -> Result s b
n Addr#
q State# s
t
  {-# inline (*>) #-}
  Parser Addr# -> State# s -> Result s a
m <* :: forall a b. Parser s a -> Parser s b -> Parser s a
<* Parser Addr# -> State# s -> Result s b
n = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> State# s -> Result s a
m Addr#
p State# s
s of
    OK a
a Addr#
q State# s
t -> a -> Result s b -> Result s a
forall b s a. b -> Result s a -> Result s b
setResult a
a (Addr# -> State# s -> Result s b
n Addr#
q State# s
t)
    Result s a
x -> Result s a
x
  {-# inline (<*) #-}

instance Monad (Parser s) where
  Parser Addr# -> State# s -> Result s a
m >>= :: forall a b. Parser s a -> (a -> Parser s b) -> Parser s b
>>= a -> Parser s b
f = (Addr# -> State# s -> Result s b) -> Parser s b
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> State# s -> Result s a
m Addr#
p State# s
s of
    Fail Addr#
q State# s
t -> Addr# -> State# s -> Result s b
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
q State# s
t
    OK a
a Addr#
q State# s
t -> Parser s b -> Addr# -> State# s -> Result s b
forall s a. Parser s a -> Addr# -> State# s -> Result s a
runParser (a -> Parser s b
f a
a) Addr#
q State# s
t
  {-# inline (>>=) #-}
  >> :: forall a b. Parser s a -> Parser s b -> Parser s b
(>>) = Parser s a -> Parser s b -> Parser s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# inline (>>) #-}
#if !MIN_VERSION_base(4,13,0)
  fail _ = Parser Fail
  {-# inline fail #-}
#endif

instance Alternative (Parser s) where
  Parser Addr# -> State# s -> Result s a
m <|> :: forall a. Parser s a -> Parser s a -> Parser s a
<|> Parser Addr# -> State# s -> Result s a
n = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \ Addr#
p State# s
s -> case Addr# -> State# s -> Result s a
m Addr#
p State# s
s of
    Fail Addr#
_ State# s
t -> Addr# -> State# s -> Result s a
n Addr#
p State# s
t
    OK a
a Addr#
q State# s
t -> a -> Addr# -> State# s -> Result s a
forall a s. a -> Addr# -> State# s -> Result s a
OK a
a Addr#
q State# s
t
  {-# inline (<|>) #-}
  empty :: forall a. Parser s a
empty = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser Addr# -> State# s -> Result s a
forall s a. Addr# -> State# s -> Result s a
Fail
  {-# inline empty #-}

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

instance PrimMonad (Parser s) where
  type PrimState (Parser s) = s
  primitive :: forall a.
(State# (PrimState (Parser s))
 -> (# State# (PrimState (Parser s)), a #))
-> Parser s a
primitive State# (PrimState (Parser s))
-> (# State# (PrimState (Parser s)), a #)
f = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case State# (PrimState (Parser s))
-> (# State# (PrimState (Parser s)), a #)
f State# s
State# (PrimState (Parser s))
s of
    (# State# (PrimState (Parser s))
t, a
a #) -> a -> Addr# -> State# s -> Result s a
forall a s. a -> Addr# -> State# s -> Result s a
OK a
a Addr#
p State# s
State# (PrimState (Parser s))
t
  {-# inline primitive #-}

-- perhaps this interface is a little low level. hrmm
instance a ~ ByteString => IsString (Parser s a) where
  fromString :: String -> Parser s a
fromString String
"" = ByteString -> Parser s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
B.empty
  fromString String
xs = (Addr# -> State# s -> Result s ByteString) -> Parser s ByteString
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
ba of
    Int#
n -> case IO CInt -> State# s -> (# State# s, CInt #)
forall a s. IO a -> State# s -> (# State# s, a #)
io (Addr# -> Addr# -> CSize -> IO CInt
c_strncmp (MutableByteArray# RealWorld -> Addr#
forall s. MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# RealWorld
ba) Addr#
p (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
n)) State# s
s of
      (# State# s
t, CInt
i #)
        | CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0    -> Addr# -> State# s -> Result s ByteString
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
t
        | Bool
otherwise -> ByteString -> Addr# -> State# s -> Result s ByteString
forall a s. a -> Addr# -> State# s -> Result s a
OK ByteString
bs (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
n) State# s
t
    where !(MutableByteArray MutableByteArray# RealWorld
ba) = String -> MutableByteArray RealWorld
pinnedByteArrayFromString0 String
xs
          bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (MutableByteArray# RealWorld -> Addr#
forall s. MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# RealWorld
ba) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr MutableByteArray# RealWorld
ba)) Int
0 (Int# -> Int
I# (MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
ba))

try :: Parser s a -> Parser s a
try :: forall s a. Parser s a -> Parser s a
try (Parser Addr# -> State# s -> Result s a
m) = (Addr# -> State# s -> Result s a) -> Parser s a
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser ((Addr# -> State# s -> Result s a) -> Parser s a)
-> (Addr# -> State# s -> Result s a) -> Parser s a
forall a b. (a -> b) -> a -> b
$ \Addr#
p State# s
s -> case Addr# -> State# s -> Result s a
m Addr#
p State# s
s of
  OK a
a Addr#
q State# s
t -> a -> Addr# -> State# s -> Result s a
forall a s. a -> Addr# -> State# s -> Result s a
OK a
a Addr#
q State# s
t
  Fail Addr#
_ State# s
t -> Addr# -> State# s -> Result s a
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
t

word8 :: Word8 -> Parser s Word8
word8 :: forall s. Word8 -> Parser s Word8
word8 Word8
0 = Parser s Word8
forall (f :: * -> *) a. Alternative f => f a
empty
word8 r :: Word8
r@(W8# Word#
c) = (Addr# -> State# s -> Result s Word8) -> Parser s Word8
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# Addr#
p Int#
0# State# s
s of
  (# State# s
t, Word#
c' #) -> if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`eqWord#` Word#
c')
    then Word8 -> Addr# -> State# s -> Result s Word8
forall a s. a -> Addr# -> State# s -> Result s a
OK Word8
r (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
1#) State# s
t
    else Addr# -> State# s -> Result s Word8
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
t
{-# inline word8 #-}

---------------------------------------------------------------------------------------
-- * Super-unsafe literal parsers
---------------------------------------------------------------------------------------

-- | super-duper unsafe. Fabricates bytestrings that directly reference constant memory
litN :: Addr# -> CSize -> Parser s ByteString
litN :: forall s. Addr# -> CSize -> Parser s ByteString
litN Addr#
q CSize
n = (Addr# -> State# s -> Result s ByteString) -> Parser s ByteString
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case IO CInt -> State# s -> (# State# s, CInt #)
forall a s. IO a -> State# s -> (# State# s, a #)
io (Addr# -> Addr# -> CSize -> IO CInt
c_strncmp Addr#
p Addr#
q CSize
n) State# s
s of
    (# State# s
t, CInt
0 #) -> ByteString -> Addr# -> State# s -> Result s ByteString
forall a s. a -> Addr# -> State# s -> Result s a
OK ByteString
bs (Addr#
p Addr# -> Int# -> Addr#
`plusAddr#` CSize -> Int#
csize CSize
n) State# s
t
    (# State# s
t, CInt
_ #) -> Addr# -> State# s -> Result s ByteString
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
t
  where bs :: ByteString
bs = Addr# -> CSize -> ByteString
unsafeLiteralByteStringN Addr#
q CSize
n

-- | Super unsafe. Fabricates a bytestring that directly reference constant memory.
--
-- Usage:
--
-- @
-- hello = lit "hello"#
-- @
lit :: Addr# -> Parser s ByteString
lit :: forall s. Addr# -> Parser s ByteString
lit Addr#
q = Addr# -> CSize -> Parser s ByteString
forall s. Addr# -> CSize -> Parser s ByteString
litN Addr#
q (Addr# -> CSize
pure_strlen Addr#
q)

literalForeignPtrContents :: ForeignPtrContents
literalForeignPtrContents :: ForeignPtrContents
literalForeignPtrContents = IO ForeignPtrContents -> ForeignPtrContents
forall a. IO a -> a
unsafeDupablePerformIO (IO ForeignPtrContents -> ForeignPtrContents)
-> IO ForeignPtrContents -> ForeignPtrContents
forall a b. (a -> b) -> a -> b
$ (State# (PrimState IO)
 -> (# State# (PrimState IO), ForeignPtrContents #))
-> IO ForeignPtrContents
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive \State# (PrimState IO)
s -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
0# State# RealWorld
State# (PrimState IO)
s of
  (# State# RealWorld
t, MutableByteArray# RealWorld
a #) -> (# State# RealWorld
State# (PrimState IO)
t, MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr MutableByteArray# RealWorld
a #)
-- {-# noinline literalForeignPtrContents #-}

unsafeLiteralForeignPtr :: Addr# -> ForeignPtr Word8
unsafeLiteralForeignPtr :: Addr# -> ForeignPtr Word8
unsafeLiteralForeignPtr Addr#
addr = Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr ForeignPtrContents
literalForeignPtrContents

unsafeLiteralByteStringN :: Addr# -> CSize -> ByteString
unsafeLiteralByteStringN :: Addr# -> CSize -> ByteString
unsafeLiteralByteStringN Addr#
p CSize
n = ForeignPtr Word8 -> Int -> Int -> ByteString
PS (Addr# -> ForeignPtr Word8
unsafeLiteralForeignPtr Addr#
p) Int
0 (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
n)
{-# noinline unsafeLiteralByteStringN #-}

--unsafeLiteralByteString :: Addr# -> ByteString
--unsafeLiteralByteString p = unsafeLiteralByteStringN p (pure_strlen p)

-- Given a 'Base' you can do two things with it. While in a Parser, you're allowed to
-- access the memory between the start and end addresses, as they'll be alive.
--
-- However, you can always reconstruct a bytestring from the oriignal (non-0 terminated
-- data using 'bytes', and that will remain valid forever or until appropriately
-- garbage collected.
--
-- In general, in a Parser you should try to access the memory in the null-terminated
-- region for cache locality.
--
-- Afterwards, or to report bytestrings, you should trim them off the original, this
-- way, no additional memory needs to be copied, and the garbage collector will just
-- manage the storage of the bytestrings you cut off of the parent for you.

data Base s = Base
  { forall s. Base s -> Addr#
baseOriginal  :: Addr# -- the start of a valid bytestring
  , forall s. Base s -> ForeignPtrContents
baseContents  :: ForeignPtrContents -- memory management for that bytestring
  , forall s. Base s -> Addr#
baseStart :: Addr# -- the start of our null terminated copy of the bytestring
  , forall s. Base s -> Addr#
baseEnd :: Addr# -- the end of our null terminated copy (points to the '\0')
  }

bytes :: forall s. KnownBase s => ByteString
bytes :: forall s. KnownBase s => ByteString
bytes = case forall s. KnownBase s => Base s
reflectBase @s of
  !(Base Addr#
b ForeignPtrContents
g Addr#
p Addr#
q) -> Addr# -> ForeignPtrContents -> Int# -> ByteString
mkBS Addr#
b ForeignPtrContents
g (Addr# -> Addr# -> Int#
minusAddr# Addr#
q Addr#
p)
{-# inline bytes #-}

start :: forall s. KnownBase s => Addr#
start :: forall s. KnownBase s => Addr#
start = Base s -> Addr#
forall s. Base s -> Addr#
baseStart (forall s. KnownBase s => Base s
reflectBase @s)
{-# inline start #-}

end :: forall s. KnownBase s => Addr#
end :: forall s. KnownBase s => Addr#
end = Base s -> Addr#
forall s. Base s -> Addr#
baseEnd (forall s. KnownBase s => Base s
reflectBase @s)
{-# inline end #-}

class KnownBase (s :: Type) where
  reflectBase :: Base s

--------------------------------------------------------------------------------
-- * Parsing
--------------------------------------------------------------------------------

parse :: (forall s. KnownBase s => Parser s a) -> ByteString -> Either Location a
parse :: forall a.
(forall s. KnownBase s => Parser s a)
-> ByteString -> Either Location a
parse forall s. KnownBase s => Parser s a
m bs :: ByteString
bs@(B.PS (ForeignPtr Addr#
b ForeignPtrContents
g) (I# Int#
o) (I# Int#
len)) = IO (Either Location a) -> Either Location a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Location a) -> Either Location a)
-> IO (Either Location a) -> Either Location a
forall a b. (a -> b) -> a -> b
$
  ByteString
-> (CString -> IO (Either Location a)) -> IO (Either Location a)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
bs \(Ptr Addr#
p) -> -- now it is null terminated
    (State# RealWorld -> (# State# RealWorld, Either Location a #))
-> IO (Either Location a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
s -> let base :: Base RealWorld
base = Addr# -> ForeignPtrContents -> Addr# -> Addr# -> Base RealWorld
forall s. Addr# -> ForeignPtrContents -> Addr# -> Addr# -> Base s
Base (Addr# -> Int# -> Addr#
plusAddr# Addr#
b Int#
o) ForeignPtrContents
g Addr#
p (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
len) in
      case Parser RealWorld a
-> Addr# -> State# RealWorld -> Result RealWorld a
forall s a. Parser s a -> Addr# -> State# s -> Result s a
runParser ((KnownBase RealWorld => Proxy# RealWorld -> Parser RealWorld a)
-> Base RealWorld -> Proxy# RealWorld -> Parser RealWorld a
forall s a.
(KnownBase s => Proxy# s -> Parser s a)
-> Base s -> Proxy# s -> Parser s a
withBase (\Proxy# RealWorld
_ -> Parser RealWorld a
forall s. KnownBase s => Parser s a
m) Base RealWorld
base Proxy# RealWorld
forall {k} (a :: k). Proxy# a
proxy#) Addr#
p State# RealWorld
s of
        (# Option a
n, Addr#
q, State# RealWorld
t #) -> (# State# RealWorld
t, Base RealWorld -> Addr# -> Option a -> Either Location a
forall s a. Base s -> Addr# -> Option a -> Either Location a
finish Base RealWorld
base Addr#
q Option a
n #)

finish :: Base s -> Addr# -> Option a -> Either Location a
finish :: forall s a. Base s -> Addr# -> Option a -> Either Location a
finish (Base Addr#
b ForeignPtrContents
g Addr#
q Addr#
r) Addr#
p = \case
  Some a
a -> a -> Either Location a
forall a b. b -> Either a b
Right a
a
  Option a
None -> Location -> Either Location a
forall a b. a -> Either a b
Left (ByteString -> Int -> Location
location (Addr# -> ForeignPtrContents -> Int# -> ByteString
mkBS Addr#
b ForeignPtrContents
g (Addr# -> Addr# -> Int#
minusAddr# Addr#
r Addr#
q)) (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
p Addr#
q)))
{-# inline finish #-}

data Wrap s a = Wrap (KnownBase s => Proxy# s -> Parser s a)

withBase :: (KnownBase s => Proxy# s -> Parser s a) -> Base s -> Proxy# s -> Parser s a
withBase :: forall s a.
(KnownBase s => Proxy# s -> Parser s a)
-> Base s -> Proxy# s -> Parser s a
withBase KnownBase s => Proxy# s -> Parser s a
f Base s
x Proxy# s
y = Wrap s a -> Base s -> Proxy# s -> Parser s a
forall a. a
magicDict ((KnownBase s => Proxy# s -> Parser s a) -> Wrap s a
forall s a. (KnownBase s => Proxy# s -> Parser s a) -> Wrap s a
Wrap KnownBase s => Proxy# s -> Parser s a
f) Base s
x Proxy# s
y
{-# inline withBase #-}