{-# LANGUAGE RankNTypes, BangPatterns, CPP #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Scanner implementation

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

-- | CPS scanner without backtracking
newtype Scanner a = Scanner
  { forall a. Scanner a -> forall r. ByteString -> Next a r -> Result r
run :: forall r. ByteString -> Next a r -> Result r
  }

-- | Scanner continuation
type Next a r = ByteString -> a -> Result r

-- | Scanner result
data Result r
  -- | Successful result with the rest of input
  = Done ByteString r

  -- | Scanner failed with rest of input and error message
  | Fail ByteString String

  -- | Need more input
  | More (ByteString -> Result r)

-- | Run scanner with the input
scan :: Scanner r -> ByteString -> Result r
scan :: forall r. Scanner r -> ByteString -> Result r
scan Scanner r
s ByteString
bs = Scanner r -> forall 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 :: forall a b. (a -> b) -> Scanner a -> Scanner b
fmap a -> b
f (Scanner 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
$ \ByteString
bs 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
$ \ByteString
bs' a
a ->
      Next b r
next ByteString
bs' (a -> b
f a
a)

instance Applicative Scanner where
  {-# INLINE pure #-}
  pure :: forall a. a -> Scanner a
pure = a -> Scanner a
forall a. a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE (<*>) #-}
  <*> :: forall a b. 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 (*>) #-}
  *> :: forall a b. Scanner a -> Scanner b -> Scanner b
(*>) = Scanner a -> Scanner b -> Scanner b
forall a b. Scanner a -> Scanner b -> Scanner b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)

  {-# INLINE (<*) #-}
  Scanner a
s1 <* :: forall a b. Scanner a -> Scanner b -> Scanner a
<* Scanner b
s2 = Scanner a
s1 Scanner a -> (a -> Scanner a) -> Scanner a
forall a b. Scanner a -> (a -> Scanner b) -> Scanner b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> Scanner b
s2 Scanner b -> Scanner a -> Scanner a
forall a b. Scanner a -> Scanner b -> Scanner b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Scanner a
forall a. a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

instance Monad Scanner where
  {-# INLINE return #-}
  return :: forall a. a -> Scanner a
return 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
$ \ByteString
bs Next a r
next ->
    Next a r
next ByteString
bs a
a

  {-# INLINE (>>=) #-}
  Scanner a
s1 >>= :: forall a b. Scanner a -> (a -> Scanner b) -> Scanner b
>>= 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
$ \ByteString
bs Next b r
next ->
    Scanner a -> forall r. 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
$ \ByteString
bs' a
a ->
      Scanner b -> forall r. 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 :: forall a. String -> Scanner a
fail 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
$ \ByteString
bs Next a r
_ ->
    ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
bs String
err

-- | Consume the next word
--
-- It fails if end of input
{-# 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
$ \ByteString
bs Next Word8 r
next ->
  case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
    Just (Word8
c, ByteString
bs') -> Next Word8 r
next ByteString
bs' Word8
c
    Maybe (Word8, ByteString)
_ -> (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
$ \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 ByteString
bs ByteString -> Word8 -> Result r
next =
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
      Just (Word8
c, ByteString
bs') -> ByteString -> Word8 -> Result r
next ByteString
bs' Word8
c
      Maybe (Word8, ByteString)
_ -> ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
ByteString.empty String
"No more input"

-- | Take input while the predicate is `True`
{-# INLINE takeWhile #-}
takeWhile :: (Word8 -> Bool) -> Scanner ByteString
takeWhile :: (Word8 -> Bool) -> Scanner ByteString
takeWhile 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
$ \ByteString
bs Next ByteString r
next ->
  let (ByteString
l, 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
$ \ByteString
bs' ->
      if ByteString -> Bool
ByteString.null ByteString
bs'
        then Next ByteString r
next ByteString
ByteString.empty ByteString
l
        else Scanner ByteString
-> forall r. 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 ByteString
l = [ByteString] -> Scanner ByteString
go [ByteString
l]
  go :: [ByteString] -> Scanner ByteString
go [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 a. a -> Scanner a
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
$ \ByteString
bs Next ByteString r
next ->
    let (ByteString
l, ByteString
r) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
p ByteString
bs
    in Next ByteString r
next ByteString
r ByteString
l

-- | Take the specified number of bytes
{-# INLINE take #-}
take :: Int -> Scanner ByteString
take :: Int -> Scanner ByteString
take 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
$ \ByteString
bs 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 (ByteString
l, 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
$ \ByteString
bs' ->
      if ByteString -> Bool
ByteString.null ByteString
bs'
        then ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
ByteString.empty String
"No more input"
        else Scanner ByteString
-> forall r. 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 ByteString
bs 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 [ByteString]
res Int
0 = ByteString -> Scanner ByteString
forall a. a -> Scanner a
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 [ByteString]
res 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
$ \ByteString
bs 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 (ByteString
l, 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
$ \ByteString
bs' ->
        if ByteString -> Bool
ByteString.null ByteString
bs'
          then ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
ByteString.empty String
"No more input"
          else Scanner ByteString
-> forall r. 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

-- | Returns `True` when there is no more input
{-# 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
$ \ByteString
bs 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
$ \ByteString
bs' -> Next Bool r
next ByteString
bs' (ByteString -> Bool
ByteString.null ByteString
bs')
    else Next Bool r
next ByteString
bs Bool
False

-- | Consume the specified string
--
-- Warning: it is not optimized yet, so for for small string it is better
-- to consume it byte-by-byte using `Scanner.word8`
{-# INLINE string #-}
string :: ByteString -> Scanner ()
string :: ByteString -> Scanner ()
string 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
$ \ByteString
bs 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 () -> forall r. 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 a. a -> Scanner a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else String -> Scanner ()
forall a. String -> Scanner a
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
"Unexpected input"

-- | Return the next byte, if any, without consuming it
{-# 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
$ \ByteString
bs Next (Maybe Word8) r
next ->
  case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
    Just (Word8
c, ByteString
_) -> Next (Maybe Word8) r
next ByteString
bs (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
c)
    Maybe (Word8, ByteString)
_ -> (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
$ \ByteString
bs' -> ByteString -> Next (Maybe Word8) r -> Result r
forall {t}. ByteString -> (ByteString -> Maybe Word8 -> t) -> t
slowPath ByteString
bs' Next (Maybe Word8) r
next
  where
  slowPath :: ByteString -> (ByteString -> Maybe Word8 -> t) -> t
slowPath ByteString
bs ByteString -> Maybe Word8 -> t
next =
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
bs of
      Just (Word8
c, ByteString
_) -> ByteString -> Maybe Word8 -> t
next ByteString
bs (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
c)
      Maybe (Word8, ByteString)
_ -> ByteString -> Maybe Word8 -> t
next ByteString
ByteString.empty Maybe Word8
forall a. Maybe a
Nothing

{-| Fold over the octets, which satisfy the predicate -}
{-# INLINE foldlWhile #-}
foldlWhile :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile :: forall a. (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile Word8 -> Bool
p a -> Word8 -> a
step 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
$ \ ByteString
bs Next a r
next -> let
  (ByteString
l, 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
$ \ ByteString
bs -> if ByteString -> Bool
ByteString.null ByteString
bs
      then Next a r
next ByteString
ByteString.empty a
state
      else Scanner a -> forall r. 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 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 a. 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 a. 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 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
$ \ ByteString
bs Next ByteString r
next ->
      let (ByteString
l, ByteString
r) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
p ByteString
bs
      in Next ByteString r
next ByteString
r ByteString
l

{-| Fold over the octets, which satisfy the predicate, ensuring that there's at least one -}
{-# INLINE foldlWhile1 #-}
foldlWhile1 :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile1 :: forall a. (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a
foldlWhile1 Word8 -> Bool
predicate a -> Word8 -> a
step 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)

{-| Consume a single octet which satisfies the predicate and fail if it does not -}
{-# INLINE satisfy #-}
satisfy :: (Word8 -> Bool) -> Scanner Word8
satisfy :: (Word8 -> Bool) -> Scanner Word8
satisfy 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
$ \ ByteString
chunk Next Word8 r
next -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
  Just (Word8
word8, 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
  Maybe (Word8, ByteString)
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
$ \ ByteString
chunk -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
    Just (Word8
word8, 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
    Maybe (Word8, ByteString)
Nothing -> ByteString -> String -> Result r
forall r. ByteString -> String -> Result r
Fail ByteString
chunk String
"No more input"
  where
    handleHeadAndTail :: Word8 -> ByteString -> (ByteString -> Word8 -> Result r) -> ByteString -> Result r
    handleHeadAndTail :: forall r.
Word8
-> ByteString
-> (ByteString -> Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail Word8
word8 ByteString
remainder ByteString -> Word8 -> Result r
next 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
$ \ 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 String
"Octet doesn't satisfy the predicate"

{-| Consume a single octet in case it satisfies the predicate -}
{-# INLINE satisfyMaybe #-}
satisfyMaybe :: (Word8 -> Bool) -> Scanner (Maybe Word8)
satisfyMaybe :: (Word8 -> Bool) -> Scanner (Maybe Word8)
satisfyMaybe 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
$ \ ByteString
chunk Next (Maybe Word8) r
next -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
  Just (Word8
word8, 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
  Maybe (Word8, ByteString)
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
$ \ ByteString
chunk -> case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
chunk of
    Just (Word8
word8, 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
    Maybe (Word8, ByteString)
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 :: forall r.
Word8
-> ByteString
-> (ByteString -> Maybe Word8 -> Result r)
-> ByteString
-> Result r
handleHeadAndTail Word8
word8 ByteString
remainder ByteString -> Maybe Word8 -> Result r
next 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
$ \ 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

{-| Parse a non-negative decimal number in ASCII -}
{-# INLINE decimal #-}
decimal :: Integral n => Scanner n
decimal :: forall n. Integral n => 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 n
0 where
  step :: a -> a -> a
step a
a a
w = a
a a -> a -> a
forall a. Num a => 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
- a
48)