{-# LANGUAGE RankNTypes, BangPatterns, CPP #-}
{-# OPTIONS_HADDOCK not-home #-}
module Scanner.Internal
where
import Prelude hiding (take, takeWhile)
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as ByteString (unsafeDrop)
import qualified Scanner.OctetPredicates as OctetPredicates
import Control.Monad
import Control.Monad.Fail
newtype Scanner a = Scanner
{ Scanner a -> forall r. ByteString -> Next a r -> Result r
run :: forall r. ByteString -> Next a r -> Result r
}
type Next a r = ByteString -> a -> Result r
data Result r
= Done ByteString r
| Fail ByteString String
| More (ByteString -> Result r)
scan :: Scanner r -> ByteString -> Result r
scan :: Scanner r -> ByteString -> Result r
scan s :: Scanner r
s bs :: ByteString
bs = Scanner r -> ByteString -> Next r r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run Scanner r
s ByteString
bs Next r r
forall r. ByteString -> r -> Result r
Done
instance Functor Scanner where
{-# INLINE fmap #-}
fmap :: (a -> b) -> Scanner a -> Scanner b
fmap f :: a -> b
f (Scanner s :: forall r. ByteString -> Next a r -> Result r
s) = (forall r. ByteString -> Next b r -> Result r) -> Scanner b
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next b r -> Result r) -> Scanner b)
-> (forall r. ByteString -> Next b r -> Result r) -> Scanner b
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next b r
next ->
ByteString -> Next a r -> Result r
forall r. ByteString -> Next a r -> Result r
s ByteString
bs (Next a r -> Result r) -> Next a r -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' a :: a
a ->
Next b r
next ByteString
bs' (a -> b
f a
a)
instance Applicative Scanner where
{-# INLINE pure #-}
pure :: a -> Scanner a
pure = a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE (<*>) #-}
<*> :: Scanner (a -> b) -> Scanner a -> Scanner b
(<*>) = Scanner (a -> b) -> Scanner a -> Scanner b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (*>) #-}
*> :: Scanner a -> Scanner b -> Scanner b
(*>) = Scanner a -> Scanner b -> Scanner b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
{-# INLINE (<*) #-}
s1 :: Scanner a
s1 <* :: Scanner a -> Scanner b -> Scanner a
<* s2 :: Scanner b
s2 = Scanner a
s1 Scanner a -> (a -> Scanner a) -> Scanner a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> Scanner b
s2 Scanner b -> Scanner a -> Scanner a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
instance Monad Scanner where
{-# INLINE return #-}
return :: a -> Scanner a
return a :: a
a = (forall r. ByteString -> Next a r -> Result r) -> Scanner a
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next a r -> Result r) -> Scanner a)
-> (forall r. ByteString -> Next a r -> Result r) -> Scanner a
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next a r
next ->
Next a r
next ByteString
bs a
a
{-# INLINE (>>=) #-}
s1 :: Scanner a
s1 >>= :: Scanner a -> (a -> Scanner b) -> Scanner b
>>= s2 :: a -> Scanner b
s2 = (forall r. ByteString -> Next b r -> Result r) -> Scanner b
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next b r -> Result r) -> Scanner b)
-> (forall r. ByteString -> Next b r -> Result r) -> Scanner b
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next b r
next ->
Scanner a -> ByteString -> Next a r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run Scanner a
s1 ByteString
bs (Next a r -> Result r) -> Next a r -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' a :: a
a ->
Scanner b -> ByteString -> Next b r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run (a -> Scanner b
s2 a
a) ByteString
bs' Next b r
next
#if !(MIN_VERSION_base(4,13,0))
{-# INLINE fail #-}
fail err = Scanner $ \bs _ ->
Fail bs err
#endif
instance MonadFail Scanner where
{-# INLINE fail #-}
fail :: String -> Scanner a
fail err :: String
err = (forall r. ByteString -> Next a r -> Result r) -> Scanner a
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next a r -> Result r) -> Scanner a)
-> (forall r. ByteString -> Next a r -> Result r) -> Scanner a
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs _ ->
ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
bs String
err
{-# INLINE anyWord8 #-}
anyWord8 :: Scanner Word8
anyWord8 :: Scanner Word8
anyWord8 = (forall r. ByteString -> Next Word8 r -> Result r) -> Scanner Word8
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next Word8 r -> Result r)
-> Scanner Word8)
-> (forall r. ByteString -> Next Word8 r -> Result r)
-> Scanner Word8
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next Word8 r
next ->
case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
Just (c :: Word8
c, bs' :: ByteString
bs') -> Next Word8 r
next ByteString
bs' Word8
c
_ -> (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' -> ByteString -> Next Word8 r -> Result r
forall r. ByteString -> Next Word8 r -> Result r
slowPath ByteString
bs' Next Word8 r
next
where
slowPath :: ByteString -> (ByteString -> Word8 -> Result r) -> Result r
slowPath bs :: ByteString
bs next :: ByteString -> Word8 -> Result r
next =
case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
Just (c :: Word8
c, bs' :: ByteString
bs') -> ByteString -> Word8 -> Result r
next ByteString
bs' Word8
c
_ -> ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
ByteString.empty "No more input"
{-# INLINE takeWhile #-}
takeWhile :: (Word8 -> Bool) -> Scanner ByteString
takeWhile :: (Word8 -> Bool) -> Scanner ByteString
takeWhile p :: Word8 -> Bool
p = (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString)
-> (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next ByteString r
next ->
let (l :: ByteString
l, r :: ByteString
r) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
p ByteString
bs
in if ByteString -> Bool
ByteString.null ByteString
r
then (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' ->
if ByteString -> Bool
ByteString.null ByteString
bs'
then Next ByteString r
next ByteString
ByteString.empty ByteString
l
else Scanner ByteString -> ByteString -> Next ByteString r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run (ByteString -> Scanner ByteString
slowPath ByteString
l) ByteString
bs' Next ByteString r
next
else Next ByteString r
next ByteString
r ByteString
l
where
slowPath :: ByteString -> Scanner ByteString
slowPath l :: ByteString
l = [ByteString] -> Scanner ByteString
go [ByteString
l]
go :: [ByteString] -> Scanner ByteString
go res :: [ByteString]
res = do
ByteString
chunk <- Scanner ByteString
takeChunk
Bool
done <- Scanner Bool
endOfInput
if Bool
done Bool -> Bool -> Bool
|| ByteString -> Bool
ByteString.null ByteString
chunk
then ByteString -> Scanner ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Scanner ByteString)
-> ([ByteString] -> ByteString)
-> [ByteString]
-> Scanner ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
ByteString.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> Scanner ByteString)
-> [ByteString] -> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
res)
else [ByteString] -> Scanner ByteString
go (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
res)
takeChunk :: Scanner ByteString
takeChunk = (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString)
-> (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next ByteString r
next ->
let (l :: ByteString
l, r :: ByteString
r) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
p ByteString
bs
in Next ByteString r
next ByteString
r ByteString
l
{-# INLINE take #-}
take :: Int -> Scanner ByteString
take :: Int -> Scanner ByteString
take n :: Int
n = (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString)
-> (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next ByteString r
next ->
let len :: Int
len = ByteString -> Int
ByteString.length ByteString
bs
in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then let (l :: ByteString
l, r :: ByteString
r) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
n ByteString
bs
in Next ByteString r
next ByteString
r ByteString
l
else (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' ->
if ByteString -> Bool
ByteString.null ByteString
bs'
then ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
ByteString.empty "No more input"
else Scanner ByteString -> ByteString -> Next ByteString r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run (ByteString -> Int -> Scanner ByteString
slowPath ByteString
bs Int
len) ByteString
bs' Next ByteString r
next
where
slowPath :: ByteString -> Int -> Scanner ByteString
slowPath bs :: ByteString
bs len :: Int
len = [ByteString] -> Int -> Scanner ByteString
go [ByteString
bs] (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len)
go :: [ByteString] -> Int -> Scanner ByteString
go res :: [ByteString]
res 0 = ByteString -> Scanner ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Scanner ByteString)
-> ([ByteString] -> ByteString)
-> [ByteString]
-> Scanner ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
ByteString.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> Scanner ByteString)
-> [ByteString] -> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
res
go res :: [ByteString]
res i :: Int
i = (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString)
-> (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next ByteString r
next ->
let len :: Int
len = ByteString -> Int
ByteString.length ByteString
bs
in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i
then let (l :: ByteString
l, r :: ByteString
r) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
i ByteString
bs
in Next ByteString r
next ByteString
r ([ByteString] -> ByteString
ByteString.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString
l ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
res))
else (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' ->
if ByteString -> Bool
ByteString.null ByteString
bs'
then ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
ByteString.empty "No more input"
else Scanner ByteString -> ByteString -> Next ByteString r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run ([ByteString] -> Int -> Scanner ByteString
go (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
res) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len)) ByteString
bs' Next ByteString r
next
{-# INLINE endOfInput #-}
endOfInput :: Scanner Bool
endOfInput :: Scanner Bool
endOfInput = (forall r. ByteString -> Next Bool r -> Result r) -> Scanner Bool
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next Bool r -> Result r) -> Scanner Bool)
-> (forall r. ByteString -> Next Bool r -> Result r)
-> Scanner Bool
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next Bool r
next ->
if ByteString -> Bool
ByteString.null ByteString
bs
then (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' -> Next Bool r
next ByteString
bs' (ByteString -> Bool
ByteString.null ByteString
bs')
else Next Bool r
next ByteString
bs Bool
False
{-# INLINE string #-}
string :: ByteString -> Scanner ()
string :: ByteString -> Scanner ()
string str :: ByteString
str = (forall r. ByteString -> Next () r -> Result r) -> Scanner ()
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next () r -> Result r) -> Scanner ())
-> (forall r. ByteString -> Next () r -> Result r) -> Scanner ()
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next () r
next ->
let strL :: Int
strL = ByteString -> Int
ByteString.length ByteString
str
in if ByteString -> ByteString -> Bool
ByteString.isPrefixOf ByteString
str ByteString
bs
then Next () r
next (Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
strL ByteString
bs) ()
else Scanner () -> ByteString -> Next () r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run Scanner ()
slowPath ByteString
bs Next () r
next
where
slowPath :: Scanner ()
slowPath = do
ByteString
bs <- Int -> Scanner ByteString
take (ByteString -> Int
ByteString.length ByteString
str)
if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
str
then () -> Scanner ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Scanner ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail "Unexpected input"
{-# INLINE lookAhead #-}
lookAhead :: Scanner (Maybe Word8)
lookAhead :: Scanner (Maybe Word8)
lookAhead = (forall r. ByteString -> Next (Maybe Word8) r -> Result r)
-> Scanner (Maybe Word8)
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next (Maybe Word8) r -> Result r)
-> Scanner (Maybe Word8))
-> (forall r. ByteString -> Next (Maybe Word8) r -> Result r)
-> Scanner (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs next :: Next (Maybe Word8) r
next ->
case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
Just (c :: Word8
c, _) -> Next (Maybe Word8) r
next ByteString
bs (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
c)
_ -> (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \bs' :: ByteString
bs' -> ByteString -> Next (Maybe Word8) r -> Result r
forall p. ByteString -> (ByteString -> Maybe Word8 -> p) -> p
slowPath ByteString
bs' Next (Maybe Word8) r
next
where
slowPath :: ByteString -> (ByteString -> Maybe Word8 -> p) -> p
slowPath bs :: ByteString
bs next :: ByteString -> Maybe Word8 -> p
next =
case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
Just (c :: Word8
c, _) -> ByteString -> Maybe Word8 -> p
next ByteString
bs (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
c)
_ -> ByteString -> Maybe Word8 -> p
next ByteString
ByteString.empty Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE foldlWhile #-}
foldlWhile :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile p :: Word8 -> Bool
p step :: a -> Word8 -> a
step init :: a
init = (forall r. ByteString -> Next a r -> Result r) -> Scanner a
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next a r -> Result r) -> Scanner a)
-> (forall r. ByteString -> Next a r -> Result r) -> Scanner a
forall a b. (a -> b) -> a -> b
$ \ bs :: ByteString
bs next :: Next a r
next -> let
(l :: ByteString
l, r :: ByteString
r) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
p ByteString
bs
state :: a
state = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
ByteString.foldl' a -> Word8 -> a
step a
init ByteString
l
in if ByteString -> Bool
ByteString.null ByteString
r
then (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \ bs :: ByteString
bs -> if ByteString -> Bool
ByteString.null ByteString
bs
then Next a r
next ByteString
ByteString.empty a
state
else Scanner a -> ByteString -> Next a r -> Result r
forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run (a -> Scanner a
loop a
state) ByteString
bs Next a r
next
else Next a r
next ByteString
r a
state
where
loop :: a -> Scanner a
loop state :: a
state = do
ByteString
chunk <- a -> Scanner ByteString
forall p. p -> Scanner ByteString
takeChunk a
state
if ByteString -> Bool
ByteString.null ByteString
chunk
then a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return a
state
else do
Bool
done <- Scanner Bool
endOfInput
if Bool
done
then a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return a
state
else a -> Scanner a
loop ((a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
ByteString.foldl' a -> Word8 -> a
step a
state ByteString
chunk)
takeChunk :: p -> Scanner ByteString
takeChunk state :: p
state = (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString)
-> (forall r. ByteString -> Next ByteString r -> Result r)
-> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ \ bs :: ByteString
bs next :: Next ByteString r
next ->
let (l :: ByteString
l, r :: ByteString
r) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
p ByteString
bs
in Next ByteString r
next ByteString
r ByteString
l
{-# INLINE foldlWhile1 #-}
foldlWhile1 :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile1 :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile1 predicate :: Word8 -> Bool
predicate step :: a -> Word8 -> a
step init :: a
init = do
Word8
head <- (Word8 -> Bool) -> Scanner Word8
satisfy Word8 -> Bool
predicate
(Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
forall a. (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile Word8 -> Bool
predicate a -> Word8 -> a
step (a -> Word8 -> a
step a
init Word8
head)
{-# INLINE satisfy #-}
satisfy :: (Word8 -> Bool) -> Scanner Word8
satisfy :: (Word8 -> Bool) -> Scanner Word8
satisfy predicate :: Word8 -> Bool
predicate = (forall r. ByteString -> Next Word8 r -> Result r) -> Scanner Word8
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next Word8 r -> Result r)
-> Scanner Word8)
-> (forall r. ByteString -> Next Word8 r -> Result r)
-> Scanner Word8
forall a b. (a -> b) -> a -> b
$ \ chunk :: ByteString
chunk next :: Next Word8 r
next -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
Just (word8 :: Word8
word8, remainder :: ByteString
remainder) -> Word8 -> ByteString -> Next Word8 r -> ByteString -> Result r
forall r.
Word8
-> ByteString
-> (ByteString -> Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail Word8
word8 ByteString
remainder Next Word8 r
next ByteString
chunk
Nothing -> (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \ chunk :: ByteString
chunk -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
Just (word8 :: Word8
word8, remainder :: ByteString
remainder) -> Word8 -> ByteString -> Next Word8 r -> ByteString -> Result r
forall r.
Word8
-> ByteString
-> (ByteString -> Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail Word8
word8 ByteString
remainder Next Word8 r
next ByteString
chunk
Nothing -> ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
chunk "No more input"
where
handleHeadAndTail :: Word8 -> ByteString -> (ByteString -> Word8 -> Result r) -> ByteString -> Result r
handleHeadAndTail :: Word8
-> ByteString
-> (ByteString -> Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail word8 :: Word8
word8 remainder :: ByteString
remainder next :: ByteString -> Word8 -> Result r
next chunk :: ByteString
chunk = if Word8 -> Bool
predicate Word8
word8
then if ByteString -> Bool
ByteString.null ByteString
remainder
then (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \ chunk :: ByteString
chunk -> ByteString -> Word8 -> Result r
next ByteString
chunk Word8
word8
else ByteString -> Word8 -> Result r
next ByteString
remainder Word8
word8
else ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
chunk "Octet doesn't satisfy the predicate"
{-# INLINE satisfyMaybe #-}
satisfyMaybe :: (Word8 -> Bool) -> Scanner (Maybe Word8)
satisfyMaybe :: (Word8 -> Bool) -> Scanner (Maybe Word8)
satisfyMaybe predicate :: Word8 -> Bool
predicate = (forall r. ByteString -> Next (Maybe Word8) r -> Result r)
-> Scanner (Maybe Word8)
forall a.
(forall r. ByteString -> Next a r -> Result r) -> Scanner a
Scanner ((forall r. ByteString -> Next (Maybe Word8) r -> Result r)
-> Scanner (Maybe Word8))
-> (forall r. ByteString -> Next (Maybe Word8) r -> Result r)
-> Scanner (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \ chunk :: ByteString
chunk next :: Next (Maybe Word8) r
next -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
Just (word8 :: Word8
word8, remainder :: ByteString
remainder) -> Word8
-> ByteString -> Next (Maybe Word8) r -> ByteString -> Result r
forall r.
Word8
-> ByteString
-> (ByteString -> Maybe Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail Word8
word8 ByteString
remainder Next (Maybe Word8) r
next ByteString
chunk
Nothing -> (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \ chunk :: ByteString
chunk -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
Just (word8 :: Word8
word8, remainder :: ByteString
remainder) -> Word8
-> ByteString -> Next (Maybe Word8) r -> ByteString -> Result r
forall r.
Word8
-> ByteString
-> (ByteString -> Maybe Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail Word8
word8 ByteString
remainder Next (Maybe Word8) r
next ByteString
chunk
Nothing -> Next (Maybe Word8) r
next ByteString
ByteString.empty Maybe Word8
forall a. Maybe a
Nothing
where
handleHeadAndTail :: Word8 -> ByteString -> (ByteString -> Maybe Word8 -> Result r) -> ByteString -> Result r
handleHeadAndTail :: Word8
-> ByteString
-> (ByteString -> Maybe Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail word8 :: Word8
word8 remainder :: ByteString
remainder next :: ByteString -> Maybe Word8 -> Result r
next chunk :: ByteString
chunk = if Word8 -> Bool
predicate Word8
word8
then if ByteString -> Bool
ByteString.null ByteString
remainder
then (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
More ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \ chunk :: ByteString
chunk -> ByteString -> Maybe Word8 -> Result r
next ByteString
chunk (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
word8)
else ByteString -> Maybe Word8 -> Result r
next ByteString
remainder (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
word8)
else ByteString -> Maybe Word8 -> Result r
next ByteString
chunk Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE decimal #-}
decimal :: Integral n => Scanner n
decimal :: Scanner n
decimal = (Word8 -> Bool) -> (n -> Word8 -> n) -> n -> Scanner n
forall a. (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile1 Word8 -> Bool
OctetPredicates.isDigit n -> Word8 -> n
forall a a. (Integral a, Num a) => a -> a -> a
step 0 where
step :: a -> a -> a
step a :: a
a w :: a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* 10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- 48)