{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
RecordWildCards #-}
module Data.Attoparsec.ByteString.Internal
(
Parser
, Result
, parse
, parseOnly
, module Data.Attoparsec.Combinator
, satisfy
, satisfyWith
, anyWord8
, skip
, word8
, notWord8
, peekWord8
, peekWord8'
, inClass
, notInClass
, storable
, skipWhile
, string
, stringCI
, take
, scan
, runScanner
, takeWhile
, takeWhile1
, takeTill
, takeByteString
, takeLazyByteString
, endOfLine
, endOfInput
, match
, atEnd
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Applicative ((<|>))
import Control.Monad (when)
import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
import Data.Attoparsec.Combinator ((<?>))
import Data.Attoparsec.Internal
import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
import Data.ByteString (ByteString)
import Data.List (intercalate)
import Data.Word (Word8)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (castPtr, minusPtr, plusPtr)
import Foreign.Storable (Storable(peek, sizeOf))
import Prelude hiding (getChar, succ, take, takeWhile)
import qualified Data.Attoparsec.ByteString.Buffer as Buf
import qualified Data.Attoparsec.Internal.Types as T
import qualified Data.ByteString as B8
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Unsafe as B
type Parser = T.Parser ByteString
type Result = IResult ByteString
type Failure r = T.Failure ByteString Buffer r
type Success a r = T.Success ByteString Buffer a r
satisfy :: (Word8 -> Bool) -> Parser Word8
satisfy :: (Word8 -> Bool) -> Parser Word8
satisfy p :: Word8 -> Bool
p = do
Word8
h <- Parser Word8
peekWord8'
if Word8 -> Bool
p Word8
h
then Int -> Parser ()
advance 1 Parser () -> Parser Word8 -> Parser Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Parser Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
h
else String -> Parser Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "satisfy"
{-# INLINE satisfy #-}
skip :: (Word8 -> Bool) -> Parser ()
skip :: (Word8 -> Bool) -> Parser ()
skip p :: Word8 -> Bool
p = do
Word8
h <- Parser Word8
peekWord8'
if Word8 -> Bool
p Word8
h
then Int -> Parser ()
advance 1
else String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "skip"
satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
satisfyWith f :: Word8 -> a
f p :: a -> Bool
p = do
Word8
h <- Parser Word8
peekWord8'
let c :: a
c = Word8 -> a
f Word8
h
if a -> Bool
p a
c
then Int -> Parser ()
advance 1 Parser () -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c
else String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "satisfyWith"
{-# INLINE satisfyWith #-}
storable :: Storable a => Parser a
storable :: Parser a
storable = a -> Parser a
forall b. Storable b => b -> Parser b
hack a
forall a. HasCallStack => a
undefined
where
hack :: Storable b => b -> Parser b
hack :: b -> Parser b
hack dummy :: b
dummy = do
(fp :: ForeignPtr Word8
fp,o :: Int
o,_) <- ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> Parser ByteString ByteString
-> Parser ByteString (ForeignPtr Word8, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Parser ByteString ByteString
take (b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy)
b -> Parser b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Parser b)
-> ((Ptr Word8 -> IO b) -> b) -> (Ptr Word8 -> IO b) -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> b
forall a. IO a -> a
inlinePerformIO (IO b -> b)
-> ((Ptr Word8 -> IO b) -> IO b) -> (Ptr Word8 -> IO b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Word8 -> (Ptr Word8 -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO b) -> Parser b)
-> (Ptr Word8 -> IO b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p ->
Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o)
take :: Int -> Parser ByteString
take :: Int -> Parser ByteString ByteString
take n0 :: Int
n0 = do
let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n0 0
ByteString
s <- Int -> Parser ByteString ByteString
ensure Int
n
Int -> Parser ()
advance Int
n Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
{-# INLINE take #-}
string :: ByteString -> Parser ByteString
string :: ByteString -> Parser ByteString ByteString
string s :: ByteString
s = (forall r.
ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r)
-> (ByteString -> ByteString)
-> ByteString
-> Parser ByteString ByteString
string_ ((ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
forall r.
(ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
stringSuspended ByteString -> ByteString
forall a. a -> a
id) ByteString -> ByteString
forall a. a -> a
id ByteString
s
{-# INLINE string #-}
toLower :: Word8 -> Word8
toLower :: Word8 -> Word8
toLower w :: Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 65 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 90 = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 32
| Bool
otherwise = Word8
w
stringCI :: ByteString -> Parser ByteString
stringCI :: ByteString -> Parser ByteString ByteString
stringCI s :: ByteString
s = (forall r.
ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r)
-> (ByteString -> ByteString)
-> ByteString
-> Parser ByteString ByteString
string_ ((ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
forall r.
(ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
stringSuspended ByteString -> ByteString
lower) ByteString -> ByteString
lower ByteString
s
where lower :: ByteString -> ByteString
lower = (Word8 -> Word8) -> ByteString -> ByteString
B8.map Word8 -> Word8
toLower
{-# INLINE stringCI #-}
string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More
-> Failure r -> Success ByteString r -> Result r)
-> (ByteString -> ByteString)
-> ByteString -> Parser ByteString
string_ :: (forall r.
ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r)
-> (ByteString -> ByteString)
-> ByteString
-> Parser ByteString ByteString
string_ suspended :: forall r.
ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
suspended f :: ByteString -> ByteString
f s0 :: ByteString
s0 = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more lose :: Failure ByteString (State ByteString) r
lose succ :: Success ByteString (State ByteString) ByteString r
succ ->
let n :: Int
n = ByteString -> Int
B.length ByteString
s
s :: ByteString
s = ByteString -> ByteString
f ByteString
s0
in if Pos -> Int -> Buffer -> Bool
lengthAtLeast Pos
pos Int
n Buffer
State ByteString
t
then let t' :: ByteString
t' = Pos -> Pos -> Buffer -> ByteString
substring Pos
pos (Int -> Pos
Pos Int
n) Buffer
State ByteString
t
in if ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
f ByteString
t'
then Success ByteString (State ByteString) ByteString r
succ State ByteString
t (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
n) More
more ByteString
t'
else Failure ByteString (State ByteString) r
lose State ByteString
t Pos
pos More
more [] "string"
else let t' :: ByteString
t' = Int -> Buffer -> ByteString
Buf.unsafeDrop (Pos -> Int
fromPos Pos
pos) Buffer
State ByteString
t
in if ByteString -> ByteString
f ByteString
t' ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
s
then ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
forall r.
ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
suspended ByteString
s (Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
t') ByteString
s) Buffer
State ByteString
t Pos
pos More
more Failure r
Failure ByteString (State ByteString) r
lose Success ByteString r
Success ByteString (State ByteString) ByteString r
succ
else Failure ByteString (State ByteString) r
lose State ByteString
t Pos
pos More
more [] "string"
{-# INLINE string_ #-}
stringSuspended :: (ByteString -> ByteString)
-> ByteString -> ByteString -> Buffer -> Pos -> More
-> Failure r
-> Success ByteString r
-> Result r
stringSuspended :: (ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
stringSuspended f :: ByteString -> ByteString
f s0 :: ByteString
s0 s :: ByteString
s t :: Buffer
t pos :: Pos
pos more :: More
more lose :: Failure r
lose succ :: Success ByteString r
succ =
Parser ByteString ByteString
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> Result r
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
runParser (Parser ByteString ByteString
forall t. Chunk t => Parser t t
demandInput_ Parser ByteString ByteString
-> (ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Parser ByteString ByteString
go) Buffer
State ByteString
t Pos
pos More
more Failure r
Failure ByteString (State ByteString) r
lose Success ByteString r
Success ByteString (State ByteString) ByteString r
succ
where go :: ByteString -> Parser ByteString ByteString
go s'0 :: ByteString
s'0 = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \t' :: State ByteString
t' pos' :: Pos
pos' more' :: More
more' lose' :: Failure ByteString (State ByteString) r
lose' succ' :: Success ByteString (State ByteString) ByteString r
succ' ->
let m :: Int
m = ByteString -> Int
B.length ByteString
s
s' :: ByteString
s' = ByteString -> ByteString
f ByteString
s'0
n :: Int
n = ByteString -> Int
B.length ByteString
s'
in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m
then if Int -> ByteString -> ByteString
B.unsafeTake Int
m ByteString
s' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
s
then let o :: Pos
o = Int -> Pos
Pos (ByteString -> Int
B.length ByteString
s0)
in Success ByteString (State ByteString) ByteString r
succ' State ByteString
t' (Pos
pos' Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Pos
o) More
more'
(Pos -> Pos -> Buffer -> ByteString
substring Pos
pos' Pos
o Buffer
State ByteString
t')
else Failure ByteString (State ByteString) r
lose' State ByteString
t' Pos
pos' More
more' [] "string"
else if ByteString
s' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
s
then (ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
forall r.
(ByteString -> ByteString)
-> ByteString
-> ByteString
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
stringSuspended ByteString -> ByteString
f ByteString
s0 (Int -> ByteString -> ByteString
B.unsafeDrop Int
n ByteString
s)
Buffer
State ByteString
t' Pos
pos' More
more' Failure r
Failure ByteString (State ByteString) r
lose' Success ByteString r
Success ByteString (State ByteString) ByteString r
succ'
else Failure ByteString (State ByteString) r
lose' State ByteString
t' Pos
pos' More
more' [] "string"
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile p :: Word8 -> Bool
p = Parser ()
go
where
go :: Parser ()
go = do
ByteString
t <- (Word8 -> Bool) -> ByteString -> ByteString
B8.takeWhile Word8 -> Bool
p (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
get
Bool
continue <- Int -> Parser Bool
inputSpansChunks (ByteString -> Int
B.length ByteString
t)
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue Parser ()
go
{-# INLINE skipWhile #-}
takeTill :: (Word8 -> Bool) -> Parser ByteString
takeTill :: (Word8 -> Bool) -> Parser ByteString ByteString
takeTill p :: Word8 -> Bool
p = (Word8 -> Bool) -> Parser ByteString ByteString
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
p)
{-# INLINE takeTill #-}
takeWhile :: (Word8 -> Bool) -> Parser ByteString
takeWhile :: (Word8 -> Bool) -> Parser ByteString ByteString
takeWhile p :: Word8 -> Bool
p = do
ByteString
s <- (Word8 -> Bool) -> ByteString -> ByteString
B8.takeWhile Word8 -> Bool
p (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
get
Bool
continue <- Int -> Parser Bool
inputSpansChunks (ByteString -> Int
B.length ByteString
s)
if Bool
continue
then (Word8 -> Bool) -> [ByteString] -> Parser ByteString ByteString
takeWhileAcc Word8 -> Bool
p [ByteString
s]
else ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
{-# INLINE takeWhile #-}
takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString ByteString
takeWhileAcc p :: Word8 -> Bool
p = [ByteString] -> Parser ByteString ByteString
go
where
go :: [ByteString] -> Parser ByteString ByteString
go acc :: [ByteString]
acc = do
ByteString
s <- (Word8 -> Bool) -> ByteString -> ByteString
B8.takeWhile Word8 -> Bool
p (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
get
Bool
continue <- Int -> Parser Bool
inputSpansChunks (ByteString -> Int
B.length ByteString
s)
if Bool
continue
then [ByteString] -> Parser ByteString ByteString
go (ByteString
sByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
else ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall m. Monoid m => [m] -> m
concatReverse (ByteString
sByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
{-# INLINE takeWhileAcc #-}
takeRest :: Parser [ByteString]
takeRest :: Parser [ByteString]
takeRest = [ByteString] -> Parser [ByteString]
go []
where
go :: [ByteString] -> Parser [ByteString]
go acc :: [ByteString]
acc = do
Bool
input <- Parser Bool
forall t. Chunk t => Parser t Bool
wantInput
if Bool
input
then do
ByteString
s <- Parser ByteString ByteString
get
Int -> Parser ()
advance (ByteString -> Int
B.length ByteString
s)
[ByteString] -> Parser [ByteString]
go (ByteString
sByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
else [ByteString] -> Parser [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
takeByteString :: Parser ByteString
takeByteString :: Parser ByteString ByteString
takeByteString = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> Parser [ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [ByteString]
takeRest
takeLazyByteString :: Parser L.ByteString
takeLazyByteString :: Parser ByteString
takeLazyByteString = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> Parser [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [ByteString]
takeRest
data T s = T {-# UNPACK #-} !Int s
scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
-> Parser r
scan_ :: (s -> [ByteString] -> Parser r)
-> s -> (s -> Word8 -> Maybe s) -> Parser r
scan_ f :: s -> [ByteString] -> Parser r
f s0 :: s
s0 p :: s -> Word8 -> Maybe s
p = [ByteString] -> s -> Parser r
go [] s
s0
where
go :: [ByteString] -> s -> Parser r
go acc :: [ByteString]
acc s1 :: s
s1 = do
let scanner :: ByteString -> IO (T s)
scanner (B.PS fp :: ForeignPtr Word8
fp off :: Int
off len :: Int
len) =
ForeignPtr Word8 -> (Ptr Word8 -> IO (T s)) -> IO (T s)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (T s)) -> IO (T s))
-> (Ptr Word8 -> IO (T s)) -> IO (T s)
forall a b. (a -> b) -> a -> b
$ \ptr0 :: Ptr Word8
ptr0 -> do
let start :: Ptr Word8
start = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
end :: Ptr Word8
end = Ptr Word8
start Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
inner :: Ptr Word8 -> s -> IO (T s)
inner ptr :: Ptr Word8
ptr !s
s
| Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end = do
Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
case s -> Word8 -> Maybe s
p s
s Word8
w of
Just s' :: s
s' -> Ptr Word8 -> s -> IO (T s)
inner (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) s
s'
_ -> Int -> s -> IO (T s)
forall (m :: * -> *) s. Monad m => Int -> s -> m (T s)
done (Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start) s
s
| Bool
otherwise = Int -> s -> IO (T s)
forall (m :: * -> *) s. Monad m => Int -> s -> m (T s)
done (Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start) s
s
done :: Int -> s -> m (T s)
done !Int
i !s
s = T s -> m (T s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> s -> T s
forall s. Int -> s -> T s
T Int
i s
s)
Ptr Word8 -> s -> IO (T s)
inner Ptr Word8
start s
s1
ByteString
bs <- Parser ByteString ByteString
get
let T i :: Int
i s' :: s
s' = IO (T s) -> T s
forall a. IO a -> a
inlinePerformIO (IO (T s) -> T s) -> IO (T s) -> T s
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (T s)
scanner ByteString
bs
!h :: ByteString
h = Int -> ByteString -> ByteString
B.unsafeTake Int
i ByteString
bs
Bool
continue <- Int -> Parser Bool
inputSpansChunks Int
i
if Bool
continue
then [ByteString] -> s -> Parser r
go (ByteString
hByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc) s
s'
else s -> [ByteString] -> Parser r
f s
s' (ByteString
hByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
{-# INLINE scan_ #-}
scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString ByteString
scan = (s -> [ByteString] -> Parser ByteString ByteString)
-> s -> (s -> Word8 -> Maybe s) -> Parser ByteString ByteString
forall s r.
(s -> [ByteString] -> Parser r)
-> s -> (s -> Word8 -> Maybe s) -> Parser r
scan_ ((s -> [ByteString] -> Parser ByteString ByteString)
-> s -> (s -> Word8 -> Maybe s) -> Parser ByteString ByteString)
-> (s -> [ByteString] -> Parser ByteString ByteString)
-> s
-> (s -> Word8 -> Maybe s)
-> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \_ chunks :: [ByteString]
chunks -> ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
forall m. Monoid m => [m] -> m
concatReverse [ByteString]
chunks
{-# INLINE scan #-}
runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
runScanner = (s -> [ByteString] -> Parser (ByteString, s))
-> s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
forall s r.
(s -> [ByteString] -> Parser r)
-> s -> (s -> Word8 -> Maybe s) -> Parser r
scan_ ((s -> [ByteString] -> Parser (ByteString, s))
-> s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s))
-> (s -> [ByteString] -> Parser (ByteString, s))
-> s
-> (s -> Word8 -> Maybe s)
-> Parser (ByteString, s)
forall a b. (a -> b) -> a -> b
$ \s :: s
s xs :: [ByteString]
xs -> let !sx :: ByteString
sx = [ByteString] -> ByteString
forall m. Monoid m => [m] -> m
concatReverse [ByteString]
xs in (ByteString, s) -> Parser (ByteString, s)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
sx, s
s)
{-# INLINE runScanner #-}
takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
takeWhile1 :: (Word8 -> Bool) -> Parser ByteString ByteString
takeWhile1 p :: Word8 -> Bool
p = do
(Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` Parser ()
forall t. Chunk t => Parser t ()
demandInput) (Bool -> Parser ()) -> Parser Bool -> Parser ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Bool
endOfChunk
ByteString
s <- (Word8 -> Bool) -> ByteString -> ByteString
B8.takeWhile Word8 -> Bool
p (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
get
let len :: Int
len = ByteString -> Int
B.length ByteString
s
if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then String -> Parser ByteString ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "takeWhile1"
else do
Int -> Parser ()
advance Int
len
Bool
eoc <- Parser Bool
endOfChunk
if Bool
eoc
then (Word8 -> Bool) -> [ByteString] -> Parser ByteString ByteString
takeWhileAcc Word8 -> Bool
p [ByteString
s]
else ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
{-# INLINE takeWhile1 #-}
inClass :: String -> Word8 -> Bool
inClass :: String -> Word8 -> Bool
inClass s :: String
s = (Word8 -> FastSet -> Bool
`memberWord8` FastSet
mySet)
where mySet :: FastSet
mySet = String -> FastSet
charClass String
s
{-# NOINLINE mySet #-}
{-# INLINE inClass #-}
notInClass :: String -> Word8 -> Bool
notInClass :: String -> Word8 -> Bool
notInClass s :: String
s = Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Word8 -> Bool
inClass String
s
{-# INLINE notInClass #-}
anyWord8 :: Parser Word8
anyWord8 :: Parser Word8
anyWord8 = (Word8 -> Bool) -> Parser Word8
satisfy ((Word8 -> Bool) -> Parser Word8)
-> (Word8 -> Bool) -> Parser Word8
forall a b. (a -> b) -> a -> b
$ Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True
{-# INLINE anyWord8 #-}
word8 :: Word8 -> Parser Word8
word8 :: Word8 -> Parser Word8
word8 c :: Word8
c = (Word8 -> Bool) -> Parser Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
<?> Word8 -> String
forall a. Show a => a -> String
show Word8
c
{-# INLINE word8 #-}
notWord8 :: Word8 -> Parser Word8
notWord8 :: Word8 -> Parser Word8
notWord8 c :: Word8
c = (Word8 -> Bool) -> Parser Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
c) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
<?> "not " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c
{-# INLINE notWord8 #-}
peekWord8 :: Parser (Maybe Word8)
peekWord8 :: Parser (Maybe Word8)
peekWord8 = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) (Maybe Word8) r
-> IResult ByteString r)
-> Parser (Maybe Word8)
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) (Maybe Word8) r
-> IResult ByteString r)
-> Parser (Maybe Word8))
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) (Maybe Word8) r
-> IResult ByteString r)
-> Parser (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos@(Pos pos_ :: Int
pos_) more :: More
more _lose :: Failure ByteString (State ByteString) r
_lose succ :: Success ByteString (State ByteString) (Maybe Word8) r
succ ->
case () of
_| Int
pos_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> Int
Buf.length Buffer
State ByteString
t ->
let !w :: Word8
w = Buffer -> Int -> Word8
Buf.unsafeIndex Buffer
State ByteString
t Int
pos_
in Success ByteString (State ByteString) (Maybe Word8) r
succ State ByteString
t Pos
pos More
more (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
w)
| More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete ->
Success ByteString (State ByteString) (Maybe Word8) r
succ State ByteString
t Pos
pos More
more Maybe Word8
forall a. Maybe a
Nothing
| Bool
otherwise ->
let succ' :: Buffer -> Pos -> More -> IResult ByteString r
succ' t' :: Buffer
t' pos' :: Pos
pos' more' :: More
more' = let !w :: Word8
w = Buffer -> Int -> Word8
Buf.unsafeIndex Buffer
t' Int
pos_
in Success ByteString (State ByteString) (Maybe Word8) r
succ Buffer
State ByteString
t' Pos
pos' More
more' (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
w)
lose' :: Buffer -> Pos -> More -> IResult ByteString r
lose' t' :: Buffer
t' pos' :: Pos
pos' more' :: More
more' = Success ByteString (State ByteString) (Maybe Word8) r
succ Buffer
State ByteString
t' Pos
pos' More
more' Maybe Word8
forall a. Maybe a
Nothing
in State ByteString
-> Pos
-> More
-> (State ByteString -> Pos -> More -> IResult ByteString r)
-> (State ByteString -> Pos -> More -> IResult ByteString r)
-> IResult ByteString r
forall t r.
Chunk t =>
State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State ByteString
t Pos
pos More
more Buffer -> Pos -> More -> IResult ByteString r
State ByteString -> Pos -> More -> IResult ByteString r
lose' Buffer -> Pos -> More -> IResult ByteString r
State ByteString -> Pos -> More -> IResult ByteString r
succ'
{-# INLINE peekWord8 #-}
peekWord8' :: Parser Word8
peekWord8' :: Parser Word8
peekWord8' = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Word8 r
-> IResult ByteString r)
-> Parser Word8
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Word8 r
-> IResult ByteString r)
-> Parser Word8)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Word8 r
-> IResult ByteString r)
-> Parser Word8
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more lose :: Failure ByteString (State ByteString) r
lose succ :: Success ByteString (State ByteString) Word8 r
succ ->
if Pos -> Int -> Buffer -> Bool
lengthAtLeast Pos
pos 1 Buffer
State ByteString
t
then Success ByteString (State ByteString) Word8 r
succ State ByteString
t Pos
pos More
more (Buffer -> Int -> Word8
Buf.unsafeIndex Buffer
State ByteString
t (Pos -> Int
fromPos Pos
pos))
else let succ' :: Buffer -> Pos -> More -> ByteString -> IResult ByteString r
succ' t' :: Buffer
t' pos' :: Pos
pos' more' :: More
more' bs' :: ByteString
bs' = Success ByteString (State ByteString) Word8 r
succ Buffer
State ByteString
t' Pos
pos' More
more' (Word8 -> IResult ByteString r) -> Word8 -> IResult ByteString r
forall a b. (a -> b) -> a -> b
$! ByteString -> Word8
B.unsafeHead ByteString
bs'
in Int
-> Buffer
-> Pos
-> More
-> Failure r
-> (Buffer -> Pos -> More -> ByteString -> IResult ByteString r)
-> IResult ByteString r
forall r.
Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
ensureSuspended 1 Buffer
State ByteString
t Pos
pos More
more Failure r
Failure ByteString (State ByteString) r
lose Buffer -> Pos -> More -> ByteString -> IResult ByteString r
succ'
{-# INLINE peekWord8' #-}
endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = (Word8 -> Parser Word8
word8 10 Parser Word8 -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString ByteString
string "\r\n" Parser ByteString ByteString -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
failK :: Failure a
failK :: Failure a
failK t :: Buffer
t (Pos pos :: Int
pos) _more :: More
_more stack :: [String]
stack msg :: String
msg = ByteString -> [String] -> String -> IResult ByteString a
forall i r. i -> [String] -> String -> IResult i r
Fail (Int -> Buffer -> ByteString
Buf.unsafeDrop Int
pos Buffer
t) [String]
stack String
msg
{-# INLINE failK #-}
successK :: Success a a
successK :: Success a a
successK t :: Buffer
t (Pos pos :: Int
pos) _more :: More
_more a :: a
a = ByteString -> a -> IResult ByteString a
forall i r. i -> r -> IResult i r
Done (Int -> Buffer -> ByteString
Buf.unsafeDrop Int
pos Buffer
t) a
a
{-# INLINE successK #-}
parse :: Parser a -> ByteString -> Result a
parse :: Parser a -> ByteString -> Result a
parse m :: Parser a
m s :: ByteString
s = Parser a
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) a
-> Success ByteString (State ByteString) a a
-> Result a
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
T.runParser Parser a
m (ByteString -> Buffer
buffer ByteString
s) (Int -> Pos
Pos 0) More
Incomplete Failure ByteString (State ByteString) a
forall a. Failure a
failK Success ByteString (State ByteString) a a
forall a. Success a a
successK
{-# INLINE parse #-}
parseOnly :: Parser a -> ByteString -> Either String a
parseOnly :: Parser a -> ByteString -> Either String a
parseOnly m :: Parser a
m s :: ByteString
s = case Parser a
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) a
-> Success ByteString (State ByteString) a a
-> IResult ByteString a
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
T.runParser Parser a
m (ByteString -> Buffer
buffer ByteString
s) (Int -> Pos
Pos 0) More
Complete Failure ByteString (State ByteString) a
forall a. Failure a
failK Success ByteString (State ByteString) a a
forall a. Success a a
successK of
Fail _ [] err :: String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
Fail _ ctxs :: [String]
ctxs err :: String
err -> String -> Either String a
forall a b. a -> Either a b
Left (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " > " [String]
ctxs String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
Done _ a :: a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
_ -> String -> Either String a
forall a. HasCallStack => String -> a
error "parseOnly: impossible error!"
{-# INLINE parseOnly #-}
get :: Parser ByteString
get :: Parser ByteString ByteString
get = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more _lose :: Failure ByteString (State ByteString) r
_lose succ :: Success ByteString (State ByteString) ByteString r
succ ->
Success ByteString (State ByteString) ByteString r
succ State ByteString
t Pos
pos More
more (Int -> Buffer -> ByteString
Buf.unsafeDrop (Pos -> Int
fromPos Pos
pos) Buffer
State ByteString
t)
{-# INLINE get #-}
endOfChunk :: Parser Bool
endOfChunk :: Parser Bool
endOfChunk = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Bool r
-> IResult ByteString r)
-> Parser Bool
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Bool r
-> IResult ByteString r)
-> Parser Bool)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Bool r
-> IResult ByteString r)
-> Parser Bool
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more _lose :: Failure ByteString (State ByteString) r
_lose succ :: Success ByteString (State ByteString) Bool r
succ ->
Success ByteString (State ByteString) Bool r
succ State ByteString
t Pos
pos More
more (Pos -> Int
fromPos Pos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer -> Int
Buf.length Buffer
State ByteString
t)
{-# INLINE endOfChunk #-}
inputSpansChunks :: Int -> Parser Bool
inputSpansChunks :: Int -> Parser Bool
inputSpansChunks i :: Int
i = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Bool r
-> IResult ByteString r)
-> Parser Bool
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Bool r
-> IResult ByteString r)
-> Parser Bool)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Bool r
-> IResult ByteString r)
-> Parser Bool
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos_ :: Pos
pos_ more :: More
more _lose :: Failure ByteString (State ByteString) r
_lose succ :: Success ByteString (State ByteString) Bool r
succ ->
let pos :: Pos
pos = Pos
pos_ Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
i
in if Pos -> Int
fromPos Pos
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> Int
Buf.length Buffer
State ByteString
t Bool -> Bool -> Bool
|| More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete
then Success ByteString (State ByteString) Bool r
succ State ByteString
t Pos
pos More
more Bool
False
else let lose' :: Buffer -> Pos -> More -> IResult ByteString r
lose' t' :: Buffer
t' pos' :: Pos
pos' more' :: More
more' = Success ByteString (State ByteString) Bool r
succ Buffer
State ByteString
t' Pos
pos' More
more' Bool
False
succ' :: Buffer -> Pos -> More -> IResult ByteString r
succ' t' :: Buffer
t' pos' :: Pos
pos' more' :: More
more' = Success ByteString (State ByteString) Bool r
succ Buffer
State ByteString
t' Pos
pos' More
more' Bool
True
in State ByteString
-> Pos
-> More
-> (State ByteString -> Pos -> More -> IResult ByteString r)
-> (State ByteString -> Pos -> More -> IResult ByteString r)
-> IResult ByteString r
forall t r.
Chunk t =>
State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State ByteString
t Pos
pos More
more Buffer -> Pos -> More -> IResult ByteString r
State ByteString -> Pos -> More -> IResult ByteString r
lose' Buffer -> Pos -> More -> IResult ByteString r
State ByteString -> Pos -> More -> IResult ByteString r
succ'
{-# INLINE inputSpansChunks #-}
advance :: Int -> Parser ()
advance :: Int -> Parser ()
advance n :: Int
n = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) () r
-> IResult ByteString r)
-> Parser ()
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) () r
-> IResult ByteString r)
-> Parser ())
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) () r
-> IResult ByteString r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more _lose :: Failure ByteString (State ByteString) r
_lose succ :: Success ByteString (State ByteString) () r
succ ->
Success ByteString (State ByteString) () r
succ State ByteString
t (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
n) More
more ()
{-# INLINE advance #-}
ensureSuspended :: Int -> Buffer -> Pos -> More
-> Failure r
-> Success ByteString r
-> Result r
ensureSuspended :: Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
ensureSuspended n :: Int
n t :: Buffer
t pos :: Pos
pos more :: More
more lose :: Failure r
lose succ :: Success ByteString r
succ =
Parser ByteString ByteString
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> Result r
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
runParser (Parser ()
forall t. Chunk t => Parser t ()
demandInput Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ByteString
go) Buffer
State ByteString
t Pos
pos More
more Failure r
Failure ByteString (State ByteString) r
lose Success ByteString r
Success ByteString (State ByteString) ByteString r
succ
where go :: Parser ByteString ByteString
go = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \t' :: State ByteString
t' pos' :: Pos
pos' more' :: More
more' lose' :: Failure ByteString (State ByteString) r
lose' succ' :: Success ByteString (State ByteString) ByteString r
succ' ->
if Pos -> Int -> Buffer -> Bool
lengthAtLeast Pos
pos' Int
n Buffer
State ByteString
t'
then Success ByteString (State ByteString) ByteString r
succ' State ByteString
t' Pos
pos' More
more' (Pos -> Pos -> Buffer -> ByteString
substring Pos
pos (Int -> Pos
Pos Int
n) Buffer
State ByteString
t')
else Parser ByteString ByteString
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
runParser (Parser ()
forall t. Chunk t => Parser t ()
demandInput Parser ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ByteString
go) State ByteString
t' Pos
pos' More
more' Failure ByteString (State ByteString) r
lose' Success ByteString (State ByteString) ByteString r
succ'
ensure :: Int -> Parser ByteString
ensure :: Int -> Parser ByteString ByteString
ensure n :: Int
n = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more lose :: Failure ByteString (State ByteString) r
lose succ :: Success ByteString (State ByteString) ByteString r
succ ->
if Pos -> Int -> Buffer -> Bool
lengthAtLeast Pos
pos Int
n Buffer
State ByteString
t
then Success ByteString (State ByteString) ByteString r
succ State ByteString
t Pos
pos More
more (Pos -> Pos -> Buffer -> ByteString
substring Pos
pos (Int -> Pos
Pos Int
n) Buffer
State ByteString
t)
else Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
forall r.
Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success ByteString r
-> Result r
ensureSuspended Int
n Buffer
State ByteString
t Pos
pos More
more Failure r
Failure ByteString (State ByteString) r
lose Success ByteString r
Success ByteString (State ByteString) ByteString r
succ
{-# INLINE ensure #-}
match :: Parser a -> Parser (ByteString, a)
match :: Parser a -> Parser (ByteString, a)
match p :: Parser a
p = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) (ByteString, a) r
-> IResult ByteString r)
-> Parser (ByteString, a)
forall i a.
(forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i a
T.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) (ByteString, a) r
-> IResult ByteString r)
-> Parser (ByteString, a))
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) (ByteString, a) r
-> IResult ByteString r)
-> Parser (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \t :: State ByteString
t pos :: Pos
pos more :: More
more lose :: Failure ByteString (State ByteString) r
lose succ :: Success ByteString (State ByteString) (ByteString, a) r
succ ->
let succ' :: Buffer -> Pos -> More -> a -> IResult ByteString r
succ' t' :: Buffer
t' pos' :: Pos
pos' more' :: More
more' a :: a
a =
Success ByteString (State ByteString) (ByteString, a) r
succ Buffer
State ByteString
t' Pos
pos' More
more' (Pos -> Pos -> Buffer -> ByteString
substring Pos
pos (Pos
pos'Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
-Pos
pos) Buffer
t', a
a)
in Parser a
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) a r
-> IResult ByteString r
forall i a.
Parser i a
-> forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
runParser Parser a
p State ByteString
t Pos
pos More
more Failure ByteString (State ByteString) r
lose Buffer -> Pos -> More -> a -> IResult ByteString r
Success ByteString (State ByteString) a r
succ'
lengthAtLeast :: Pos -> Int -> Buffer -> Bool
lengthAtLeast :: Pos -> Int -> Buffer -> Bool
lengthAtLeast (Pos pos :: Int
pos) n :: Int
n bs :: Buffer
bs = Buffer -> Int
Buf.length Buffer
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
{-# INLINE lengthAtLeast #-}
substring :: Pos -> Pos -> Buffer -> ByteString
substring :: Pos -> Pos -> Buffer -> ByteString
substring (Pos pos :: Int
pos) (Pos n :: Int
n) = Int -> Int -> Buffer -> ByteString
Buf.substring Int
pos Int
n
{-# INLINE substring #-}