{-# LANGUAGE BangPatterns
, MagicHash
, PatternSynonyms
, RankNTypes
, UnboxedTuples
, UnboxedSums
, UnliftedNewtypes #-}
module Parser.Lathe.Internal
( ByteOffset
, Result (..)
, Resupply (..)
, Partial (..)
, TotalOffset
, ChunkOffset
, More (..)
, Rollback (..)
, Policy (..)
, Core
, Res (Yes, No, ..)
, Dec (Re, Fin, ..)
, Parser (..)
, UnexpectedPartial (..)
, parse
, Blank (..)
, prepare
, Scrap (..)
, scrap
, draw
, catch
, match
, bytesRead
, atEnd
, err
, mapError
, skip
, unsafeSkip
, skipEndOr
, unsafeSkipEndOr
, skipNul
, skipUntil
, skipUntilEndOr
, byteString
, unsafeByteString
, byteStringNul
, byteStringUntil
, int8
, word8
, skip1
, skipEndOr1
, unsafeRead
, shortByteString
, unsafeShortByteString
, shortByteStringNul
, shortByteStringUntil
, lazyByteString
, unsafeLazyByteString
, lazyByteStringNul
, lazyByteStringUntil
, lazyByteStringRest
) where
import Parser.Lathe.Internal.ByteString
import Control.Applicative
import Control.Exception (Exception, throw)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L (ByteString (..), chunk)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
import qualified Data.ByteString.Unsafe as B
import Data.Int
import Data.Word
type ByteOffset = Int64
data Resupply = Supply
!B.ByteString
| EndOfInput
data Result a = Result
L.ByteString
{-# UNPACK #-} !ByteOffset
a
deriving Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> String
show :: Result a -> String
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show
instance Functor Result where
fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f (Result ByteString
s ByteOffset
i a
a) = ByteString -> ByteOffset -> b -> Result b
forall a. ByteString -> ByteOffset -> a -> Result a
Result ByteString
s ByteOffset
i (a -> b
f a
a)
data Partial a = Partial (Resupply -> Partial a)
| Done a
instance Functor Partial where
fmap :: forall a b. (a -> b) -> Partial a -> Partial b
fmap a -> b
f (Partial Resupply -> Partial a
k) = (Resupply -> Partial b) -> Partial b
forall a. (Resupply -> Partial a) -> Partial a
Partial ((a -> b) -> Partial a -> Partial b
forall a b. (a -> b) -> Partial a -> Partial b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Partial a -> Partial b)
-> (Resupply -> Partial a) -> Resupply -> Partial b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Resupply -> Partial a
k)
fmap a -> b
f (Done a
a) = b -> Partial b
forall a. a -> Partial a
Done (a -> b
f a
a)
instance Show a => Show (Partial a) where
showsPrec :: Int -> Partial a -> ShowS
showsPrec Int
d Partial a
x =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
case Partial a
x of
Partial Resupply -> Partial a
_ -> String -> ShowS
showString String
"Partial _"
Done a
res -> String -> ShowS
showString String
"Done " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
res
type TotalOffset = Int64
type ChunkOffset = Int
data Policy = Drop
| Keep
deriving Int -> Policy -> ShowS
[Policy] -> ShowS
Policy -> String
(Int -> Policy -> ShowS)
-> (Policy -> String) -> ([Policy] -> ShowS) -> Show Policy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Policy -> ShowS
showsPrec :: Int -> Policy -> ShowS
$cshow :: Policy -> String
show :: Policy -> String
$cshowList :: [Policy] -> ShowS
showList :: [Policy] -> ShowS
Show
data Rollback = Rollback !Rollback {-# UNPACK #-} !B.ByteString
| Bottom
deriving Int -> Rollback -> ShowS
[Rollback] -> ShowS
Rollback -> String
(Int -> Rollback -> ShowS)
-> (Rollback -> String) -> ([Rollback] -> ShowS) -> Show Rollback
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rollback -> ShowS
showsPrec :: Int -> Rollback -> ShowS
$cshow :: Rollback -> String
show :: Rollback -> String
$cshowList :: [Rollback] -> ShowS
showList :: [Rollback] -> ShowS
Show
data More = More
| End
deriving (Int -> More -> ShowS
[More] -> ShowS
More -> String
(Int -> More -> ShowS)
-> (More -> String) -> ([More] -> ShowS) -> Show More
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> More -> ShowS
showsPrec :: Int -> More -> ShowS
$cshow :: More -> String
show :: More -> String
$cshowList :: [More] -> ShowS
showList :: [More] -> ShowS
Show, More -> More -> Bool
(More -> More -> Bool) -> (More -> More -> Bool) -> Eq More
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: More -> More -> Bool
== :: More -> More -> Bool
$c/= :: More -> More -> Bool
/= :: More -> More -> Bool
Eq)
type Core =
(# TotalOffset, ChunkOffset, B.ByteString, L.ByteString, More, Rollback #)
newtype Res e a = Res (# a | e #)
newtype Dec e a = Dec (# (# Core, Res e a #) | Resupply -> Dec e a #)
newtype Parser e a =
Parser
{ forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser
:: Core
-> Policy
-> Dec e a
}
{-# COMPLETE Re, Fin #-}
pattern Re :: (Resupply -> Dec e a) -> Dec e a
pattern $mRe :: forall {r} {e} {a}.
Dec e a -> ((Resupply -> Dec e a) -> r) -> ((# #) -> r) -> r
$bRe :: forall e a. (Resupply -> Dec e a) -> Dec e a
Re loop = Dec (# | loop #)
pattern Fin :: Core -> Res e a -> Dec e a
pattern $mFin :: forall {r} {e} {a}.
Dec e a -> (Core -> Res e a -> r) -> ((# #) -> r) -> r
$bFin :: forall e a. Core -> Res e a -> Dec e a
Fin core ea = Dec (# (# core, ea #) | #)
{-# COMPLETE Yes, No #-}
pattern Yes :: a -> Res e a
pattern $mYes :: forall {r} {a} {e}. Res e a -> (a -> r) -> ((# #) -> r) -> r
$bYes :: forall a e. a -> Res e a
Yes a = Res (# a | #)
pattern No :: e -> Res e a
pattern $mNo :: forall {r} {e} {a}. Res e a -> (e -> r) -> ((# #) -> r) -> r
$bNo :: forall e a. e -> Res e a
No e = Res (# | e #)
instance Functor (Parser e) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Parser e a -> Parser e b
fmap a -> b
f (Parser Core -> Policy -> Dec e a
p) =
(Core -> Policy -> Dec e b) -> Parser e b
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec e b) -> Parser e b)
-> (Core -> Policy -> Dec e b) -> Parser e b
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
loc ->
let tie :: Dec e a -> Dec e b
tie !Dec e a
x =
case Dec e a
x of
Re Resupply -> Dec e a
loop -> (Resupply -> Dec e b) -> Dec e b
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec e b) -> Dec e b)
-> (Resupply -> Dec e b) -> Dec e b
forall a b. (a -> b) -> a -> b
$ \Resupply
re -> Dec e a -> Dec e b
tie (Resupply -> Dec e a
loop Resupply
re)
Fin Core
core' Res e a
res ->
case Res e a
res of
Yes a
a -> Core -> Res e b -> Dec e b
forall e a. Core -> Res e a -> Dec e a
Fin Core
core' (b -> Res e b
forall a e. a -> Res e a
Yes (a -> b
f a
a))
No e
e -> Core -> Res e b -> Dec e b
forall e a. Core -> Res e a -> Dec e a
Fin Core
core' (e -> Res e b
forall e a. e -> Res e a
No e
e)
in Dec e a -> Dec e b
forall {e}. Dec e a -> Dec e b
tie (Core -> Policy -> Dec e a
p Core
core Policy
loc)
instance Applicative (Parser e) where
{-# INLINE pure #-}
pure :: forall a. a -> Parser e a
pure = \a
x ->
(Core -> Policy -> Dec e a) -> Parser e a
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec e a) -> Parser e a)
-> (Core -> Policy -> Dec e a) -> Parser e a
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
_ -> Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (a -> Res e a
forall a e. a -> Res e a
Yes a
x)
{-# INLINE (<*>) #-}
Parser e (a -> b)
g <*> :: forall a b. Parser e (a -> b) -> Parser e a -> Parser e b
<*> Parser e a
b = do
a -> b
f <- Parser e (a -> b)
g
a
a <- Parser e a
b
b -> Parser e b
forall a. a -> Parser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
a)
{-# INLINE liftA2 #-}
liftA2 :: forall a b c.
(a -> b -> c) -> Parser e a -> Parser e b -> Parser e c
liftA2 a -> b -> c
f Parser e a
a Parser e b
b = a -> b -> c
f (a -> b -> c) -> Parser e a -> Parser e (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
a Parser e (b -> c) -> Parser e b -> Parser e c
forall a b. Parser e (a -> b) -> Parser e a -> Parser e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e b
b
instance Monad (Parser e) where
{-# INLINE return #-}
return :: forall a. a -> Parser e a
return = a -> Parser e a
forall a. a -> Parser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (>>=) #-}
Parser Core -> Policy -> Dec e a
p >>= :: forall a b. Parser e a -> (a -> Parser e b) -> Parser e b
>>= a -> Parser e b
m =
(Core -> Policy -> Dec e b) -> Parser e b
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec e b) -> Parser e b)
-> (Core -> Policy -> Dec e b) -> Parser e b
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
let tie :: Dec e a -> Dec e b
tie !Dec e a
x =
case Dec e a
x of
Re Resupply -> Dec e a
loop -> (Resupply -> Dec e b) -> Dec e b
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec e b) -> Dec e b)
-> (Resupply -> Dec e b) -> Dec e b
forall a b. (a -> b) -> a -> b
$ \Resupply
re -> Dec e a -> Dec e b
tie (Resupply -> Dec e a
loop Resupply
re)
Fin Core
core' Res e a
res ->
case Res e a
res of
Yes a
a -> Parser e b -> Core -> Policy -> Dec e b
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (a -> Parser e b
m a
a) Core
core' Policy
pol
No e
e -> Core -> Res e b -> Dec e b
forall e a. Core -> Res e a -> Dec e a
Fin Core
core' (e -> Res e b
forall e a. e -> Res e a
No e
e)
in Dec e a -> Dec e b
tie (Core -> Policy -> Dec e a
p Core
core Policy
pol)
{-# INLINEABLE catch #-}
catch :: Parser e a -> (e -> Parser x a) -> Parser x a
catch :: forall e a x. Parser e a -> (e -> Parser x a) -> Parser x a
catch (Parser Core -> Policy -> Dec e a
f) e -> Parser x a
g =
(Core -> Policy -> Dec x a) -> Parser x a
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec x a) -> Parser x a)
-> (Core -> Policy -> Dec x a) -> Parser x a
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let tie :: Dec e a -> Dec x a
tie !Dec e a
x =
case Dec e a
x of
Re Resupply -> Dec e a
loop -> (Resupply -> Dec x a) -> Dec x a
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec x a) -> Dec x a)
-> (Resupply -> Dec x a) -> Dec x a
forall a b. (a -> b) -> a -> b
$ \Resupply
re -> Dec e a -> Dec x a
tie (Resupply -> Dec e a
loop Resupply
re)
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs_, More
more', Rollback
delta #) Res e a
res ->
case Res e a
res of
Yes a
a ->
case Policy
pol of
Policy
Drop -> Core -> Res x a -> Dec x a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs_, More
more', Rollback
Bottom #) (a -> Res x a
forall a e. a -> Res e a
Yes a
a)
Policy
Keep ->
let !(# Rollback
roll' #) = Rollback -> Rollback -> (# Rollback #)
retain Rollback
roll Rollback
delta
in Core -> Res x a -> Dec x a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs_, More
more', Rollback
roll' #) (a -> Res x a
forall a e. a -> Res e a
Yes a
a)
No e
e ->
let !(# ByteString
lbs' #) = Rollback -> ByteString -> (# ByteString #)
rollback Rollback
delta ByteString
lbs_
in Parser x a -> Core -> Policy -> Dec x a
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (e -> Parser x a
g e
e) (# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs', More
more', Rollback
roll #) Policy
pol
in Dec e a -> Dec x a
tie (Core -> Policy -> Dec e a
f (# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
Bottom #) Policy
Keep)
{-# INLINEABLE match #-}
match :: Parser e a -> Parser e (L.ByteString, a)
match :: forall e a. Parser e a -> Parser e (ByteString, a)
match (Parser Core -> Policy -> Dec e a
f) =
(Core -> Policy -> Dec e (ByteString, a))
-> Parser e (ByteString, a)
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec e (ByteString, a))
-> Parser e (ByteString, a))
-> (Core -> Policy -> Dec e (ByteString, a))
-> Parser e (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let tie :: Dec e a -> Dec e (ByteString, a)
tie !Dec e a
x =
case Dec e a
x of
Re Resupply -> Dec e a
loop -> (Resupply -> Dec e (ByteString, a)) -> Dec e (ByteString, a)
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec e (ByteString, a)) -> Dec e (ByteString, a))
-> (Resupply -> Dec e (ByteString, a)) -> Dec e (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \Resupply
re -> Dec e a -> Dec e (ByteString, a)
tie (Resupply -> Dec e a
loop Resupply
re)
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs', More
more', Rollback
delta #) Res e a
res ->
case Res e a
res of
Yes a
a ->
case Policy
pol of
Policy
Drop ->
let !r :: ByteString
r = case Rollback
delta of
Rollback Rollback
delta' ByteString
_ ->
let !r0 :: ByteString
r0 = ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> ByteString -> ByteString
takeCopy Copying
Copy Int
o' ByteString
bs') ByteString
L.empty
!(# ByteString
r1 #) = Rollback -> ByteString -> (# ByteString #)
rollback Rollback
delta' ByteString
r0
in ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> ByteString -> ByteString
dropCopy Copying
Copy Int
o ByteString
bs) ByteString
r1
Rollback
Bottom ->
ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o (Int
o' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o) ByteString
bs) ByteString
L.empty
in Core -> Res e (ByteString, a) -> Dec e (ByteString, a)
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs', More
more', Rollback
Bottom #) ((ByteString, a) -> Res e (ByteString, a)
forall a e. a -> Res e a
Yes (ByteString
r, a
a))
Policy
Keep ->
let !(# Rollback
roll', !ByteString
r #) =
case Rollback
delta of
Rollback Rollback
_ ByteString
_ ->
let !r0 :: ByteString
r0 = ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> ByteString -> ByteString
takeCopy Copying
Copy Int
o' ByteString
bs') ByteString
L.empty
!(# Rollback
roll1, ByteString
r1 #) = Rollback -> Rollback -> ByteString -> (# Rollback, ByteString #)
retainRollback Rollback
roll Rollback
delta ByteString
r0
in (# Rollback
roll1, ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> ByteString -> ByteString
dropCopy Copying
Copy Int
o ByteString
bs) ByteString
r1 #)
Rollback
Bottom ->
(# Rollback
roll
, ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o (Int
o' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o) ByteString
bs) ByteString
L.empty
#)
in Core -> Res e (ByteString, a) -> Dec e (ByteString, a)
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs', More
more', Rollback
roll' #) ((ByteString, a) -> Res e (ByteString, a)
forall a e. a -> Res e a
Yes (ByteString
r, a
a))
No e
e ->
case Policy
pol of
Policy
Drop ->
Core -> Res e (ByteString, a) -> Dec e (ByteString, a)
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs', More
more', Rollback
Bottom #) (e -> Res e (ByteString, a)
forall e a. e -> Res e a
No e
e)
Policy
Keep ->
let !(# Rollback
roll' #) = Rollback -> Rollback -> (# Rollback #)
retain Rollback
roll Rollback
delta
in Core -> Res e (ByteString, a) -> Dec e (ByteString, a)
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs', More
more', Rollback
roll' #) (e -> Res e (ByteString, a)
forall e a. e -> Res e a
No e
e)
in Dec e a -> Dec e (ByteString, a)
forall {e} {a}. Dec e a -> Dec e (ByteString, a)
tie (Core -> Policy -> Dec e a
f (# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
Bottom #) Policy
Keep)
rollback :: Rollback -> L.ByteString -> (# L.ByteString #)
rollback :: Rollback -> ByteString -> (# ByteString #)
rollback Rollback
Bottom ByteString
bs = (# ByteString
bs #)
rollback (Rollback Rollback
r ByteString
b) ByteString
bs = Rollback -> ByteString -> (# ByteString #)
rollback Rollback
r (ByteString -> (# ByteString #)) -> ByteString -> (# ByteString #)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
L.Chunk ByteString
b ByteString
bs
retain :: Rollback -> Rollback -> (# Rollback #)
retain :: Rollback -> Rollback -> (# Rollback #)
retain Rollback
x Rollback
Bottom = (# Rollback
x #)
retain Rollback
x (Rollback Rollback
r ByteString
b) = let !(# Rollback
r' #) = Rollback -> Rollback -> (# Rollback #)
retain Rollback
x Rollback
r
in (# Rollback -> ByteString -> Rollback
Rollback Rollback
r' ByteString
b #)
retainRollback :: Rollback -> Rollback -> L.ByteString -> (# Rollback, L.ByteString #)
retainRollback :: Rollback -> Rollback -> ByteString -> (# Rollback, ByteString #)
retainRollback Rollback
x Rollback
Bottom ByteString
bs = (# Rollback
x, ByteString
bs #)
retainRollback Rollback
x (Rollback Rollback
r ByteString
b) ByteString
bs =
let !(# Rollback
r', ByteString
cs #) = Rollback -> Rollback -> ByteString -> (# Rollback, ByteString #)
retainRollback Rollback
x Rollback
r (ByteString -> ByteString -> ByteString
L.Chunk ByteString
b ByteString
bs)
in (# Rollback -> ByteString -> Rollback
Rollback Rollback
r' ByteString
b, ByteString
cs #)
data UnexpectedPartial = UnexpectedPartial
instance Show UnexpectedPartial where
showsPrec :: Int -> UnexpectedPartial -> ShowS
showsPrec Int
_ UnexpectedPartial
_ =
String -> ShowS
showString
String
"lathe#Parser.Lathe.parse: \
\parser was instructed to never prompt for more input, yet prompted anyway"
instance Exception UnexpectedPartial
parse :: Parser e a -> L.ByteString -> (Scrap, Either e a)
parse :: forall e a. Parser e a -> ByteString -> (Scrap, Either e a)
parse Parser e a
g ByteString
lbs0 =
let !(# ByteString
bs, ByteString
lbs #) = case ByteString
lbs0 of
L.Chunk ByteString
bs' ByteString
lbs' -> (# ByteString
bs', ByteString
lbs' #)
ByteString
L.Empty -> (# ByteString
B.empty, ByteString
L.Empty #)
in case Parser e a -> Blank -> Partial (Blank, Either e a)
forall e a. Parser e a -> Blank -> Partial (Blank, Either e a)
draw Parser e a
g (ByteOffset -> Int -> ByteString -> ByteString -> More -> Blank
Blank ByteOffset
0 Int
0 ByteString
bs ByteString
lbs More
End) of
Partial Resupply -> Partial (Blank, Either e a)
_ -> UnexpectedPartial -> (Scrap, Either e a)
forall a e. Exception e => e -> a
throw UnexpectedPartial
UnexpectedPartial
Done (Blank
blank, Either e a
res) ->
let !s :: Scrap
s = Blank -> Scrap
scrap Blank
blank
in (Scrap
s, Either e a
res)
data Blank =
Blank
{-# UNPACK #-} !TotalOffset
{-# UNPACK #-} !ChunkOffset
!B.ByteString
!L.ByteString
!More
prepare
:: ByteOffset
-> B.ByteString
-> L.ByteString
-> More
-> Blank
prepare :: ByteOffset -> ByteString -> ByteString -> More -> Blank
prepare ByteOffset
i = ByteOffset -> Int -> ByteString -> ByteString -> More -> Blank
Blank ByteOffset
i Int
0
data Scrap =
Scrap
{-# UNPACK #-} !ByteOffset
!L.ByteString
!More
deriving Int -> Scrap -> ShowS
[Scrap] -> ShowS
Scrap -> String
(Int -> Scrap -> ShowS)
-> (Scrap -> String) -> ([Scrap] -> ShowS) -> Show Scrap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scrap -> ShowS
showsPrec :: Int -> Scrap -> ShowS
$cshow :: Scrap -> String
show :: Scrap -> String
$cshowList :: [Scrap] -> ShowS
showList :: [Scrap] -> ShowS
Show
scrap :: Blank -> Scrap
scrap :: Blank -> Scrap
scrap (Blank ByteOffset
i Int
o ByteString
bs ByteString
lbs More
more) =
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o
!(# ByteString
lbs' #) | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = (# ByteString
lbs #)
| Bool
otherwise = let !lbs_ :: ByteString
lbs_ = ByteString -> ByteString -> ByteString
L.chunk (Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs) ByteString
lbs
in (# ByteString
lbs_ #)
in ByteOffset -> ByteString -> More -> Scrap
Scrap ByteOffset
i' ByteString
lbs' More
more
draw :: Parser e a -> Blank -> Partial (Blank, Either e a)
draw :: forall e a. Parser e a -> Blank -> Partial (Blank, Either e a)
draw (Parser Core -> Policy -> Dec e a
p) (Blank ByteOffset
i0 Int
o0 ByteString
bs0 ByteString
lbs0 More
more0) =
let tie :: Dec e a -> Partial (Blank, Either e a)
tie !Dec e a
x =
case Dec e a
x of
Re Resupply -> Dec e a
loop -> (Resupply -> Partial (Blank, Either e a))
-> Partial (Blank, Either e a)
forall a. (Resupply -> Partial a) -> Partial a
Partial ((Resupply -> Partial (Blank, Either e a))
-> Partial (Blank, Either e a))
-> (Resupply -> Partial (Blank, Either e a))
-> Partial (Blank, Either e a)
forall a b. (a -> b) -> a -> b
$ \Resupply
resupply -> Dec e a -> Partial (Blank, Either e a)
tie (Resupply -> Dec e a
loop Resupply
resupply)
Fin (# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
_ #) Res e a
res ->
let !ei :: Either e a
ei = case Res e a
res of
Yes a
a -> a -> Either e a
forall a b. b -> Either a b
Right a
a
No e
e -> e -> Either e a
forall a b. a -> Either a b
Left e
e
in (Blank, Either e a) -> Partial (Blank, Either e a)
forall a. a -> Partial a
Done (ByteOffset -> Int -> ByteString -> ByteString -> More -> Blank
Blank ByteOffset
i Int
o ByteString
bs ByteString
lbs More
more, Either e a
ei)
in Dec e a -> Partial (Blank, Either e a)
forall {e} {a}. Dec e a -> Partial (Blank, Either e a)
tie (Core -> Policy -> Dec e a
p (# ByteOffset
i0, Int
o0, ByteString
bs0, ByteString
lbs0, More
more0, Rollback
Bottom #) Policy
Drop)
{-# INLINE advance #-}
advance
:: Res e a
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> More
-> Rollback
-> Policy
-> (TotalOffset -> B.ByteString -> L.ByteString -> Rollback -> Dec e a)
-> Dec e a
advance :: forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance Res e a
eof ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll !Policy
pol ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
next =
case ByteString
lbs of
L.Chunk ByteString
bs' ByteString
lbs' ->
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
!(# Rollback
roll' #) = case Policy
pol of
Policy
Drop -> (# Rollback
roll #)
Policy
Keep -> (# Rollback -> ByteString -> Rollback
Rollback Rollback
roll ByteString
bs' #)
in ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
next ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
ByteString
L.Empty ->
case More
more of
More
More ->
(Resupply -> Dec e a) -> Dec e a
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec e a) -> Dec e a)
-> (Resupply -> Dec e a) -> Dec e a
forall a b. (a -> b) -> a -> b
$ \Resupply
resupply ->
case Resupply
resupply of
Supply ByteString
bs' ->
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
!(# Rollback
roll' #) =
case Policy
pol of
Policy
Drop -> (# Rollback
roll #)
Policy
Keep -> (# Rollback -> ByteString -> Rollback
Rollback Rollback
roll ByteString
bs' #)
in ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
next ByteOffset
i' ByteString
bs' ByteString
L.empty Rollback
roll'
Resupply
EndOfInput -> Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, ByteString -> Int
B.length ByteString
bs, ByteString
bs, ByteString
lbs, More
End, Rollback
roll #) Res e a
eof
More
End -> Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, ByteString -> Int
B.length ByteString
bs, ByteString
bs, ByteString
lbs, More
End, Rollback
roll #) Res e a
eof
{-# INLINE err #-}
err :: e -> Parser e a
err :: forall e a. e -> Parser e a
err e
e = (Core -> Policy -> Dec e a) -> Parser e a
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec e a) -> Parser e a)
-> (Core -> Policy -> Dec e a) -> Parser e a
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
_ -> Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (e -> Res e a
forall e a. e -> Res e a
No e
e)
{-# INLINE mapError #-}
mapError :: (e -> Either x a) -> Parser e a -> Parser x a
mapError :: forall e x a. (e -> Either x a) -> Parser e a -> Parser x a
mapError e -> Either x a
f (Parser Core -> Policy -> Dec e a
p) =
(Core -> Policy -> Dec x a) -> Parser x a
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec x a) -> Parser x a)
-> (Core -> Policy -> Dec x a) -> Parser x a
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
let tie :: Dec e a -> Dec x a
tie !Dec e a
x =
case Dec e a
x of
Re Resupply -> Dec e a
loop -> (Resupply -> Dec x a) -> Dec x a
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec x a) -> Dec x a)
-> (Resupply -> Dec x a) -> Dec x a
forall a b. (a -> b) -> a -> b
$ \Resupply
re -> Dec e a -> Dec x a
tie (Resupply -> Dec e a
loop Resupply
re)
Fin Core
core' Res e a
res ->
case Res e a
res of
Yes a
a -> Core -> Res x a -> Dec x a
forall e a. Core -> Res e a -> Dec e a
Fin Core
core' (a -> Res x a
forall a e. a -> Res e a
Yes a
a)
No e
e ->
let !ea :: Res x a
ea = case e -> Either x a
f e
e of
Left x
e' -> x -> Res x a
forall e a. e -> Res e a
No x
e'
Right a
a -> a -> Res x a
forall a e. a -> Res e a
Yes a
a
in Core -> Res x a -> Dec x a
forall e a. Core -> Res e a -> Dec e a
Fin Core
core' Res x a
ea
in Dec e a -> Dec x a
tie (Core -> Policy -> Dec e a
p Core
core Policy
pol)
{-# INLINE bytesRead #-}
bytesRead :: Parser never ByteOffset
bytesRead :: forall never. Parser never ByteOffset
bytesRead =
(Core -> Policy -> Dec never ByteOffset) -> Parser never ByteOffset
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never ByteOffset)
-> Parser never ByteOffset)
-> (Core -> Policy -> Dec never ByteOffset)
-> Parser never ByteOffset
forall a b. (a -> b) -> a -> b
$ \core :: Core
core@(# ByteOffset
i, Int
o, ByteString
_, ByteString
_, More
_, Rollback
_ #) Policy
_ ->
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o
in Core -> Res never ByteOffset -> Dec never ByteOffset
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (ByteOffset -> Res never ByteOffset
forall a e. a -> Res e a
Yes ByteOffset
i')
{-# INLINE atEnd #-}
atEnd :: Parser never Bool
atEnd :: forall never. Parser never Bool
atEnd =
(Core -> Policy -> Dec never Bool) -> Parser never Bool
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never Bool) -> Parser never Bool)
-> (Core -> Policy -> Dec never Bool) -> Parser never Bool
forall a b. (a -> b) -> a -> b
$ \core :: Core
core@(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs Bool -> Bool -> Bool
&& ByteString -> Bool
L.null ByteString
lbs
then case More
more of
More
More -> (Resupply -> Dec never Bool) -> Dec never Bool
forall e a. (Resupply -> Dec e a) -> Dec e a
Re (ByteOffset
-> Int
-> ByteString
-> ByteString
-> Rollback
-> Policy
-> Resupply
-> Dec never Bool
forall e.
ByteOffset
-> Int
-> ByteString
-> ByteString
-> Rollback
-> Policy
-> Resupply
-> Dec e Bool
atEnd_ ByteOffset
i Int
o ByteString
bs ByteString
lbs Rollback
roll Policy
pol)
More
End -> Core -> Res never Bool -> Dec never Bool
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (Bool -> Res never Bool
forall a e. a -> Res e a
Yes Bool
True)
else Core -> Res never Bool -> Dec never Bool
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (Bool -> Res never Bool
forall a e. a -> Res e a
Yes Bool
False)
atEnd_
:: TotalOffset
-> ChunkOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Policy
-> Resupply
-> Dec e Bool
atEnd_ :: forall e.
ByteOffset
-> Int
-> ByteString
-> ByteString
-> Rollback
-> Policy
-> Resupply
-> Dec e Bool
atEnd_ ByteOffset
i Int
o ByteString
bs ByteString
lbs Rollback
roll Policy
pol Resupply
resupply =
case Resupply
resupply of
Supply ByteString
bs' ->
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
!(# Rollback
roll' #) =
case Policy
pol of
Policy
Drop -> (# Rollback
roll #)
Policy
Keep -> (# Rollback -> ByteString -> Rollback
Rollback Rollback
roll ByteString
bs' #)
in if ByteString -> Int
B.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then (Resupply -> Dec e Bool) -> Dec e Bool
forall e a. (Resupply -> Dec e a) -> Dec e a
Re (ByteOffset
-> Int
-> ByteString
-> ByteString
-> Rollback
-> Policy
-> Resupply
-> Dec e Bool
forall e.
ByteOffset
-> Int
-> ByteString
-> ByteString
-> Rollback
-> Policy
-> Resupply
-> Dec e Bool
atEnd_ ByteOffset
i' Int
0 ByteString
bs' ByteString
L.Empty Rollback
roll Policy
pol)
else Core -> Res e Bool -> Dec e Bool
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
0, ByteString
bs', ByteString
L.empty, More
More, Rollback
roll' #) (Bool -> Res e Bool
forall a e. a -> Res e a
Yes Bool
False)
Resupply
EndOfInput -> Core -> Res e Bool -> Dec e Bool
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
End, Rollback
roll #) (Bool -> Res e Bool
forall a e. a -> Res e a
Yes Bool
True)
data Copying = Original
| Copy
deriving Int -> Copying -> ShowS
[Copying] -> ShowS
Copying -> String
(Int -> Copying -> ShowS)
-> (Copying -> String) -> ([Copying] -> ShowS) -> Show Copying
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Copying -> ShowS
showsPrec :: Int -> Copying -> ShowS
$cshow :: Copying -> String
show :: Copying -> String
$cshowList :: [Copying] -> ShowS
showList :: [Copying] -> ShowS
Show
{-# INLINE dropCopy #-}
dropCopy :: Copying -> Int -> B.ByteString -> B.ByteString
dropCopy :: Copying -> Int -> ByteString -> ByteString
dropCopy !Copying
copy Int
o ByteString
b
| Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
b
| Bool
otherwise = let b' :: ByteString
b' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
b
in case Copying
copy of
Copying
Original -> ByteString
b'
Copying
Copy -> ByteString -> ByteString
B.copy ByteString
b'
{-# INLINE sliceCopy #-}
sliceCopy
:: Copying
-> Int
-> Int
-> B.ByteString
-> B.ByteString
sliceCopy :: Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy !Copying
copy Int
o !Int
n ByteString
b
| Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
b = ByteString
b
| Bool
otherwise = let b' :: ByteString
b' = Int -> ByteString -> ByteString
B.unsafeTake Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
b
in case Copying
copy of
Copying
Original -> ByteString
b'
Copying
Copy -> ByteString -> ByteString
B.copy ByteString
b'
{-# INLINE takeCopy #-}
takeCopy :: Copying -> Int -> B.ByteString -> B.ByteString
takeCopy :: Copying -> Int -> ByteString -> ByteString
takeCopy !Copying
copy Int
n ByteString
b
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
b = ByteString
b
| Bool
otherwise = let b' :: ByteString
b' = Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
b
in case Copying
copy of
Copying
Original -> ByteString
b'
Copying
Copy -> ByteString -> ByteString
B.copy ByteString
b'
{-# INLINE byteString #-}
byteString :: Int -> end -> Parser end B.ByteString
byteString :: forall end. Int -> end -> Parser end ByteString
byteString Int
n end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
B.empty)
else Parser end ByteString -> Core -> Policy -> Dec end ByteString
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (Int -> end -> Parser end ByteString
forall end. Int -> end -> Parser end ByteString
unsafeByteString Int
n end
e) Core
core Policy
pol
{-# INLINE unsafeByteString #-}
unsafeByteString :: Int -> end -> Parser end B.ByteString
unsafeByteString :: forall end. Int -> end -> Parser end ByteString
unsafeByteString Int
n end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
n' :: Int
n' = Int
o' Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then let !r :: ByteString
r = Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o Int
n ByteString
bs
in Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
r)
else let !(# ByteString -> ByteString
acc #) | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = (# ByteString -> ByteString
forall a. a -> a
id #)
| Bool
otherwise = let !r :: ByteString
r = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in (# ByteString -> ByteString -> ByteString
L.Chunk ByteString
r #)
in Copying
-> end
-> (ByteString -> ByteString)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ByteString
forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
take_ Copying
Original end
e (Int -> ByteString -> ByteString
toStrictLen Int
n) More
more Policy
pol Int
n' ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
{-# INLINE shortByteString #-}
shortByteString :: Int -> end -> Parser end ShortByteString
shortByteString :: forall end. Int -> end -> Parser end ShortByteString
shortByteString Int
n end
e =
(Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString)
-> (Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Core -> Res end ShortByteString -> Dec end ShortByteString
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (ShortByteString -> Res end ShortByteString
forall a e. a -> Res e a
Yes ShortByteString
Short.empty)
else Parser end ShortByteString
-> Core -> Policy -> Dec end ShortByteString
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (Int -> end -> Parser end ShortByteString
forall end. Int -> end -> Parser end ShortByteString
unsafeShortByteString Int
n end
e) Core
core Policy
pol
{-# INLINE unsafeShortByteString #-}
unsafeShortByteString :: Int -> end -> Parser end ShortByteString
unsafeShortByteString :: forall end. Int -> end -> Parser end ShortByteString
unsafeShortByteString Int
n end
e =
(Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString)
-> (Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
n' :: Int
n' = Int
o' Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then let !r :: ShortByteString
r = ByteString -> ShortByteString
Short.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.unsafeTake Int
n (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in Core -> Res end ShortByteString -> Dec end ShortByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ShortByteString -> Res end ShortByteString
forall a e. a -> Res e a
Yes ShortByteString
r)
else let !(# ByteString -> ByteString
acc #) | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = (# ByteString -> ByteString
forall a. a -> a
id #)
| Bool
otherwise = let !r :: ByteString
r = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in (# ByteString -> ByteString -> ByteString
L.Chunk ByteString
r #)
in Copying
-> end
-> (ByteString -> ShortByteString)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ShortByteString
forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
take_ Copying
Original end
e (Int -> ByteString -> ShortByteString
toShortLen Int
n) More
more Policy
pol Int
n' ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
{-# INLINE lazyByteString #-}
lazyByteString :: Int -> end -> Parser end L.ByteString
lazyByteString :: forall end. Int -> end -> Parser end ByteString
lazyByteString Int
n end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
L.empty)
else Parser end ByteString -> Core -> Policy -> Dec end ByteString
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (Int -> end -> Parser end ByteString
forall end. Int -> end -> Parser end ByteString
unsafeLazyByteString Int
n end
e) Core
core Policy
pol
{-# INLINE unsafeLazyByteString #-}
unsafeLazyByteString :: Int -> end -> Parser end L.ByteString
unsafeLazyByteString :: forall end. Int -> end -> Parser end ByteString
unsafeLazyByteString Int
n end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
n' :: Int
n' = Int
o' Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then let !raw :: ByteString
raw = Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o Int
n ByteString
bs
!res :: ByteString
res = ByteString -> ByteString -> ByteString
L.chunk ByteString
raw ByteString
L.empty
in Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
res)
else let !(# ByteString -> ByteString
acc #) | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = (# ByteString -> ByteString
forall a. a -> a
id #)
| Bool
otherwise = let !r :: ByteString
r = Copying -> Int -> ByteString -> ByteString
dropCopy Copying
Copy Int
o ByteString
bs
in (# ByteString -> ByteString -> ByteString
L.Chunk ByteString
r #)
in Copying
-> end
-> (ByteString -> ByteString)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ByteString
forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
take_ Copying
Copy end
e ByteString -> ByteString
forall a. a -> a
id More
more Policy
pol Int
n' ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
take_
:: Copying
-> e
-> (L.ByteString -> a)
-> More
-> Policy
-> Int
-> (L.ByteString -> L.ByteString)
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e a
take_ :: forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
take_ Copying
copy e
e ByteString -> a
conv More
more Policy
pol = Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
go
where
go :: Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
go !Int
n ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e a
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a)
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs'
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then let !raw :: ByteString
raw = Copying -> Int -> ByteString -> ByteString
takeCopy Copying
copy Int
n ByteString
bs'
!r :: a
r = ByteString -> a
conv (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
acc (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
raw ByteString
L.empty
in Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
n, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (a -> Res e a
forall a e. a -> Res e a
Yes a
r)
else Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
go Int
n' (\ByteString
r -> ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs' ByteString
r) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE int8 #-}
int8 :: end -> Parser end Int8
int8 :: forall end. end -> Parser end Int8
int8 end
e =
(Core -> Policy -> Dec end Int8) -> Parser end Int8
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end Int8) -> Parser end Int8)
-> (Core -> Policy -> Dec end Int8) -> Parser end Int8
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
B.length ByteString
bs
then let !w :: Int8
w = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> Word8 -> Int8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs Int
o
!o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Core -> Res end Int8 -> Dec end Int8
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (Int8 -> Res end Int8
forall a e. a -> Res e a
Yes Int8
w)
else end
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end Int8
forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e Int8
int8_ end
e More
more Policy
pol ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
int8_
:: e
-> More
-> Policy
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e Int8
int8_ :: forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e Int8
int8_ e
e More
more Policy
pol = ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e Int8
forall {a}.
Num a =>
ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go
where
go :: ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e a
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a)
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
if ByteString -> Int
B.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then let !w :: a
w = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Word8 -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs' Int
0
in Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
1, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (a -> Res e a
forall a e. a -> Res e a
Yes a
w)
else ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE word8 #-}
word8 :: end -> Parser end Word8
word8 :: forall end. end -> Parser end Word8
word8 end
e =
(Core -> Policy -> Dec end Word8) -> Parser end Word8
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end Word8) -> Parser end Word8)
-> (Core -> Policy -> Dec end Word8) -> Parser end Word8
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
B.length ByteString
bs
then let !w :: Word8
w = ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs Int
o
!o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Core -> Res end Word8 -> Dec end Word8
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (Word8 -> Res end Word8
forall a e. a -> Res e a
Yes Word8
w)
else end
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end Word8
forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e Word8
word8_ end
e More
more Policy
pol ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
word8_
:: e
-> More
-> Policy
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e Word8
word8_ :: forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e Word8
word8_ e
e More
more Policy
pol = ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e Word8
go
where
go :: ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e Word8
go ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e Word8
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset
-> ByteString -> ByteString -> Rollback -> Dec e Word8)
-> Dec e Word8
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e Word8
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset
-> ByteString -> ByteString -> Rollback -> Dec e Word8)
-> Dec e Word8)
-> (ByteOffset
-> ByteString -> ByteString -> Rollback -> Dec e Word8)
-> Dec e Word8
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
if ByteString -> Int
B.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then let !w :: Word8
w = ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs' Int
0
in Core -> Res e Word8 -> Dec e Word8
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
1, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (Word8 -> Res e Word8
forall a e. a -> Res e a
Yes Word8
w)
else ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e Word8
go ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE skip1 #-}
skip1 :: end -> Parser end ()
skip1 :: forall end. end -> Parser end ()
skip1 end
e =
(Core -> Policy -> Dec end ()) -> Parser end ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ()) -> Parser end ())
-> (Core -> Policy -> Dec end ()) -> Parser end ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
B.length ByteString
bs
then let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Core -> Res end () -> Dec end ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res end ()
forall a e. a -> Res e a
Yes ())
else end
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ()
forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skip1_ end
e More
more Policy
pol ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
skip1_
:: e
-> More
-> Policy
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skip1_ :: forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skip1_ e
e More
more Policy
pol = ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e ()
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
if ByteString -> Int
B.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
1, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
else ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE skipEndOr1 #-}
skipEndOr1 :: Parser never ()
skipEndOr1 :: forall never. Parser never ()
skipEndOr1 =
(Core -> Policy -> Dec never ()) -> Parser never ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never ()) -> Parser never ())
-> (Core -> Policy -> Dec never ()) -> Parser never ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
B.length ByteString
bs
then let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Core -> Res never () -> Dec never ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res never ()
forall a e. a -> Res e a
Yes ())
else More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec never ()
forall e.
More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipEndOr1_ More
more Policy
pol ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
skipEndOr1_
:: More
-> Policy
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skipEndOr1_ :: forall e.
More
-> Policy
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipEndOr1_ More
more Policy
pol = ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
forall {e}.
ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (() -> Res e ()
forall a e. a -> Res e a
Yes ()) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
if ByteString -> Int
B.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
1, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
else ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE unsafeRead #-}
unsafeRead :: Int -> (B.ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead :: forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
n ByteString -> (# Res e a #)
conv = \e
e ->
(Core -> Policy -> Dec e a) -> Parser e a
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec e a) -> Parser e a)
-> (Core -> Policy -> Dec e a) -> Parser e a
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
n' :: Int
n' = Int
o' Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then let !(# Res e a
r #) = ByteString -> (# Res e a #)
conv (ByteString -> (# Res e a #)) -> ByteString -> (# Res e a #)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Res e a
r
else let !(# ByteString -> ByteString
acc #) | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = (# ByteString -> ByteString
forall a. a -> a
id #)
| Bool
otherwise = let !r :: ByteString
r = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in (# ByteString -> ByteString -> ByteString
L.Chunk ByteString
r #)
in e
-> (ByteString -> (# Res e a #))
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
forall e a.
e
-> (ByteString -> (# Res e a #))
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
read_ e
e (\ByteString
b -> ByteString -> (# Res e a #)
conv (ByteString -> (# Res e a #)) -> ByteString -> (# Res e a #)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
toStrictLen Int
n ByteString
b) More
more Policy
pol Int
n' ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
read_
:: e
-> (L.ByteString -> (# Res e a #))
-> More
-> Policy
-> Int
-> (L.ByteString -> L.ByteString)
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e a
read_ :: forall e a.
e
-> (ByteString -> (# Res e a #))
-> More
-> Policy
-> Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
read_ e
e ByteString -> (# Res e a #)
conv More
more Policy
pol = Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
go
where
go :: Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
go !Int
n ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e a
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a)
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs'
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then let !(# Res e a
r #) = ByteString -> (# Res e a #)
conv (ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
L.Chunk (Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
bs') ByteString
L.Empty)
in Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
n, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) Res e a
r
else Int
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
go Int
n' (\ByteString
r -> ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs' ByteString
r) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE byteStringNul #-}
byteStringNul :: end -> Parser end B.ByteString
byteStringNul :: forall end. end -> Parser end ByteString
byteStringNul end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
acc = Copying
-> end
-> (ByteString -> ByteString)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ByteString
forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeNul_ Copying
Original end
e
(\ByteString
r -> Int -> ByteString -> ByteString
toStrictLen (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Int) -> ByteOffset -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
L.length ByteString
r) ByteString
r) More
more Policy
pol
ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
forall a. a -> a
id
else
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
0 ByteString
bs' of
Just Int
x ->
let x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x'
!r :: ByteString
r = Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o Int
x ByteString
bs
in Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
r)
Maybe Int
Nothing -> (ByteString -> ByteString) -> Dec end ByteString
long (ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs')
{-# INLINE shortByteStringNul #-}
shortByteStringNul :: end -> Parser end ShortByteString
shortByteStringNul :: forall end. end -> Parser end ShortByteString
shortByteStringNul end
e =
(Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString)
-> (Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: (ByteString -> ByteString) -> Dec end ShortByteString
long ByteString -> ByteString
acc = Copying
-> end
-> (ByteString -> ShortByteString)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ShortByteString
forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeNul_ Copying
Original end
e
(\ByteString
r -> Int -> ByteString -> ShortByteString
toShortLen (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Int) -> ByteOffset -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
L.length ByteString
r) ByteString
r) More
more Policy
pol
ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then (ByteString -> ByteString) -> Dec end ShortByteString
long ByteString -> ByteString
forall a. a -> a
id
else
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
0 ByteString
bs' of
Just Int
x ->
let x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x'
!r :: ShortByteString
r = ByteString -> ShortByteString
Short.toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeTake Int
x ByteString
bs'
in Core -> Res end ShortByteString -> Dec end ShortByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ShortByteString -> Res end ShortByteString
forall a e. a -> Res e a
Yes ShortByteString
r)
Maybe Int
Nothing -> (ByteString -> ByteString) -> Dec end ShortByteString
long (ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs')
{-# INLINE lazyByteStringNul #-}
lazyByteStringNul :: end -> Parser end L.ByteString
lazyByteStringNul :: forall end. end -> Parser end ByteString
lazyByteStringNul end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
acc = Copying
-> end
-> (ByteString -> ByteString)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ByteString
forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeNul_ Copying
Copy end
e ByteString -> ByteString
forall a. a -> a
id More
more Policy
pol ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
forall a. a -> a
id
else
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
0 ByteString
bs' of
Just Int
x ->
let x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x'
!raw :: ByteString
raw = Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o Int
x ByteString
bs
!r :: ByteString
r = ByteString -> ByteString -> ByteString
L.Chunk ByteString
raw ByteString
L.Empty
in Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
r)
Maybe Int
Nothing -> (ByteString -> ByteString) -> Dec end ByteString
long (ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs')
takeNul_
:: Copying
-> e
-> (L.ByteString -> a)
-> More
-> Policy
-> (L.ByteString -> L.ByteString)
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e a
takeNul_ :: forall e a.
Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeNul_ Copying
copy e
e ByteString -> a
conv More
more Policy
pol = (ByteString -> ByteString)
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go
where
go :: (ByteString -> ByteString)
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e a
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a)
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
0 ByteString
bs' of
Just Int
x ->
let !x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!r :: a
r = ByteString -> a
conv (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
acc (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
L.Chunk (Copying -> Int -> ByteString -> ByteString
takeCopy Copying
copy Int
x ByteString
bs') ByteString
L.Empty
in Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
x', ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (a -> Res e a
forall a e. a -> Res e a
Yes a
r)
Maybe Int
Nothing -> (ByteString -> ByteString)
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go (\ByteString
r -> ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs' ByteString
r) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE byteStringUntil #-}
byteStringUntil :: (Word8 -> Bool) -> end -> Parser end B.ByteString
byteStringUntil :: forall end. (Word8 -> Bool) -> end -> Parser end ByteString
byteStringUntil Word8 -> Bool
f end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
acc = (Word8 -> Bool)
-> Copying
-> end
-> (ByteString -> ByteString)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ByteString
forall e a.
(Word8 -> Bool)
-> Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeUntil_ Word8 -> Bool
f Copying
Original end
e
(\ByteString
r -> Int -> ByteString -> ByteString
toStrictLen (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Int) -> ByteOffset -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
L.length ByteString
r) ByteString
r) More
more Policy
pol
ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
forall a. a -> a
id
else
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f ByteString
bs' of
Just Int
x ->
let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
!r :: ByteString
r = Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o Int
x ByteString
bs
in Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
r)
Maybe Int
Nothing -> (ByteString -> ByteString) -> Dec end ByteString
long (ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs')
{-# INLINE shortByteStringUntil #-}
shortByteStringUntil :: (Word8 -> Bool) -> end -> Parser end ShortByteString
shortByteStringUntil :: forall end. (Word8 -> Bool) -> end -> Parser end ShortByteString
shortByteStringUntil Word8 -> Bool
f end
e =
(Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString)
-> (Core -> Policy -> Dec end ShortByteString)
-> Parser end ShortByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: (ByteString -> ByteString) -> Dec end ShortByteString
long ByteString -> ByteString
acc = (Word8 -> Bool)
-> Copying
-> end
-> (ByteString -> ShortByteString)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ShortByteString
forall e a.
(Word8 -> Bool)
-> Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeUntil_ Word8 -> Bool
f Copying
Original end
e
(\ByteString
r -> Int -> ByteString -> ShortByteString
toShortLen (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Int) -> ByteOffset -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
L.length ByteString
r) ByteString
r) More
more Policy
pol
ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then (ByteString -> ByteString) -> Dec end ShortByteString
long ByteString -> ByteString
forall a. a -> a
id
else
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f ByteString
bs' of
Just Int
x ->
let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
!r :: ShortByteString
r = ByteString -> ShortByteString
Short.toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeTake Int
x ByteString
bs'
in Core -> Res end ShortByteString -> Dec end ShortByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ShortByteString -> Res end ShortByteString
forall a e. a -> Res e a
Yes ShortByteString
r)
Maybe Int
Nothing -> (ByteString -> ByteString) -> Dec end ShortByteString
long (ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs')
{-# INLINE lazyByteStringUntil #-}
lazyByteStringUntil :: (Word8 -> Bool) -> end -> Parser end L.ByteString
lazyByteStringUntil :: forall end. (Word8 -> Bool) -> end -> Parser end ByteString
lazyByteStringUntil Word8 -> Bool
f end
e =
(Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ByteString) -> Parser end ByteString)
-> (Core -> Policy -> Dec end ByteString) -> Parser end ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
acc = (Word8 -> Bool)
-> Copying
-> end
-> (ByteString -> ByteString)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ByteString
forall e a.
(Word8 -> Bool)
-> Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeUntil_ Word8 -> Bool
f Copying
Copy end
e ByteString -> ByteString
forall a. a -> a
id More
more Policy
pol ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then (ByteString -> ByteString) -> Dec end ByteString
long ByteString -> ByteString
forall a. a -> a
id
else
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f ByteString
bs' of
Just Int
x ->
let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
!raw :: ByteString
raw = Copying -> Int -> Int -> ByteString -> ByteString
sliceCopy Copying
Copy Int
o Int
x ByteString
bs
!r :: ByteString
r = ByteString -> ByteString -> ByteString
L.Chunk ByteString
raw ByteString
L.Empty
in Core -> Res end ByteString -> Dec end ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (ByteString -> Res end ByteString
forall a e. a -> Res e a
Yes ByteString
r)
Maybe Int
Nothing -> (ByteString -> ByteString) -> Dec end ByteString
long (ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs')
takeUntil_
:: (Word8 -> Bool)
-> Copying
-> e
-> (L.ByteString -> a)
-> More
-> Policy
-> (L.ByteString -> L.ByteString)
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e a
takeUntil_ :: forall e a.
(Word8 -> Bool)
-> Copying
-> e
-> (ByteString -> a)
-> More
-> Policy
-> (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e a
takeUntil_ Word8 -> Bool
f Copying
copy e
e ByteString -> a
conv More
more Policy
pol = (ByteString -> ByteString)
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go
where
go :: (ByteString -> ByteString)
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go ByteString -> ByteString
acc ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e a
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a)
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f ByteString
bs' of
Just Int
x ->
let !r :: a
r = ByteString -> a
conv (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
acc (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict (Copying -> Int -> ByteString -> ByteString
takeCopy Copying
copy Int
x ByteString
bs')
in Core -> Res e a -> Dec e a
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
x, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (a -> Res e a
forall a e. a -> Res e a
Yes a
r)
Maybe Int
Nothing -> (ByteString -> ByteString)
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a
go (\ByteString
r -> ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs' ByteString
r) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
type Carry = (# TotalOffset, L.ByteString -> L.ByteString #)
carry1 :: B.ByteString -> Carry -> Carry
carry1 :: ByteString -> Carry -> Carry
carry1 ByteString
bs (# ByteOffset
n, ByteString -> ByteString
acc #) =
let !n' :: ByteOffset
n' = ByteOffset
n ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
in (# ByteOffset
n', \ByteString
r -> ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
bs ByteString
r #)
carryN :: L.ByteString -> Carry -> Carry
carryN :: ByteString -> Carry -> Carry
carryN ByteString
bss Carry
c =
case ByteString
bss of
ByteString
L.Empty -> Carry
c
L.Chunk ByteString
b ByteString
bs ->
let !c' :: Carry
c' = ByteString -> Carry -> Carry
carry1 ByteString
b Carry
c
in ByteString -> Carry -> Carry
carryN ByteString
bs Carry
c'
type CarryRoll = (# TotalOffset, L.ByteString -> L.ByteString, Rollback #)
carryRoll :: B.ByteString -> CarryRoll -> CarryRoll
carryRoll :: ByteString -> CarryRoll -> CarryRoll
carryRoll ByteString
b (# ByteOffset
n, ByteString -> ByteString
acc, Rollback
roll #) =
let !n' :: ByteOffset
n' = ByteOffset
n ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
b)
in (# ByteOffset
n', \ByteString
r -> ByteString -> ByteString
acc (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
L.Chunk ByteString
b ByteString
r, Rollback -> ByteString -> Rollback
Rollback Rollback
roll ByteString
b #)
{-# INLINE lazyByteStringRest #-}
lazyByteStringRest :: Parser never L.ByteString
lazyByteStringRest :: forall never. Parser never ByteString
lazyByteStringRest =
(Core -> Policy -> Dec never ByteString) -> Parser never ByteString
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never ByteString)
-> Parser never ByteString)
-> (Core -> Policy -> Dec never ByteString)
-> Parser never ByteString
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
case More
more of
More
End ->
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteString -> ByteOffset
L.length ByteString
lbs
!r :: ByteString
r = ByteString -> ByteString -> ByteString
L.chunk (Copying -> Int -> ByteString -> ByteString
dropCopy Copying
Copy Int
o ByteString
bs) ByteString
lbs
in Core -> Res never ByteString -> Dec never ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
0, ByteString
B.empty, ByteString
L.Empty, More
End, Rollback
roll #) (ByteString -> Res never ByteString
forall a e. a -> Res e a
Yes ByteString
r)
More
More ->
let !i' :: ByteOffset
i' = ByteOffset
i ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
!(# ByteString -> ByteString
acc0 #) | Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = (# ByteString -> ByteString
forall a. a -> a
id #)
| Bool
otherwise = let !r :: ByteString
r = Copying -> Int -> ByteString -> ByteString
dropCopy Copying
Copy Int
o ByteString
bs
in (# ByteString -> ByteString -> ByteString
L.chunk ByteString
r #)
in (ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> Rollback
-> Policy
-> Dec never ByteString
forall e.
(ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> Rollback
-> Policy
-> Dec e ByteString
lazyByteStringRest_ ByteString -> ByteString
acc0 ByteOffset
i' ByteString
lbs Rollback
roll Policy
pol
lazyByteStringRest_
:: (L.ByteString -> L.ByteString)
-> TotalOffset -> L.ByteString -> Rollback -> Policy -> Dec e L.ByteString
lazyByteStringRest_ :: forall e.
(ByteString -> ByteString)
-> ByteOffset
-> ByteString
-> Rollback
-> Policy
-> Dec e ByteString
lazyByteStringRest_ ByteString -> ByteString
acc0 ByteOffset
i' ByteString
lbs Rollback
roll Policy
pol =
case Policy
pol of
Policy
Drop ->
let !c :: Carry
c = ByteString -> Carry -> Carry
carryN ByteString
lbs (# ByteOffset
i', ByteString -> ByteString
acc0 #)
in Carry -> Dec e ByteString
forall {e}. Carry -> Dec e ByteString
flush Carry
c
where
flush :: Carry -> Dec e ByteString
flush carry :: Carry
carry@(# ByteOffset
n, ByteString -> ByteString
acc #) =
(Resupply -> Dec e ByteString) -> Dec e ByteString
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec e ByteString) -> Dec e ByteString)
-> (Resupply -> Dec e ByteString) -> Dec e ByteString
forall a b. (a -> b) -> a -> b
$ \Resupply
resupply ->
case Resupply
resupply of
Supply ByteString
bsR ->
let !carry' :: Carry
carry' = ByteString -> Carry -> Carry
carry1 ByteString
bsR Carry
carry
in Carry -> Dec e ByteString
flush Carry
carry'
Resupply
EndOfInput ->
let !r :: ByteString
r = ByteString -> ByteString
acc ByteString
L.empty
in Core -> Res e ByteString -> Dec e ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
n, Int
0, ByteString
B.empty, ByteString
L.Empty, More
End, Rollback
roll #) (ByteString -> Res e ByteString
forall a e. a -> Res e a
Yes ByteString
r)
Policy
Keep ->
let !(# ByteOffset
i'', ByteString -> ByteString
acc1 #) = ByteString -> Carry -> Carry
carryN ByteString
lbs (# ByteOffset
i', ByteString -> ByteString
acc0 #)
in CarryRoll -> Dec e ByteString
forall {e}. CarryRoll -> Dec e ByteString
flush (# ByteOffset
i'', ByteString -> ByteString
acc1, Rollback
roll #)
where
flush :: CarryRoll -> Dec e ByteString
flush carry :: CarryRoll
carry@(# ByteOffset
n, ByteString -> ByteString
acc, Rollback
roll' #) =
(Resupply -> Dec e ByteString) -> Dec e ByteString
forall e a. (Resupply -> Dec e a) -> Dec e a
Re ((Resupply -> Dec e ByteString) -> Dec e ByteString)
-> (Resupply -> Dec e ByteString) -> Dec e ByteString
forall a b. (a -> b) -> a -> b
$ \Resupply
resupply ->
case Resupply
resupply of
Supply ByteString
bsR ->
let !carry' :: CarryRoll
carry' = ByteString -> CarryRoll -> CarryRoll
carryRoll ByteString
bsR CarryRoll
carry
in CarryRoll -> Dec e ByteString
flush CarryRoll
carry'
Resupply
EndOfInput ->
let !r :: ByteString
r = ByteString -> ByteString
acc ByteString
L.empty
in Core -> Res e ByteString -> Dec e ByteString
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
n, Int
0, ByteString
B.empty, ByteString
L.Empty, More
End, Rollback
roll' #) (ByteString -> Res e ByteString
forall a e. a -> Res e a
Yes ByteString
r)
{-# INLINE skip #-}
skip :: Int64 -> end -> Parser end ()
skip :: forall end. ByteOffset -> end -> Parser end ()
skip ByteOffset
n end
e =
(Core -> Policy -> Dec end ()) -> Parser end ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ()) -> Parser end ())
-> (Core -> Policy -> Dec end ()) -> Parser end ()
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
if ByteOffset
n ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteOffset
0
then Core -> Res end () -> Dec end ()
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (() -> Res end ()
forall a e. a -> Res e a
Yes ())
else Parser end () -> Core -> Policy -> Dec end ()
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (ByteOffset -> end -> Parser end ()
forall end. ByteOffset -> end -> Parser end ()
unsafeSkip ByteOffset
n end
e) Core
core Policy
pol
{-# INLINE unsafeSkip #-}
unsafeSkip :: Int64 -> end -> Parser end ()
unsafeSkip :: forall end. ByteOffset -> end -> Parser end ()
unsafeSkip ByteOffset
n end
e =
(Core -> Policy -> Dec end ()) -> Parser end ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ()) -> Parser end ())
-> (Core -> Policy -> Dec end ()) -> Parser end ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let o' :: ByteOffset
o' = Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
n
n' :: ByteOffset
n' = ByteOffset
o' ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
in if ByteOffset
n' ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteOffset
0
then let !m :: Int
m = ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
o'
in Core -> Res end () -> Dec end ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
m, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res end ()
forall a e. a -> Res e a
Yes ())
else end
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ()
forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skip_ end
e More
more Policy
pol ByteOffset
n' ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
skip_
:: e
-> More
-> Policy
-> Int64
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skip_ :: forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skip_ e
e More
more Policy
pol = ByteOffset
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
forall {t}.
Integral t =>
t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go !t
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e ()
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
let n' :: t
n' = t
n t -> t -> t
forall a. Num a => a -> a -> a
- Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs')
in if t
n' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
then let !m :: Int
m = t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n
in Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
m, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
else t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go t
n' ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE skipEndOr #-}
skipEndOr :: Int64 -> Parser never ()
skipEndOr :: forall never. ByteOffset -> Parser never ()
skipEndOr ByteOffset
n =
(Core -> Policy -> Dec never ()) -> Parser never ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never ()) -> Parser never ())
-> (Core -> Policy -> Dec never ()) -> Parser never ()
forall a b. (a -> b) -> a -> b
$ \Core
core Policy
pol ->
if ByteOffset
n ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteOffset
0
then Core -> Res never () -> Dec never ()
forall e a. Core -> Res e a -> Dec e a
Fin Core
core (() -> Res never ()
forall a e. a -> Res e a
Yes ())
else Parser never () -> Core -> Policy -> Dec never ()
forall e a. Parser e a -> Core -> Policy -> Dec e a
runParser (ByteOffset -> Parser never ()
forall never. ByteOffset -> Parser never ()
unsafeSkipEndOr ByteOffset
n) Core
core Policy
pol
{-# INLINE unsafeSkipEndOr #-}
unsafeSkipEndOr :: Int64 -> Parser never ()
unsafeSkipEndOr :: forall never. ByteOffset -> Parser never ()
unsafeSkipEndOr ByteOffset
n =
(Core -> Policy -> Dec never ()) -> Parser never ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never ()) -> Parser never ())
-> (Core -> Policy -> Dec never ()) -> Parser never ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let o' :: ByteOffset
o' = Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
n
n' :: ByteOffset
n' = ByteOffset
o' ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
in if ByteOffset
n' ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteOffset
0
then let !m :: Int
m = ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
o'
in Core -> Res never () -> Dec never ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
m, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res never ()
forall a e. a -> Res e a
Yes ())
else More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec never ()
forall e.
More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipEndOr_ More
more Policy
pol ByteOffset
n' ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
skipEndOr_
:: More
-> Policy
-> Int64
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skipEndOr_ :: forall e.
More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipEndOr_ More
more Policy
pol = ByteOffset
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
forall {t} {e}.
Integral t =>
t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go !t
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (() -> Res e ()
forall a e. a -> Res e a
Yes ()) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
let n' :: t
n' = t
n t -> t -> t
forall a. Num a => a -> a -> a
- Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs')
in if t
n' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
then let !m :: Int
m = t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n
in Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
m, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
else t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go t
n' ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE skipNul #-}
skipNul :: end -> Parser end ()
skipNul :: forall end. end -> Parser end ()
skipNul end
e =
(Core -> Policy -> Dec end ()) -> Parser end ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ()) -> Parser end ())
-> (Core -> Policy -> Dec end ()) -> Parser end ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: ByteOffset -> Dec end ()
long ByteOffset
n = end
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ()
forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipNul_ end
e More
more Policy
pol ByteOffset
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then ByteOffset -> Dec end ()
long ByteOffset
0
else
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
0 (Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs) of
Just Int
x ->
let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Core -> Res end () -> Dec end ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res end ()
forall a e. a -> Res e a
Yes ())
Maybe Int
Nothing -> ByteOffset -> Dec end ()
long (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)
skipNul_
:: e
-> More
-> Policy
-> Int64
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skipNul_ :: forall e.
e
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipNul_ e
e More
more Policy
pol = ByteOffset
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
forall {t}.
Num t =>
t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go !t
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e ()
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
0 ByteString
bs' of
Just Int
x -> let !o' :: Int
o' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
o', ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
Maybe Int
Nothing -> t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs')) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE skipUntil #-}
skipUntil :: (Word8 -> Bool) -> end -> Parser end ()
skipUntil :: forall end. (Word8 -> Bool) -> end -> Parser end ()
skipUntil Word8 -> Bool
f end
e =
(Core -> Policy -> Dec end ()) -> Parser end ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec end ()) -> Parser end ())
-> (Core -> Policy -> Dec end ()) -> Parser end ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: ByteOffset -> Dec end ()
long ByteOffset
n = (Word8 -> Bool)
-> end
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec end ()
forall e.
(Word8 -> Bool)
-> e
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipUntil_ Word8 -> Bool
f end
e More
more Policy
pol ByteOffset
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then ByteOffset -> Dec end ()
long ByteOffset
0
else
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f (Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs) of
Just Int
x ->
let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
in Core -> Res end () -> Dec end ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res end ()
forall a e. a -> Res e a
Yes ())
Maybe Int
Nothing -> ByteOffset -> Dec end ()
long (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)
skipUntil_
:: (Word8 -> Bool)
-> e
-> More
-> Policy
-> Int64
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skipUntil_ :: forall e.
(Word8 -> Bool)
-> e
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipUntil_ Word8 -> Bool
f e
e More
more Policy
pol = ByteOffset
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
forall {t}.
Num t =>
t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go !t
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (e -> Res e ()
forall e a. e -> Res e a
No e
e) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f ByteString
bs' of
Just Int
x -> Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
x, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
Maybe Int
Nothing -> t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs')) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'
{-# INLINE skipUntilEndOr #-}
skipUntilEndOr :: (Word8 -> Bool) -> Parser never ()
skipUntilEndOr :: forall never. (Word8 -> Bool) -> Parser never ()
skipUntilEndOr Word8 -> Bool
f =
(Core -> Policy -> Dec never ()) -> Parser never ()
forall e a. (Core -> Policy -> Dec e a) -> Parser e a
Parser ((Core -> Policy -> Dec never ()) -> Parser never ())
-> (Core -> Policy -> Dec never ()) -> Parser never ()
forall a b. (a -> b) -> a -> b
$ \(# ByteOffset
i, Int
o, ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) Policy
pol ->
let long :: ByteOffset -> Dec e ()
long ByteOffset
n = (Word8 -> Bool)
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
forall e.
(Word8 -> Bool)
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipUntilEndOr_ Word8 -> Bool
f More
more Policy
pol ByteOffset
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll
in if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs
then ByteOffset -> Dec never ()
forall {e}. ByteOffset -> Dec e ()
long ByteOffset
0
else
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f (Int -> ByteString -> ByteString
B.unsafeDrop Int
o ByteString
bs) of
Just Int
x ->
let !o' :: Int
o' = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
in Core -> Res never () -> Dec never ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i, Int
o', ByteString
bs, ByteString
lbs, More
more, Rollback
roll #) (() -> Res never ()
forall a e. a -> Res e a
Yes ())
Maybe Int
Nothing -> ByteOffset -> Dec never ()
forall {e}. ByteOffset -> Dec e ()
long (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)
skipUntilEndOr_
:: (Word8 -> Bool)
-> More
-> Policy
-> Int64
-> TotalOffset
-> B.ByteString
-> L.ByteString
-> Rollback
-> Dec e ()
skipUntilEndOr_ :: forall e.
(Word8 -> Bool)
-> More
-> Policy
-> ByteOffset
-> ByteOffset
-> ByteString
-> ByteString
-> Rollback
-> Dec e ()
skipUntilEndOr_ Word8 -> Bool
f More
more Policy
pol = ByteOffset
-> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
forall {t} {e}.
Num t =>
t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go
where
go :: t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go !t
n ByteOffset
i ByteString
bs ByteString
lbs Rollback
roll =
Res e ()
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall e a.
Res e a
-> ByteOffset
-> ByteString
-> ByteString
-> More
-> Rollback
-> Policy
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e a)
-> Dec e a
advance (() -> Res e ()
forall a e. a -> Res e a
Yes ()) ByteOffset
i ByteString
bs ByteString
lbs More
more Rollback
roll Policy
pol ((ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ())
-> (ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ())
-> Dec e ()
forall a b. (a -> b) -> a -> b
$ \ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll' ->
case (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex Word8 -> Bool
f ByteString
bs' of
Just Int
x -> Core -> Res e () -> Dec e ()
forall e a. Core -> Res e a -> Dec e a
Fin (# ByteOffset
i', Int
x, ByteString
bs', ByteString
lbs', More
more, Rollback
roll' #) (() -> Res e ()
forall a e. a -> Res e a
Yes ())
Maybe Int
Nothing -> t -> ByteOffset -> ByteString -> ByteString -> Rollback -> Dec e ()
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs')) ByteOffset
i' ByteString
bs' ByteString
lbs' Rollback
roll'