-- |
-- Module      :  Data.Attoparsec.ByteString.Internal
-- Copyright   :  Bryan O'Sullivan 2007-2015
-- License     :  BSD3
--
-- Maintainer  :  bos@serpentine.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Simple, efficient parser combinators for 'ByteString' strings,
-- loosely based on the Parsec library.

module Data.Attoparsec.ByteString.Internal
    (
    -- * Parser types
      Parser
    , BackParser
    , DirParser
    , Directed
    , Dir (..)
    , Buf.DefaultDrift (..)
    , Result
    , BsParserCon

    -- * Running parsers
    , parse
    , parseBack
    , parseOnly
    , parseBackOnly
    , dirParse

    -- * Combinators
    , module Data.Attoparsec.Combinator

    -- * Parsing individual bytes
    , satisfy
    , satisfyWith
    , anyWord8
    , skip
    , word8
    , notWord8

    -- ** Lookahead
    , peekWord8
    , peekWord8'

    -- ** Byte classes
    , inClass
    , notInClass

    -- * Parsing more complicated structures
    , storable

    -- * Efficient string handling
    , skipWhile
    , string
    , stringCI
    , take
    , scan
    , runScanner
    , takeWhile
    , takeWhile1
    , takeWhileIncluding
    , takeTill
    , getChunk

    -- ** Consume all remaining input
    , takeByteString
    , takeLazyByteString

    -- * Monoidal combinator
    , DirectedTuple(..)
    , (>*)
    , (*<)
    -- * Utilities
    , endOfLine
    , endOfInput
    , match
    , atEnd
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Applicative (Alternative ((<|>)))
import Control.Monad (when)
import Data.Attoparsec.ByteString.Buffer (DirBuffer, buffer', DefaultDrift (..))
import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
import Data.Attoparsec.Combinator ((<?>))
import Data.Attoparsec.Internal
import Data.Attoparsec.Internal.Compat
import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
import Data.Attoparsec.Internal.Types hiding (DirParser, Parser, Failure, Success, DirFailure, DirSuccess)
import Data.ByteString (ByteString)
import Data.List (intercalate)
import Data.Tagged (Tagged(..), untag)
import Data.Tuple (swap)
import Data.Word (Word8)
import Debug.TraceEmbrace ( tr, tw )
import qualified Foreign.ForeignPtr as FP
import Foreign.Ptr (Ptr, castPtr)
import qualified Foreign.Ptr as FP
import Foreign.Storable (Storable(peek, sizeOf))
import Prelude hiding (getChar, succ, take, takeWhile, span, drop, length, reverse)
import qualified Prelude as P
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
import Data.Proxy

type Parser  = T.Parser ByteString
type DirParser d = T.DirParser d ByteString
type BackParser = DirParser Backward
type Result = IResult ByteString
type DirFailure d r = T.DirFailure d ByteString (DirBuffer d) r
type DirSuccess d a r = T.DirSuccess d ByteString (DirBuffer d) a r


class IntLength a where
  length :: a -> Int

instance IntLength ByteString where
  length :: ByteString -> Int
length = ByteString -> Int
B.length
  {-# INLINE length #-}
instance IntLength a => IntLength (Tagged t a) where
  length :: Tagged t a -> Int
length  = a -> Int
forall a. IntLength a => a -> Int
length (a -> Int) -> (Tagged t a -> a) -> Tagged t a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged t a -> a
forall {k} (s :: k) b. Tagged s b -> b
untag
  {-# INLINE length #-}

spanTag :: forall k (t :: k) a b c. (a -> (b, c)) -> Tagged t a -> (Tagged t b, Tagged t c)
spanTag :: forall k (t :: k) a b c.
(a -> (b, c)) -> Tagged t a -> (Tagged t b, Tagged t c)
spanTag a -> (b, c)
f (Tagged a
a) =
  case a -> (b, c)
f a
a of
    (b
b, c
c) -> (b -> Tagged t b
forall {k} (s :: k) b. b -> Tagged s b
Tagged b
b, c -> Tagged t c
forall {k} (s :: k) b. b -> Tagged s b
Tagged c
c)

withForeignPtr :: Tagged t (FP.ForeignPtr a) -> (Tagged t (Ptr a) -> IO b) -> IO b
withForeignPtr :: forall {k} (t :: k) a b.
Tagged t (ForeignPtr a) -> (Tagged t (Ptr a) -> IO b) -> IO b
withForeignPtr Tagged t (ForeignPtr a)
fp Tagged t (Ptr a) -> IO b
f = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
FP.withForeignPtr (Tagged t (ForeignPtr a) -> ForeignPtr a
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged t (ForeignPtr a)
fp) (Tagged t (Ptr a) -> IO b
f (Tagged t (Ptr a) -> IO b)
-> (Ptr a -> Tagged t (Ptr a)) -> Ptr a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Tagged t (Ptr a)
forall {k} (s :: k) b. b -> Tagged s b
Tagged)

class DirectedPlus d => Directed (d :: Dir) where
  diffLen ::
    DirPos d -> -- ^ new position
    DirPos d -> -- ^ origin position
    DirPos d

  startPos :: ByteString -> DirPos d
  isNotAll :: DirPos d -> Int -> Bool
  substring :: DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
  lengthAtLeast :: DirPos d -> Int -> DirBuffer d -> Bool
  span :: (Word8 -> Bool) -> Tagged d ByteString -> (Tagged d ByteString, Tagged d ByteString)
  uncons :: Tagged d ByteString -> Maybe (Word8, ByteString)
  snoc :: Tagged d ByteString -> Word8 -> ByteString
  takeWhileD :: (Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
  peekRest :: DirPos d -> DirBuffer d -> Tagged d ByteString
  isPrefixOf :: Tagged d ByteString -> Tagged d ByteString -> Bool
  drop :: Int -> Tagged d ByteString -> Tagged d ByteString
  unsafeTake :: Int -> Tagged d ByteString -> Tagged d ByteString
  unsafeDrop :: Int -> Tagged d ByteString -> Tagged d ByteString
  reverse :: [Tagged d ByteString] -> [Tagged d ByteString]
  scanner :: s -> Tagged d ByteString -> (s -> Word8 -> Maybe s) -> IO (T s)

instance Directed Forward where
  diffLen :: DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
diffLen DirPos 'Forward
np DirPos 'Forward
op = DirPos 'Forward
np DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
- DirPos 'Forward
op
  {-# INLINE diffLen #-}
  startPos :: ByteString -> DirPos 'Forward
startPos ByteString
_ = Int -> DirPos 'Forward
forall (d :: Dir). Int -> DirPos d
Pos Int
0
  {-# INLINE startPos #-}
  isNotAll :: DirPos 'Forward -> Int -> Bool
isNotAll (Pos Int
p) Int
n = Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
  {-# INLINE isNotAll #-}
  substring :: DirPos 'Forward
-> DirPos 'Forward
-> DirBuffer 'Forward
-> Tagged 'Forward ByteString
substring (Pos Int
pos) (Pos Int
n) = ByteString -> Tagged 'Forward ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged (ByteString -> Tagged 'Forward ByteString)
-> (DirBuffer 'Forward -> ByteString)
-> DirBuffer 'Forward
-> Tagged 'Forward ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> DirBuffer 'Forward -> ByteString
forall (d :: Dir). Int -> Int -> DirBuffer d -> ByteString
Buf.substring Int
pos Int
n
  {-# INLINE substring #-}
  lengthAtLeast :: DirPos 'Forward -> Int -> DirBuffer 'Forward -> Bool
lengthAtLeast (Pos Int
pos) Int
n DirBuffer 'Forward
bs = DirBuffer 'Forward -> Int
forall (d :: Dir). DirBuffer d -> Int
Buf.length DirBuffer 'Forward
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 #-}
  span :: (Word8 -> Bool)
-> Tagged 'Forward ByteString
-> (Tagged 'Forward ByteString, Tagged 'Forward ByteString)
span Word8 -> Bool
f = (ByteString -> (ByteString, ByteString))
-> Tagged 'Forward ByteString
-> (Tagged 'Forward ByteString, Tagged 'Forward ByteString)
forall k (t :: k) a b c.
(a -> (b, c)) -> Tagged t a -> (Tagged t b, Tagged t c)
spanTag ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B8.span Word8 -> Bool
f)
  {-# INLINE span #-}
  uncons :: Tagged 'Forward ByteString -> Maybe (Word8, ByteString)
uncons (Tagged ByteString
bs) = ByteString -> Maybe (Word8, ByteString)
B8.uncons ByteString
bs
  {-# INLINE uncons #-}
  snoc :: Tagged 'Forward ByteString -> Word8 -> ByteString
snoc (Tagged ByteString
bs) = ByteString -> Word8 -> ByteString
B8.snoc ByteString
bs
  {-# INLINE snoc #-}
  takeWhileD :: (Word8 -> Bool)
-> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
takeWhileD Word8 -> Bool
p Tagged 'Forward ByteString
bs = (Word8 -> Bool) -> ByteString -> ByteString
B8.takeWhile Word8 -> Bool
p (ByteString -> ByteString)
-> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Forward ByteString
bs
  {-# INLINE takeWhileD #-}
  peekRest :: DirPos 'Forward -> DirBuffer 'Forward -> Tagged 'Forward ByteString
peekRest (Pos Int
d) =  ByteString -> Tagged 'Forward ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged (ByteString -> Tagged 'Forward ByteString)
-> (DirBuffer 'Forward -> ByteString)
-> DirBuffer 'Forward
-> Tagged 'Forward ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DirBuffer 'Forward -> ByteString
forall (d :: Dir). Int -> DirBuffer d -> ByteString
Buf.unsafeDrop Int
d
  {-# INLINE peekRest #-}
  isPrefixOf :: Tagged 'Forward ByteString -> Tagged 'Forward ByteString -> Bool
isPrefixOf (Tagged ByteString
pre) (Tagged ByteString
bs) = ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
pre ByteString
bs
  {-# INLINE isPrefixOf #-}
  drop :: Int -> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
drop Int
n Tagged 'Forward ByteString
bs = Int -> ByteString -> ByteString
B.drop Int
n (ByteString -> ByteString)
-> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Forward ByteString
bs
  {-# INLINE drop #-}
  unsafeTake :: Int -> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
unsafeTake Int
n Tagged 'Forward ByteString
bs = Int -> ByteString -> ByteString
B.unsafeTake Int
n (ByteString -> ByteString)
-> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Forward ByteString
bs
  {-# INLINE unsafeTake #-}
  unsafeDrop :: Int -> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
unsafeDrop Int
n Tagged 'Forward ByteString
bs = Int -> ByteString -> ByteString
B.unsafeDrop Int
n (ByteString -> ByteString)
-> Tagged 'Forward ByteString -> Tagged 'Forward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Forward ByteString
bs
  {-# INLINE unsafeDrop #-}
  reverse :: [Tagged 'Forward ByteString] -> [Tagged 'Forward ByteString]
reverse = [Tagged 'Forward ByteString] -> [Tagged 'Forward ByteString]
forall a. [a] -> [a]
P.reverse
  {-# INLINE reverse #-}
  scanner :: forall s.
s
-> Tagged 'Forward ByteString
-> (s -> Word8 -> Maybe s)
-> IO (T s)
scanner s
s1 Tagged 'Forward ByteString
bs s -> Word8 -> Maybe s
p =
    Tagged 'Forward ByteString
-> (Tagged 'Forward (ForeignPtr Word8) -> Int -> Int -> IO (T s))
-> IO (T s)
forall k (a :: k) r.
Tagged a ByteString
-> (Tagged a (ForeignPtr Word8) -> Int -> Int -> r) -> r
withPsTag Tagged 'Forward ByteString
bs ((Tagged 'Forward (ForeignPtr Word8) -> Int -> Int -> IO (T s))
 -> IO (T s))
-> (Tagged 'Forward (ForeignPtr Word8) -> Int -> Int -> IO (T s))
-> IO (T s)
forall a b. (a -> b) -> a -> b
$ \Tagged 'Forward (ForeignPtr Word8)
fp Int
off Int
len ->
      Tagged 'Forward (ForeignPtr Word8)
-> (Tagged 'Forward (Ptr Word8) -> IO (T s)) -> IO (T s)
forall {k} (t :: k) a b.
Tagged t (ForeignPtr a) -> (Tagged t (Ptr a) -> IO b) -> IO b
withForeignPtr Tagged 'Forward (ForeignPtr Word8)
fp ((Tagged 'Forward (Ptr Word8) -> IO (T s)) -> IO (T s))
-> (Tagged 'Forward (Ptr Word8) -> IO (T s)) -> IO (T s)
forall a b. (a -> b) -> a -> b
$ \Tagged 'Forward (Ptr Word8)
ptr0 -> do
        let start :: Ptr Word8
start = Tagged 'Forward (Ptr Word8) -> Ptr Word8
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged 'Forward (Ptr Word8)
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`FP.plusPtr` Int
off
            end :: Ptr Word8
end   = Tagged 'Forward (Ptr Word8) -> Ptr Word8
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged 'Forward (Ptr Word8)
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`FP.plusPtr` (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
            inner :: Ptr Word8 -> s -> IO (T s)
inner Ptr Word8
ptr !s
s
              | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end = do
                w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
                case p s w of
                  Just 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
`FP.plusPtr` Int
1) s
s'
                  Maybe 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
`FP.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
`FP.minusPtr` Ptr Word8
start) s
s
            done :: Int -> s -> m (T s)
done !Int
i !s
s = T s -> m (T s)
forall a. a -> m a
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
  {-# INLINE scanner #-}

instance Directed Backward where
  diffLen :: DirPos 'Backward -> DirPos 'Backward -> DirPos 'Backward
diffLen DirPos 'Backward
np DirPos 'Backward
op = DirPos 'Backward
op DirPos 'Backward -> DirPos 'Backward -> DirPos 'Backward
forall a. Num a => a -> a -> a
- DirPos 'Backward
np
  {-# INLINE diffLen #-}
  startPos :: ByteString -> DirPos 'Backward
startPos = Int -> DirPos 'Backward
forall (d :: Dir). Int -> DirPos d
Pos (Int -> DirPos 'Backward)
-> (ByteString -> Int) -> ByteString -> DirPos 'Backward
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length
  {-# INLINE startPos #-}
  isNotAll :: DirPos 'Backward -> Int -> Bool
isNotAll DirPos 'Backward
a Int
n = DirPos 'Backward
a DirPos 'Backward -> DirPos 'Backward -> Bool
forall a. Ord a => a -> a -> Bool
>= DirPos 'Backward
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  {-# INLINE isNotAll #-}
  substring :: DirPos 'Backward
-> DirPos 'Backward
-> DirBuffer 'Backward
-> Tagged 'Backward ByteString
substring (Pos Int
pos) (Pos Int
n) DirBuffer 'Backward
b =
    $(tw "substring/pos n b")
      (ByteString -> Tagged 'Backward ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Int -> Int -> DirBuffer 'Backward -> ByteString
forall (d :: Dir). Int -> Int -> DirBuffer d -> ByteString
Buf.substring (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Int
n DirBuffer 'Backward
b))
  {-# INLINE substring #-}
  lengthAtLeast :: DirPos 'Backward -> Int -> DirBuffer 'Backward -> Bool
lengthAtLeast (Pos Int
pos) Int
n DirBuffer 'Backward
_bs = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  {-# INLINE lengthAtLeast #-}
  span :: (Word8 -> Bool)
-> Tagged 'Backward ByteString
-> (Tagged 'Backward ByteString, Tagged 'Backward ByteString)
span Word8 -> Bool
p = (ByteString -> (ByteString, ByteString))
-> Tagged 'Backward ByteString
-> (Tagged 'Backward ByteString, Tagged 'Backward ByteString)
forall k (t :: k) a b c.
(a -> (b, c)) -> Tagged t a -> (Tagged t b, Tagged t c)
spanTag ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B8.spanEnd Word8 -> Bool
p)
  {-# INLINE span #-}
  uncons :: Tagged 'Backward ByteString -> Maybe (Word8, ByteString)
uncons (Tagged ByteString
bs) = (ByteString, Word8) -> (Word8, ByteString)
forall a b. (a, b) -> (b, a)
swap ((ByteString, Word8) -> (Word8, ByteString))
-> Maybe (ByteString, Word8) -> Maybe (Word8, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (ByteString, Word8)
B8.unsnoc ByteString
bs
  {-# INLINE uncons #-}
  snoc :: Tagged 'Backward ByteString -> Word8 -> ByteString
snoc (Tagged ByteString
bs) Word8
b = Word8 -> ByteString -> ByteString
B8.cons Word8
b ByteString
bs
  {-# INLINE snoc #-}
  takeWhileD :: (Word8 -> Bool)
-> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
takeWhileD Word8 -> Bool
p Tagged 'Backward ByteString
bs = (Word8 -> Bool) -> ByteString -> ByteString
B8.takeWhileEnd Word8 -> Bool
p (ByteString -> ByteString)
-> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Backward ByteString
bs
  {-# INLINE takeWhileD #-}
  peekRest :: DirPos 'Backward
-> DirBuffer 'Backward -> Tagged 'Backward ByteString
peekRest (Pos Int
d) DirBuffer 'Backward
b =
    $(tw "/d b") (ByteString -> Tagged 'Backward ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Int -> Int -> DirBuffer 'Backward -> ByteString
forall (d :: Dir). Int -> Int -> DirBuffer d -> ByteString
Buf.substring Int
0 (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) DirBuffer 'Backward
b))
  {-# INLINE peekRest #-}
  isPrefixOf :: Tagged 'Backward ByteString -> Tagged 'Backward ByteString -> Bool
isPrefixOf (Tagged ByteString
pre) (Tagged ByteString
bs) = ByteString -> ByteString -> Bool
B.isSuffixOf ByteString
pre ByteString
bs
  {-# INLINE isPrefixOf #-}
  drop :: Int -> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
drop Int
n Tagged 'Backward ByteString
bs = Int -> ByteString -> ByteString
B.dropEnd Int
n (ByteString -> ByteString)
-> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Backward ByteString
bs
  {-# INLINE drop #-}
  -- unsafeTakeEnd
  unsafeTake :: Int -> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
unsafeTake Int
n Tagged 'Backward ByteString
bs = Int -> ByteString -> ByteString
B.unsafeDrop (ByteString -> Int
B.length (Tagged 'Backward ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged 'Backward ByteString
bs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (ByteString -> ByteString)
-> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Backward ByteString
bs
  {-# INLINE unsafeTake #-}
  -- unsafeDropEnd
  unsafeDrop :: Int -> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
unsafeDrop Int
n Tagged 'Backward ByteString
bs = Int -> ByteString -> ByteString
B.unsafeTake (ByteString -> Int
B.length (Tagged 'Backward ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged 'Backward ByteString
bs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (ByteString -> ByteString)
-> Tagged 'Backward ByteString -> Tagged 'Backward ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged 'Backward ByteString
bs
  {-# INLINE unsafeDrop #-}
  reverse :: [Tagged 'Backward ByteString] -> [Tagged 'Backward ByteString]
reverse = [Tagged 'Backward ByteString] -> [Tagged 'Backward ByteString]
forall a. a -> a
id
  {-# INLINE reverse #-}
  scanner :: forall s.
s
-> Tagged 'Backward ByteString
-> (s -> Word8 -> Maybe s)
-> IO (T s)
scanner s
s1 Tagged 'Backward ByteString
bs s -> Word8 -> Maybe s
p =
    Tagged 'Backward ByteString
-> (Tagged 'Backward (ForeignPtr Word8) -> Int -> Int -> IO (T s))
-> IO (T s)
forall k (a :: k) r.
Tagged a ByteString
-> (Tagged a (ForeignPtr Word8) -> Int -> Int -> r) -> r
withPsTag Tagged 'Backward ByteString
bs ((Tagged 'Backward (ForeignPtr Word8) -> Int -> Int -> IO (T s))
 -> IO (T s))
-> (Tagged 'Backward (ForeignPtr Word8) -> Int -> Int -> IO (T s))
-> IO (T s)
forall a b. (a -> b) -> a -> b
$ \Tagged 'Backward (ForeignPtr Word8)
fp Int
off Int
len ->
      Tagged 'Backward (ForeignPtr Word8)
-> (Tagged 'Backward (Ptr Word8) -> IO (T s)) -> IO (T s)
forall {k} (t :: k) a b.
Tagged t (ForeignPtr a) -> (Tagged t (Ptr a) -> IO b) -> IO b
withForeignPtr Tagged 'Backward (ForeignPtr Word8)
fp ((Tagged 'Backward (Ptr Word8) -> IO (T s)) -> IO (T s))
-> (Tagged 'Backward (Ptr Word8) -> IO (T s)) -> IO (T s)
forall a b. (a -> b) -> a -> b
$ \(Tagged Ptr Word8
ptr0) ->
        if Ptr Word8
ptr0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
FP.nullPtr
        then T s -> IO (T s)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (T s -> IO (T s)) -> T s -> IO (T s)
forall a b. (a -> b) -> a -> b
$ Int -> s -> T s
forall s. Int -> s -> T s
T Int
0 s
s1
        else do
          let start :: Ptr Word8
start = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`FP.plusPtr` (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              end :: Ptr Word8
end   = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`FP.plusPtr` Int
off
              inner :: Ptr Word8 -> s -> IO (T s)
inner Ptr Word8
ptr !s
s
                | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = do
                  w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
                  case p s w of
                    Just 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
`FP.plusPtr` (-Int
1)) s
s'
                    Maybe s
_       -> Int -> s -> IO (T s)
forall {m :: * -> *} {s}. Monad m => Int -> s -> m (T s)
done (Ptr Word8
start Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`FP.minusPtr` Ptr Word8
ptr) s
s
                | Bool
otherwise = Int -> s -> IO (T s)
forall {m :: * -> *} {s}. Monad m => Int -> s -> m (T s)
done (Ptr Word8
start Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`FP.minusPtr` Ptr Word8
ptr) s
s
              done :: Int -> s -> m (T s)
done !Int
i !s
s = T s -> m (T s)
forall a. a -> m a
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
  {-# INLINE scanner #-}

class Directed d => DirectedTuple d where
  -- | Run first then last parser in Forward mode and vice-versa in Backward one.
  -- Monoidal operator
  (>*<) :: DirParser d a -> DirParser d b -> DirParser d (a, b)

infixl 4 >*<

instance DirectedTuple Forward where
  DirParser 'Forward a
a >*< :: forall a b.
DirParser 'Forward a
-> DirParser 'Forward b -> DirParser 'Forward (a, b)
>*< DirParser 'Forward b
b = (,) (a -> b -> (a, b))
-> DirParser 'Forward a
-> DirParser 'Forward ByteString (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser 'Forward a
a DirParser 'Forward ByteString (b -> (a, b))
-> DirParser 'Forward b -> DirParser 'Forward ByteString (a, b)
forall a b.
DirParser 'Forward ByteString (a -> b)
-> DirParser 'Forward ByteString a
-> DirParser 'Forward ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DirParser 'Forward b
b
  {-# INLINE (>*<) #-}

instance DirectedTuple Backward where
  DirParser 'Backward a
a >*< :: forall a b.
DirParser 'Backward a
-> DirParser 'Backward b -> DirParser 'Backward (a, b)
>*< DirParser 'Backward b
b = DirParser 'Backward b
b DirParser 'Backward b
-> (b -> DirParser 'Backward ByteString (a, b))
-> DirParser 'Backward ByteString (a, b)
forall a b.
DirParser 'Backward ByteString a
-> (a -> DirParser 'Backward ByteString b)
-> DirParser 'Backward ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
br -> DirParser 'Backward a
a DirParser 'Backward a
-> (a -> DirParser 'Backward ByteString (a, b))
-> DirParser 'Backward ByteString (a, b)
forall a b.
DirParser 'Backward ByteString a
-> (a -> DirParser 'Backward ByteString b)
-> DirParser 'Backward ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
ar -> (a, b) -> DirParser 'Backward ByteString (a, b)
forall a. a -> DirParser 'Backward ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ar, b
br)
  {-# INLINE (>*<) #-}

(>*) :: DirectedTuple d => DirParser d a -> DirParser d b -> DirParser d b
DirParser d a
a >* :: forall (d :: Dir) a b.
DirectedTuple d =>
DirParser d a -> DirParser d b -> DirParser d b
>* DirParser d b
b = (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> DirParser d ByteString (a, b) -> DirParser d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirParser d a
a DirParser d a -> DirParser d b -> DirParser d ByteString (a, b)
forall a b. DirParser d a -> DirParser d b -> DirParser d (a, b)
forall (d :: Dir) a b.
DirectedTuple d =>
DirParser d a -> DirParser d b -> DirParser d (a, b)
>*< DirParser d b
b)
infixl 4 >*

(*<) :: DirectedTuple d => DirParser d a -> DirParser d b -> DirParser d a
DirParser d a
a *< :: forall (d :: Dir) a b.
DirectedTuple d =>
DirParser d a -> DirParser d b -> DirParser d a
*< DirParser d b
b = (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> DirParser d ByteString (a, b) -> DirParser d a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirParser d a
a DirParser d a -> DirParser d b -> DirParser d ByteString (a, b)
forall a b. DirParser d a -> DirParser d b -> DirParser d (a, b)
forall (d :: Dir) a b.
DirectedTuple d =>
DirParser d a -> DirParser d b -> DirParser d (a, b)
>*< DirParser d b
b)
infixl 4 *<

type BsParserCon d =
  ( DirChunk d ByteString
  , Directed d
  , DirBuffer d ~ DirState d ByteString
  , Buf.HasDrift d
  , Alternative (DirParser d)
  )

-- | The parser @satisfy p@ succeeds for any byte for which the
-- predicate @p@ returns 'True'. Returns the byte that is actually
-- parsed.
--
-- >digit = satisfy isDigit
-- >    where isDigit w = w >= 48 && w <= 57
satisfy :: BsParserCon d => (Word8 -> Bool) -> DirParser d Word8
satisfy :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d Word8
satisfy Word8 -> Bool
p = do
  h <- DirParser d Word8
forall (d :: Dir). BsParserCon d => DirParser d Word8
peekWord8'
  if $(tw "pokedWord/h") $ p h
    then advance ($(tw "advance by/") 1)  >> return h
    else fail "satisfy"
{-# INLINE satisfy #-}

-- | The parser @skip p@ succeeds for any byte for which the predicate
-- @p@ returns 'True'.
--
-- >skipDigit = skip isDigit
-- >    where isDigit w = w >= 48 && w <= 57
skip :: BsParserCon d => (Word8 -> Bool) -> DirParser d ()
skip :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d ()
skip Word8 -> Bool
p = do
  h <- DirParser d Word8
forall (d :: Dir). BsParserCon d => DirParser d Word8
peekWord8'
  if $(tw "pokedWord/h") $ p h
    then advance $ $(tw "advance by/") 1
    else fail "skip"

-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
-- the predicate @p@ returns 'True' on the transformed value. The
-- parser returns the transformed byte that was parsed.
satisfyWith :: (Show a, BsParserCon d) => (Word8 -> a) -> (a -> Bool) -> DirParser d a
satisfyWith :: forall a (d :: Dir).
(Show a, BsParserCon d) =>
(Word8 -> a) -> (a -> Bool) -> DirParser d a
satisfyWith Word8 -> a
f a -> Bool
p = do
  h <- DirParser d Word8
forall (d :: Dir). BsParserCon d => DirParser d Word8
peekWord8'
  let c = Word8 -> a
f Word8
h
  if $(tw "p c ret/h c") $ p c
    then advance 1 >> return c
    else fail "satisfyWith"
{-# INLINE satisfyWith #-}

storable :: (BsParserCon d, Storable a) => DirParser d a
storable :: forall (d :: Dir) a. (BsParserCon d, Storable a) => DirParser d a
storable = a -> DirParser d a
forall (d :: Dir) b.
(BsParserCon d, Storable b) =>
b -> DirParser d b
hack a
forall a. HasCallStack => a
undefined
 where
  hack :: (BsParserCon d, Storable b) => b -> DirParser d b
  hack :: forall (d :: Dir) b.
(BsParserCon d, Storable b) =>
b -> DirParser d b
hack b
dummy = do
    (fp,o,_) <- ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> DirParser d ByteString ByteString
-> DirParser d ByteString (ForeignPtr Word8, Int, Int)
forall a b.
(a -> b) -> DirParser d ByteString a -> DirParser d ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DirParser d ByteString ByteString
forall (d :: Dir). BsParserCon d => Int -> DirParser d ByteString
take (b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy)
    return . inlinePerformIO . FP.withForeignPtr fp $ \Ptr Word8
p ->
        Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek (Ptr (ZonkAny 0) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (ZonkAny 0) -> Ptr b) -> Ptr (ZonkAny 0) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Word8
p Ptr Word8 -> Int -> Ptr (ZonkAny 0)
forall a b. Ptr a -> Int -> Ptr b
`FP.plusPtr` Int
o)

-- | Consume exactly @n@ bytes of input.
take :: BsParserCon d => Int -> DirParser d ByteString
take :: forall (d :: Dir). BsParserCon d => Int -> DirParser d ByteString
take Int
n0 = do
  let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n0 Int
0
  s <- Int -> DirParser d ByteString
forall (d :: Dir). BsParserCon d => Int -> DirParser d ByteString
ensure Int
n
  advance ($(tw "/n0 n") n)  >> return s
{-# INLINE take #-}

-- | @string s@ parses a sequence of bytes that identically match
-- @s@. Returns the parsed string (i.e. @s@).  This parser consumes no
-- input if it fails (even if a partial match).
--
-- /Note/: The behaviour of this parser is different to that of the
-- similarly-named parser in Parsec, as this one is all-or-nothing.
-- To illustrate the difference, the following parser will fail under
-- Parsec given an input of @\"for\"@:
--
-- >string "foo" <|> string "for"
--
-- The reason for its failure is that the first branch is a
-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
-- before failing.  In attoparsec, the above parser will /succeed/ on
-- that input, because the failed first branch will consume nothing.
string :: BsParserCon d => ByteString -> DirParser d ByteString
string :: forall (d :: Dir).
BsParserCon d =>
ByteString -> DirParser d ByteString
string ByteString
s = (forall r.
 Tagged d ByteString
 -> Tagged d ByteString
 -> DirBuffer d
 -> DirPos d
 -> More
 -> DirFailure d r
 -> DirSuccess d ByteString r
 -> Result r)
-> (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> DirParser d ByteString
forall (d :: Dir).
BsParserCon d =>
(forall r.
 Tagged d ByteString
 -> Tagged d ByteString
 -> DirBuffer d
 -> DirPos d
 -> More
 -> DirFailure d r
 -> DirSuccess d ByteString r
 -> Result r)
-> (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> DirParser d ByteString
string_ ((Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
forall (d :: Dir) r.
BsParserCon d =>
(Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
stringSuspended Tagged d ByteString -> Tagged d ByteString
forall a. a -> a
id) Tagged d ByteString -> Tagged d ByteString
forall a. a -> a
id (ByteString -> Tagged d ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged ByteString
s)
{-# INLINE string #-}

-- ASCII-specific but fast, oh yes.
toLower :: Word8 -> Word8
toLower :: Word8 -> Word8
toLower Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32
          | Bool
otherwise          = Word8
w

-- | Satisfy a literal string, ignoring case.
stringCI :: BsParserCon d => ByteString -> DirParser d ByteString
stringCI :: forall (d :: Dir).
BsParserCon d =>
ByteString -> DirParser d ByteString
stringCI ByteString
s = (forall r.
 Tagged d ByteString
 -> Tagged d ByteString
 -> DirBuffer d
 -> DirPos d
 -> More
 -> DirFailure d r
 -> DirSuccess d ByteString r
 -> Result r)
-> (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> DirParser d ByteString
forall (d :: Dir).
BsParserCon d =>
(forall r.
 Tagged d ByteString
 -> Tagged d ByteString
 -> DirBuffer d
 -> DirPos d
 -> More
 -> DirFailure d r
 -> DirSuccess d ByteString r
 -> Result r)
-> (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> DirParser d ByteString
string_ ((Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
forall (d :: Dir) r.
BsParserCon d =>
(Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
stringSuspended Tagged d ByteString -> Tagged d ByteString
lower) Tagged d ByteString -> Tagged d ByteString
lower (ByteString -> Tagged d ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged ByteString
s)
  where lower :: Tagged d ByteString -> Tagged d ByteString
lower = (ByteString -> ByteString)
-> Tagged d ByteString -> Tagged d ByteString
forall a b. (a -> b) -> Tagged d a -> Tagged d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> Word8) -> ByteString -> ByteString
B8.map Word8 -> Word8
toLower)
{-# INLINE stringCI #-}

string_ :: forall (d :: Dir). BsParserCon d
        => (forall r. Tagged d ByteString -> Tagged d ByteString -> DirBuffer d -> DirPos d -> More
            -> DirFailure d r -> DirSuccess d ByteString r -> Result r)
        -> (Tagged d ByteString -> Tagged d ByteString)
        -> Tagged d ByteString
        -> DirParser d ByteString
string_ :: forall (d :: Dir).
BsParserCon d =>
(forall r.
 Tagged d ByteString
 -> Tagged d ByteString
 -> DirBuffer d
 -> DirPos d
 -> More
 -> DirFailure d r
 -> DirSuccess d ByteString r
 -> Result r)
-> (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> DirParser d ByteString
string_ forall r.
Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
suspended Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
s0 = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) ByteString r
 -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) ByteString r
  -> IResult ByteString r)
 -> DirParser d ByteString ByteString)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) ByteString r
    -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString (DirState d ByteString) ByteString r
succ ->
  let n :: Int
n = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged d ByteString
s
      s :: Tagged d ByteString
s = Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
s0
  in if $(tw "/pos n s t") (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DirPos d -> Int -> DirBuffer d -> Bool
forall (d :: Dir).
Directed d =>
DirPos d -> Int -> DirBuffer d -> Bool
lengthAtLeast DirPos d
pos Int
n DirBuffer d
DirState d ByteString
t
     then let t' :: Tagged d ByteString
t' = DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
substring DirPos d
pos (Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos Int
n) DirBuffer d
DirState d ByteString
t
          in if Tagged d ByteString
s Tagged d ByteString -> Tagged d ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
t'
             then DirSuccess d ByteString (DirState d ByteString) ByteString r
succ DirState d ByteString
t (DirPos d
pos DirPos d -> DirPos d -> DirPos d
forall a. Num a => a -> a -> a
+ (DirPos d -> DirPos d
forall (d :: Dir). DirectedPlus d => DirPos d -> DirPos d
there (Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos Int
n))) More
more (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged d ByteString
t')
             else DirFailure d ByteString (DirState d ByteString) r
lose DirState d ByteString
t DirPos d
pos More
more [] String
"string"
     else let t' :: Tagged d ByteString
t' = DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirBuffer d -> Tagged d ByteString
peekRest DirPos d
pos DirBuffer d
DirState d ByteString
t
          in if Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
t' Tagged d ByteString -> Tagged d ByteString -> Bool
forall (d :: Dir).
Directed d =>
Tagged d ByteString -> Tagged d ByteString -> Bool
`isPrefixOf` Tagged d ByteString
s
             then Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> IResult ByteString r
forall r.
Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
suspended Tagged d ByteString
s (Int -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
Int -> Tagged d ByteString -> Tagged d ByteString
drop (Tagged d ByteString -> Int
forall a. IntLength a => a -> Int
length Tagged d ByteString
t') Tagged d ByteString
s) DirBuffer d
DirState d ByteString
t DirPos d
pos More
more DirFailure d r
DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString r
DirSuccess d ByteString (DirState d ByteString) ByteString r
succ
             else DirFailure d ByteString (DirState d ByteString) r
lose DirState d ByteString
t DirPos d
pos More
more [] String
"string"
{-# INLINE string_ #-}

stringSuspended :: forall d r. BsParserCon d
                => (Tagged d ByteString -> Tagged d ByteString)
                -> Tagged d ByteString
                -> Tagged d ByteString
                -> DirBuffer d -> DirPos d -> More
                -> DirFailure d r
                -> DirSuccess d ByteString r
                -> Result r
stringSuspended :: forall (d :: Dir) r.
BsParserCon d =>
(Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
stringSuspended Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
s0 Tagged d ByteString
s DirBuffer d
t DirPos d
pos More
more DirFailure d r
lose DirSuccess d ByteString r
succ =
    DirParser d ByteString ByteString
-> forall r.
   DirState d ByteString
   -> DirPos d
   -> More
   -> DirFailure d ByteString (DirState d ByteString) r
   -> DirSuccess d ByteString (DirState d ByteString) ByteString r
   -> IResult ByteString r
forall (d :: Dir) i a.
DirParser d i a
-> forall r.
   DirState d i
   -> DirPos d
   -> More
   -> DirFailure d i (DirState d i) r
   -> DirSuccess d i (DirState d i) a r
   -> IResult i r
runParser (DirParser d ByteString ByteString
forall (d :: Dir) t. DirChunk d t => DirParser d t t
demandInput_ DirParser d ByteString ByteString
-> (ByteString -> DirParser d ByteString ByteString)
-> DirParser d ByteString ByteString
forall a b.
DirParser d ByteString a
-> (a -> DirParser d ByteString b) -> DirParser d ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tagged d ByteString -> DirParser d ByteString ByteString
go (Tagged d ByteString -> DirParser d ByteString ByteString)
-> (ByteString -> Tagged d ByteString)
-> ByteString
-> DirParser d ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tagged d ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged) DirBuffer d
DirState d ByteString
t DirPos d
pos More
more DirFailure d r
DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString r
DirSuccess d ByteString (DirState d ByteString) ByteString r
succ
  where go :: Tagged d ByteString -> DirParser d ByteString ByteString
go Tagged d ByteString
s'0   = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) ByteString r
 -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) ByteString r
  -> IResult ByteString r)
 -> DirParser d ByteString ByteString)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) ByteString r
    -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t' DirPos d
pos' More
more' DirFailure d ByteString (DirState d ByteString) r
lose' DirSuccess d ByteString (DirState d ByteString) ByteString r
succ' ->
          let m :: Int
m  = Tagged d ByteString -> Int
forall a. IntLength a => a -> Int
length Tagged d ByteString
s
              s' :: Tagged d ByteString
s' = Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
s'0
              n :: Int
n  = Tagged d ByteString -> Int
forall a. IntLength a => a -> Int
length Tagged d ByteString
s'
          in if $(tw "/t t' pos pos' s' n m ") (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m
             then if Int -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
Int -> Tagged d ByteString -> Tagged d ByteString
unsafeTake Int
m Tagged d ByteString
s' Tagged d ByteString -> Tagged d ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Tagged d ByteString
s
                  then let o :: DirPos d
o = Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos (Tagged d ByteString -> Int
forall a. IntLength a => a -> Int
length Tagged d ByteString
s0)
                       in DirSuccess d ByteString (DirState d ByteString) ByteString r
succ' DirState d ByteString
t' (DirPos d
pos' DirPos d -> DirPos d -> DirPos d
forall a. Num a => a -> a -> a
+ DirPos d -> DirPos d
forall (d :: Dir). DirectedPlus d => DirPos d -> DirPos d
there DirPos d
o) More
more'
                          (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
substring DirPos d
pos' DirPos d
o DirBuffer d
DirState d ByteString
t')
                  else DirFailure d ByteString (DirState d ByteString) r
lose' DirState d ByteString
t' DirPos d
pos' More
more' [] String
"string"
             else if Tagged d ByteString
s' Tagged d ByteString -> Tagged d ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
Int -> Tagged d ByteString -> Tagged d ByteString
unsafeTake Int
n Tagged d ByteString
s
                  then (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> IResult ByteString r
forall (d :: Dir) r.
BsParserCon d =>
(Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
stringSuspended Tagged d ByteString -> Tagged d ByteString
f Tagged d ByteString
s0 (Int -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
Int -> Tagged d ByteString -> Tagged d ByteString
unsafeDrop Int
n Tagged d ByteString
s)
                       DirBuffer d
DirState d ByteString
t' DirPos d
pos' More
more' DirFailure d r
DirFailure d ByteString (DirState d ByteString) r
lose' DirSuccess d ByteString r
DirSuccess d ByteString (DirState d ByteString) ByteString r
succ'
                  else DirFailure d ByteString (DirState d ByteString) r
lose' DirState d ByteString
t' DirPos d
pos' More
more' [] String
"string"

-- | Skip past input for as long as the predicate returns 'True'.
skipWhile :: BsParserCon d => (Word8 -> Bool) -> DirParser d ()
skipWhile :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d ()
skipWhile Word8 -> Bool
p = DirParser d ByteString ()
go
 where
  go :: DirParser d ByteString ()
go = do
    t <- $(tw "tookWhileD/") (Tagged d ByteString -> Tagged d ByteString)
-> (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString
-> Tagged d ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
(Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
takeWhileD Word8 -> Bool
p (Tagged d ByteString -> Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
    continue <- $(tw "continue/") <$> inputSpansChunks (length $ untag t)
    when continue go
{-# INLINE skipWhile #-}

-- | Consume input as long as the predicate returns 'False'
-- (i.e. until it returns 'True'), and return the consumed input.
--
-- This parser does not fail.  It will return an empty string if the
-- predicate returns 'True' on the first byte of input.
--
-- /Note/: Because this parser does not fail, do not use it with
-- combinators such as 'Control.Applicative.many', because such
-- parsers loop until a failure occurs.  Careless use will thus result
-- in an infinite loop.
takeTill :: BsParserCon d => (Word8 -> Bool) -> DirParser d ByteString
takeTill :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d ByteString
takeTill Word8 -> Bool
p = (Word8 -> Bool) -> DirParser d ByteString
forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d 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 #-}

-- | Consume input as long as the predicate returns 'True', and return
-- the consumed input.
--
-- This parser does not fail.  It will return an empty string if the
-- predicate returns 'False' on the first byte of input.
--
-- /Note/: Because this parser does not fail, do not use it with
-- combinators such as 'Control.Applicative.many', because such
-- parsers loop until a failure occurs.  Careless use will thus result
-- in an infinite loop.
takeWhile :: BsParserCon d => (Word8 -> Bool) -> DirParser d ByteString
takeWhile :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d ByteString
takeWhile Word8 -> Bool
p = do
    s <- (Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
(Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
takeWhileD Word8 -> Bool
p (Tagged d ByteString -> Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
    continue <- inputSpansChunks (B.length $ untag s)
    if continue
      then takeWhileAcc p [s]
      else return $ untag s
{-# INLINE takeWhile #-}

takeWhileAcc :: forall d. BsParserCon d
             => (Word8 -> Bool)
             -> [Tagged d ByteString]
             -> DirParser d ByteString
takeWhileAcc :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> [Tagged d ByteString] -> DirParser d ByteString
takeWhileAcc Word8 -> Bool
p = [Tagged d ByteString] -> DirParser d ByteString ByteString
go
 where
  go :: [Tagged d ByteString] -> DirParser d ByteString ByteString
go [Tagged d ByteString]
acc = do
    s <- (Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
(Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
takeWhileD Word8 -> Bool
p (Tagged d ByteString -> Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
    continue <- inputSpansChunks (B.length $ untag s)
    if $(tw "continue/s acc") continue
      then go (s:acc)
      else pure . untag $ concatReverse (s:acc)
{-# INLINE takeWhileAcc #-}

-- | Consume input until immediately after the predicate returns 'True', and return
-- the consumed input.
--
-- This parser will consume at least one 'Word8' or fail.
takeWhileIncluding :: BsParserCon d => (Word8 -> Bool) -> DirParser d B.ByteString
takeWhileIncluding :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d ByteString
takeWhileIncluding Word8 -> Bool
p = do
  (s', t) <- (Word8 -> Bool)
-> Tagged d ByteString
-> (Tagged d ByteString, Tagged d ByteString)
forall (d :: Dir).
Directed d =>
(Word8 -> Bool)
-> Tagged d ByteString
-> (Tagged d ByteString, Tagged d ByteString)
span Word8 -> Bool
p (Tagged d ByteString -> (Tagged d ByteString, Tagged d ByteString))
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser
     d ByteString (Tagged d ByteString, Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
  case uncons t of
    -- Since we reached a break point and managed to get the next byte,
    -- input can not have been exhausted thus we succed and advance unconditionally.
    Just (Word8
h, ByteString
_) -> do
      let s :: ByteString
s = Tagged d ByteString
s' Tagged d ByteString -> Word8 -> ByteString
forall (d :: Dir).
Directed d =>
Tagged d ByteString -> Word8 -> ByteString
`snoc` Word8
h
      Int -> DirParser d ()
forall (d :: Dir). BsParserCon d => Int -> DirParser d ()
advance (Int -> DirParser d ()) -> Int -> DirParser d ()
forall a b. (a -> b) -> a -> b
$ $(tw "by len/s") (ByteString -> Int
B8.length ByteString
s)
      ByteString -> DirParser d ByteString ByteString
forall a. a -> DirParser d ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
    -- The above isn't true so either we ran out of input or we need to process the next chunk.
    Maybe (Word8, ByteString)
Nothing -> do
      continue <- Int -> DirParser d Bool
forall (d :: Dir). BsParserCon d => Int -> DirParser d Bool
inputSpansChunks (Tagged d ByteString -> Int
forall a. IntLength a => a -> Int
length Tagged d ByteString
s')
      if continue
        then takeWhileIncAcc p [s']
        -- Our spec says that if we run out of input we fail.
        else fail "takeWhileIncluding reached end of input"
{-# INLINE takeWhileIncluding #-}

takeWhileIncAcc :: BsParserCon d
                => (Word8 -> Bool)
                -> [Tagged d B.ByteString]
                -> DirParser d B.ByteString
takeWhileIncAcc :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> [Tagged d ByteString] -> DirParser d ByteString
takeWhileIncAcc Word8 -> Bool
p = [Tagged d ByteString] -> DirParser d ByteString ByteString
go
 where
   go :: [Tagged d ByteString] -> DirParser d ByteString ByteString
go [Tagged d ByteString]
acc = do
     (s', t) <- (Word8 -> Bool)
-> Tagged d ByteString
-> (Tagged d ByteString, Tagged d ByteString)
forall (d :: Dir).
Directed d =>
(Word8 -> Bool)
-> Tagged d ByteString
-> (Tagged d ByteString, Tagged d ByteString)
span Word8 -> Bool
p (Tagged d ByteString -> (Tagged d ByteString, Tagged d ByteString))
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser
     d ByteString (Tagged d ByteString, Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
     case uncons t of
       Just (Word8
h, ByteString
_) -> do
         let s :: ByteString
s = Tagged d ByteString
s' Tagged d ByteString -> Word8 -> ByteString
forall (d :: Dir).
Directed d =>
Tagged d ByteString -> Word8 -> ByteString
`snoc` Word8
h
         Int -> DirParser d ()
forall (d :: Dir). BsParserCon d => Int -> DirParser d ()
advance (Int -> DirParser d ()) -> Int -> DirParser d ()
forall a b. (a -> b) -> a -> b
$ $(tw "by len /s") (ByteString -> Int
B8.length ByteString
s)
         ByteString -> DirParser d ByteString ByteString
forall a. a -> DirParser d ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> DirParser d ByteString ByteString)
-> ByteString -> DirParser d ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag ([Tagged d ByteString] -> Tagged d ByteString
forall (d :: Dir) c. DirChunk d c => [Tagged d c] -> Tagged d c
concatReverse ([Tagged d ByteString] -> Tagged d ByteString)
-> [Tagged d ByteString] -> Tagged d ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Tagged d ByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged ByteString
s) Tagged d ByteString
-> [Tagged d ByteString] -> [Tagged d ByteString]
forall a. a -> [a] -> [a]
: [Tagged d ByteString]
acc)
       Maybe (Word8, ByteString)
Nothing -> do
         continue <- Int -> DirParser d Bool
forall (d :: Dir). BsParserCon d => Int -> DirParser d Bool
inputSpansChunks (Tagged d ByteString -> Int
forall a. IntLength a => a -> Int
length Tagged d ByteString
s')
         if continue
           then go (s':acc)
           else fail "takeWhileIncAcc reached end of input"
{-# INLINE takeWhileIncAcc #-}



takeRest :: BsParserCon d => DirParser d [Tagged d ByteString]
takeRest :: forall (d :: Dir).
BsParserCon d =>
DirParser d [Tagged d ByteString]
takeRest = $(tw "/") ([Tagged d ByteString] -> [Tagged d ByteString])
-> DirParser d ByteString [Tagged d ByteString]
-> DirParser d ByteString [Tagged d ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tagged d ByteString]
-> DirParser d ByteString [Tagged d ByteString]
forall {d :: Dir}.
(DirState d ByteString ~ DirBuffer d, DirChunk d ByteString,
 Directed d, HasDrift d, Alternative (DirParser d)) =>
[Tagged d ByteString]
-> DirParser d ByteString [Tagged d ByteString]
go []
  where
  go :: [Tagged d ByteString]
-> DirParser d ByteString [Tagged d ByteString]
go [Tagged d ByteString]
acc = do
    input <- DirParser d ByteString Bool
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t Bool
wantInput
    if input
      then do
        s <- get
        advance $ $(tw "by len/s") (length s)
        go (s:acc)
      else return (reverse acc)

-- | Consume all remaining input and return it as a single string.
takeByteString :: BsParserCon d => DirParser d ByteString
takeByteString :: forall (d :: Dir). BsParserCon d => DirParser d ByteString
takeByteString = (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> ([Tagged d ByteString] -> Tagged d ByteString)
-> [Tagged d ByteString]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tagged d ByteString] -> Tagged d ByteString
forall a. Monoid a => [a] -> a
mconcat) ([Tagged d ByteString] -> ByteString)
-> DirParser d ByteString [Tagged d ByteString]
-> DirParser d ByteString ByteString
forall a b.
(a -> b) -> DirParser d ByteString a -> DirParser d ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DirParser d ByteString [Tagged d ByteString]
forall (d :: Dir).
BsParserCon d =>
DirParser d [Tagged d ByteString]
takeRest

-- | Consume all remaining input and return it as a single string.
takeLazyByteString :: BsParserCon d => DirParser d L.ByteString
takeLazyByteString :: forall (d :: Dir). BsParserCon d => DirParser d ByteString
takeLazyByteString = ([ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ([Tagged d ByteString] -> [ByteString])
-> [Tagged d ByteString]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tagged d ByteString -> ByteString)
-> [Tagged d ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag) ([Tagged d ByteString] -> ByteString)
-> DirParser d ByteString [Tagged d ByteString]
-> DirParser d ByteString ByteString
forall a b.
(a -> b) -> DirParser d ByteString a -> DirParser d ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DirParser d ByteString [Tagged d ByteString]
forall (d :: Dir).
BsParserCon d =>
DirParser d [Tagged d ByteString]
takeRest

-- | Return the rest of the current chunk without consuming anything.
--
-- If the current chunk is empty, then ask for more input.
-- If there is no more input, then return 'Nothing'
getChunk :: BsParserCon d => DirParser d (Maybe ByteString)
getChunk :: forall (d :: Dir). BsParserCon d => DirParser d (Maybe ByteString)
getChunk = do
  input <- DirParser d ByteString Bool
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t Bool
wantInput
  if input
    then Just . untag <$> get
    else return Nothing

data T s = T {-# UNPACK #-} !Int s

scan_ ::
  forall d s r. (Show s, BsParserCon d) =>
  (s -> [Tagged d ByteString] -> DirParser d r) ->
  s ->
  (s -> Word8 -> Maybe s) ->
  DirParser d r
scan_ :: forall (d :: Dir) s r.
(Show s, BsParserCon d) =>
(s -> [Tagged d ByteString] -> DirParser d r)
-> s -> (s -> Word8 -> Maybe s) -> DirParser d r
scan_ s -> [Tagged d ByteString] -> DirParser d r
f s
s0 s -> Word8 -> Maybe s
p = [Tagged d ByteString] -> s -> DirParser d r
go ($(tr "/s0") []) s
s0
 where
  go :: [Tagged d ByteString] -> s -> DirParser d r
go [Tagged d ByteString]
acc s
s1 = do
    bs <- $(tw "got bs/") (Tagged d ByteString -> Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
    let T i s' = inlinePerformIO $ scanner s1 bs p
        !h = Int -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
Int -> Tagged d ByteString -> Tagged d ByteString
unsafeTake Int
i (Tagged d ByteString -> Tagged d ByteString)
-> Tagged d ByteString -> Tagged d ByteString
forall a b. (a -> b) -> a -> b
$ $(tr "/i bs") Tagged d ByteString
bs
    continue <- inputSpansChunks $ $(tr "/i h") i
    if $(tr "/i s' h continue") continue
      then go (h:acc) s'
      else f s' (h:acc)
{-# INLINE scan_ #-}

-- | A stateful scanner.  The predicate consumes and transforms a
-- state argument, and each transformed state is passed to successive
-- invocations of the predicate on each byte of the input until one
-- returns 'Nothing' or the input ends.
--
-- This parser does not fail.  It will return an empty string if the
-- predicate returns 'Nothing' on the first byte of input.
--
-- /Note/: Because this parser does not fail, do not use it with
-- combinators such as 'Control.Applicative.many', because such
-- parsers loop until a failure occurs.  Careless use will thus result
-- in an infinite loop.
scan :: (Show s, BsParserCon d)
     => s -> (s -> Word8 -> Maybe s) -> DirParser d ByteString
scan :: forall s (d :: Dir).
(Show s, BsParserCon d) =>
s -> (s -> Word8 -> Maybe s) -> DirParser d ByteString
scan = (s -> [Tagged d ByteString] -> DirParser d ByteString)
-> s -> (s -> Word8 -> Maybe s) -> DirParser d ByteString
forall (d :: Dir) s r.
(Show s, BsParserCon d) =>
(s -> [Tagged d ByteString] -> DirParser d r)
-> s -> (s -> Word8 -> Maybe s) -> DirParser d r
scan_ ((s -> [Tagged d ByteString] -> DirParser d ByteString)
 -> s -> (s -> Word8 -> Maybe s) -> DirParser d ByteString)
-> (s -> [Tagged d ByteString] -> DirParser d ByteString)
-> s
-> (s -> Word8 -> Maybe s)
-> DirParser d ByteString
forall a b. (a -> b) -> a -> b
$ \s
_ [Tagged d ByteString]
chunks -> ByteString -> DirParser d ByteString
forall a. a -> DirParser d ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> DirParser d ByteString)
-> ByteString -> DirParser d ByteString
forall a b. (a -> b) -> a -> b
$! Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag ([Tagged d ByteString] -> Tagged d ByteString
forall (d :: Dir) c. DirChunk d c => [Tagged d c] -> Tagged d c
concatReverse [Tagged d ByteString]
chunks)
{-# INLINE scan #-}

-- | Like 'scan', but generalized to return the final state of the
-- scanner.
runScanner :: (Show s, BsParserCon d)
           => s -> (s -> Word8 -> Maybe s) -> DirParser d (ByteString, s)
runScanner :: forall s (d :: Dir).
(Show s, BsParserCon d) =>
s -> (s -> Word8 -> Maybe s) -> DirParser d (ByteString, s)
runScanner = (s -> [Tagged d ByteString] -> DirParser d (ByteString, s))
-> s -> (s -> Word8 -> Maybe s) -> DirParser d (ByteString, s)
forall (d :: Dir) s r.
(Show s, BsParserCon d) =>
(s -> [Tagged d ByteString] -> DirParser d r)
-> s -> (s -> Word8 -> Maybe s) -> DirParser d r
scan_ ((s -> [Tagged d ByteString] -> DirParser d (ByteString, s))
 -> s -> (s -> Word8 -> Maybe s) -> DirParser d (ByteString, s))
-> (s -> [Tagged d ByteString] -> DirParser d (ByteString, s))
-> s
-> (s -> Word8 -> Maybe s)
-> DirParser d (ByteString, s)
forall a b. (a -> b) -> a -> b
$ \s
s [Tagged d ByteString]
xs -> let !sx :: Tagged d ByteString
sx = [Tagged d ByteString] -> Tagged d ByteString
forall (d :: Dir) c. DirChunk d c => [Tagged d c] -> Tagged d c
concatReverse [Tagged d ByteString]
xs in (ByteString, s) -> DirParser d (ByteString, s)
forall a. a -> DirParser d ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged d ByteString
sx, s
s)
{-# INLINE runScanner #-}

-- | Consume input as long as the predicate returns 'True', and return
-- the consumed input.
--
-- This parser requires the predicate to succeed on at least one byte
-- of input: it will fail if the predicate never returns 'True' or if
-- there is no input left.
takeWhile1 :: BsParserCon d => (Word8 -> Bool) -> DirParser d ByteString
takeWhile1 :: forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d ByteString
takeWhile1 Word8 -> Bool
p = do
  (Bool -> DirParser d ByteString () -> DirParser d ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` DirParser d ByteString ()
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t ()
demandInput) (Bool -> DirParser d ByteString ())
-> DirParser d ByteString Bool -> DirParser d ByteString ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DirParser d ByteString Bool
forall (d :: Dir). BsParserCon d => DirParser d Bool
endOfChunk
  s <- (Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
(Word8 -> Bool) -> Tagged d ByteString -> Tagged d ByteString
takeWhileD Word8 -> Bool
p (Tagged d ByteString -> Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
-> DirParser d ByteString (Tagged d ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get
  let len = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag Tagged d ByteString
s
  if $(tw "/s len") $ len == 0
    then fail "takeWhile1"
    else do
      advance $ $(tw "by/len") len
      eoc <- endOfChunk
      if $(tw "eoc/") eoc
        then takeWhileAcc p [s]
        else return $ untag s
{-# INLINE takeWhile1 #-}

-- | Match any byte in a set.
--
-- >vowel = inClass "aeiou"
--
-- Range notation is supported.
--
-- >halfAlphabet = inClass "a-nA-N"
--
-- To add a literal @\'-\'@ to a set, place it at the beginning or end
-- of the string.
inClass :: String -> Word8 -> Bool
inClass :: String -> Word8 -> Bool
inClass String
s = (Word8 -> FastSet -> Bool
`memberWord8` FastSet
mySet)
    where mySet :: FastSet
mySet = String -> FastSet
charClass String
s
          {-# NOINLINE mySet #-}
{-# INLINE inClass #-}

-- | Match any byte not in a set.
notInClass :: String -> Word8 -> Bool
notInClass :: String -> Word8 -> Bool
notInClass 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 #-}

-- | Match any byte.
anyWord8 :: BsParserCon d => DirParser d Word8
anyWord8 :: forall (d :: Dir). BsParserCon d => DirParser d Word8
anyWord8 = (Word8 -> Bool) -> DirParser d Word8
forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d Word8
satisfy ((Word8 -> Bool) -> DirParser d Word8)
-> (Word8 -> Bool) -> DirParser d Word8
forall a b. (a -> b) -> a -> b
$ Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True
{-# INLINE anyWord8 #-}

-- | Match a specific byte.
word8 :: BsParserCon d => Word8 -> DirParser d Word8
word8 :: forall (d :: Dir). BsParserCon d => Word8 -> DirParser d Word8
word8 Word8
c = (Word8 -> Bool) -> DirParser d Word8
forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c) DirParser d Word8 -> String -> DirParser d Word8
forall (d :: Dir) i a. DirParser d i a -> String -> DirParser d i a
<?> Word8 -> String
forall a. Show a => a -> String
show Word8
c
{-# INLINE word8 #-}

-- | Match any byte except the given one.
notWord8 :: BsParserCon d => Word8 -> DirParser d Word8
notWord8 :: forall (d :: Dir). BsParserCon d => Word8 -> DirParser d Word8
notWord8 Word8
c = (Word8 -> Bool) -> DirParser d Word8
forall (d :: Dir).
BsParserCon d =>
(Word8 -> Bool) -> DirParser d Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
c) DirParser d Word8 -> String -> DirParser d Word8
forall (d :: Dir) i a. DirParser d i a -> String -> DirParser d i a
<?> String
"not " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c
{-# INLINE notWord8 #-}

-- | Match any byte, to perform lookahead. Returns 'Nothing' if end of
-- input has been reached. Does not consume any input.
--
-- /Note/: Because this parser does not fail, do not use it with
-- combinators such as 'Control.Applicative.many', because such
-- parsers loop until a failure occurs.  Careless use will thus result
-- in an infinite loop.
peekWord8 :: BsParserCon d => DirParser d (Maybe Word8)
peekWord8 :: forall (d :: Dir). BsParserCon d => DirParser d (Maybe Word8)
peekWord8 = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
 -> IResult ByteString r)
-> DirParser d ByteString (Maybe Word8)
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
  -> IResult ByteString r)
 -> DirParser d ByteString (Maybe Word8))
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
    -> IResult ByteString r)
-> DirParser d ByteString (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t pos :: DirPos d
pos@(Pos Int
pos_) More
more DirFailure d ByteString (DirState d ByteString) r
_lose DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
succ ->
  case () of
    ()
_| DirPos d -> Int -> Bool
forall (d :: Dir). Directed d => DirPos d -> Int -> Bool
isNotAll DirPos d
pos (DirBuffer d -> Int
forall (d :: Dir). DirBuffer d -> Int
Buf.length DirBuffer d
DirState d ByteString
t) ->
       let !w :: Word8
w = DirBuffer d -> Int -> Word8
forall (d :: Dir). DirBuffer d -> Int -> Word8
Buf.unsafeIndex DirBuffer d
DirState d ByteString
t Int
pos_
       in DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
succ DirState d ByteString
t DirPos d
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 ->
       DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
succ DirState d ByteString
t DirPos d
pos More
more Maybe Word8
forall a. Maybe a
Nothing
     | Bool
otherwise ->
       let succ' :: DirBuffer d -> DirPos d -> More -> IResult ByteString r
succ' DirBuffer d
t' DirPos d
pos' More
more' = let !w :: Word8
w = DirBuffer d -> Int -> Word8
forall (d :: Dir). DirBuffer d -> Int -> Word8
Buf.unsafeIndex DirBuffer d
t' Int
pos_
                                 in DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
succ DirBuffer d
DirState d ByteString
t' DirPos d
pos' More
more' (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
w)
           lose' :: DirBuffer d -> DirPos d -> More -> IResult ByteString r
lose' DirBuffer d
t' DirPos d
pos' More
more' = DirSuccess d ByteString (DirState d ByteString) (Maybe Word8) r
succ DirBuffer d
DirState d ByteString
t' DirPos d
pos' More
more' Maybe Word8
forall a. Maybe a
Nothing
       in DirState d ByteString
-> DirPos d
-> More
-> (DirState d ByteString
    -> DirPos d -> More -> IResult ByteString r)
-> (DirState d ByteString
    -> DirPos d -> More -> IResult ByteString r)
-> IResult ByteString r
forall t (d :: Dir) r.
(Show t, DirChunk d t) =>
DirState d t
-> DirPos d
-> More
-> (DirState d t -> DirPos d -> More -> IResult t r)
-> (DirState d t -> DirPos d -> More -> IResult t r)
-> IResult t r
prompt DirState d ByteString
t DirPos d
pos More
more DirBuffer d -> DirPos d -> More -> IResult ByteString r
DirState d ByteString -> DirPos d -> More -> IResult ByteString r
lose' DirBuffer d -> DirPos d -> More -> IResult ByteString r
DirState d ByteString -> DirPos d -> More -> IResult ByteString r
succ'
{-# INLINE peekWord8 #-}

-- | Match any byte, to perform lookahead.  Does not consume any
-- input, but will fail if end of input has been reached.
peekWord8' :: BsParserCon d => DirParser d Word8
peekWord8' :: forall (d :: Dir). BsParserCon d => DirParser d Word8
peekWord8' = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) Word8 r
 -> IResult ByteString r)
-> DirParser d ByteString Word8
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) Word8 r
  -> IResult ByteString r)
 -> DirParser d ByteString Word8)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) Word8 r
    -> IResult ByteString r)
-> DirParser d ByteString Word8
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString (DirState d ByteString) Word8 r
succ ->
    if DirPos d -> Int -> DirBuffer d -> Bool
forall (d :: Dir).
Directed d =>
DirPos d -> Int -> DirBuffer d -> Bool
lengthAtLeast DirPos d
pos Int
1 DirBuffer d
DirState d ByteString
t
    then DirSuccess d ByteString (DirState d ByteString) Word8 r
succ DirState d ByteString
t DirPos d
pos More
more (DirBuffer d -> Int -> Word8
forall (d :: Dir). DirBuffer d -> Int -> Word8
Buf.unsafeIndex DirBuffer d
DirState d ByteString
t (DirPos d -> Int
forall (d :: Dir). DirPos d -> Int
fromPos DirPos d
pos))
    else let succ' :: DirBuffer d
-> DirPos d -> More -> ByteString -> IResult ByteString r
succ' DirBuffer d
t' DirPos d
pos' More
more' ByteString
bs' = DirSuccess d ByteString (DirState d ByteString) Word8 r
succ DirBuffer d
DirState d ByteString
t' DirPos d
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
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> (DirBuffer d
    -> DirPos d -> More -> ByteString -> IResult ByteString r)
-> IResult ByteString r
forall (d :: Dir) r.
BsParserCon d =>
Int
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
ensureSuspended Int
1 DirBuffer d
DirState d ByteString
t DirPos d
pos More
more DirFailure d r
DirFailure d ByteString (DirState d ByteString) r
lose DirBuffer d
-> DirPos d -> More -> ByteString -> IResult ByteString r
succ'
{-# INLINE peekWord8' #-}

-- | Match either a single newline character @\'\\n\'@, or a carriage
-- return followed by a newline character @\"\\r\\n\"@.
endOfLine :: BsParserCon d => DirParser d ()
endOfLine :: forall (d :: Dir). BsParserCon d => DirParser d ()
endOfLine = (Word8 -> DirParser d Word8
forall (d :: Dir). BsParserCon d => Word8 -> DirParser d Word8
word8 Word8
10 DirParser d Word8
-> DirParser d ByteString () -> DirParser d ByteString ()
forall a b.
DirParser d ByteString a
-> DirParser d ByteString b -> DirParser d ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> DirParser d ByteString ()
forall a. a -> DirParser d ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) DirParser d ByteString ()
-> DirParser d ByteString () -> DirParser d ByteString ()
forall a.
DirParser d ByteString a
-> DirParser d ByteString a -> DirParser d ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> DirParser d ByteString
forall (d :: Dir).
BsParserCon d =>
ByteString -> DirParser d ByteString
string ByteString
"\r\n" DirParser d ByteString
-> DirParser d ByteString () -> DirParser d ByteString ()
forall a b.
DirParser d ByteString a
-> DirParser d ByteString b -> DirParser d ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> DirParser d ByteString ()
forall a. a -> DirParser d ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Terminal failure continuation.
failK :: BsParserCon d => DirFailure d a
failK :: forall (d :: Dir) a. BsParserCon d => DirFailure d a
failK DirBuffer d
t DirPos d
pos More
_more [String]
stack String
msg = ByteString -> [String] -> String -> IResult ByteString a
forall i r. i -> [String] -> String -> IResult i r
Fail (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirBuffer d -> Tagged d ByteString
peekRest DirPos d
pos DirBuffer d
t) [String]
stack String
msg
{-# INLINE failK #-}

-- | Terminal success continuation.
successK :: BsParserCon d => DirSuccess d a a
successK :: forall (d :: Dir) a. BsParserCon d => DirSuccess d a a
successK DirBuffer d
t DirPos d
pos More
_more a
a = ByteString -> a -> IResult ByteString a
forall i r. i -> r -> IResult i r
Done (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirBuffer d -> Tagged d ByteString
peekRest DirPos d
pos DirBuffer d
t) a
a
{-# INLINE successK #-}

-- | Run a parser.
dirParse ::
  forall d a. (Buf.DefaultDrift d, BsParserCon d) =>
  DirParser d a -> ByteString -> Result a
dirParse :: forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> ByteString -> Result a
dirParse DirParser d a
m ByteString
s = DirParser d a
-> forall r.
   DirState d ByteString
   -> DirPos d
   -> More
   -> DirFailure d ByteString (DirState d ByteString) r
   -> DirSuccess d ByteString (DirState d ByteString) a r
   -> IResult ByteString r
forall (d :: Dir) i a.
DirParser d i a
-> forall r.
   DirState d i
   -> DirPos d
   -> More
   -> DirFailure d i (DirState d i) r
   -> DirSuccess d i (DirState d i) a r
   -> IResult i r
T.runParser DirParser d a
m DirBuffer d
DirState d ByteString
b DirPos d
sp More
Incomplete DirFailure d a
DirFailure d ByteString (DirState d ByteString) a
forall (d :: Dir) a. BsParserCon d => DirFailure d a
failK DirSuccess d a a
DirSuccess d ByteString (DirState d ByteString) a a
forall (d :: Dir) a. BsParserCon d => DirSuccess d a a
successK
  where
    sp :: DirPos d
sp = $(tw "dirParse startPos/s") (DirPos d -> DirPos d) -> DirPos d -> DirPos d
forall a b. (a -> b) -> a -> b
$ ByteString -> DirPos d
forall (d :: Dir). Directed d => ByteString -> DirPos d
startPos ByteString
s
    b :: DirBuffer d
b = DriftF d -> ByteString -> DirBuffer d
forall (d :: Dir). DriftF d -> ByteString -> DirBuffer d
buffer' (Proxy d -> DriftF d
forall (d :: Dir). DefaultDrift d => Proxy d -> DriftF d
initDrift (forall {k} (t :: k). Proxy t
forall (t :: Dir). Proxy t
Proxy @d)) ByteString
s
{-# INLINE dirParse #-}

parse :: Parser a -> ByteString -> Result a
parse :: forall a. Parser a -> ByteString -> Result a
parse = DirParser 'Forward a -> ByteString -> Result a
forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> ByteString -> Result a
dirParse
{-# INLINE parse #-}

parseBack :: BackParser a -> ByteString -> Result a
parseBack :: forall a. BackParser a -> ByteString -> Result a
parseBack = DirParser 'Backward a -> ByteString -> Result a
forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> ByteString -> Result a
dirParse
{-# INLINE parseBack #-}

dirParseOnly ::
  forall d a. (Buf.DefaultDrift d, BsParserCon d) =>
  DirParser d a -> ByteString -> Either String a
dirParseOnly :: forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> ByteString -> Either String a
dirParseOnly DirParser d a
m ByteString
s =
  case DirParser d a
-> forall r.
   DirState d ByteString
   -> DirPos d
   -> More
   -> DirFailure d ByteString (DirState d ByteString) r
   -> DirSuccess d ByteString (DirState d ByteString) a r
   -> IResult ByteString r
forall (d :: Dir) i a.
DirParser d i a
-> forall r.
   DirState d i
   -> DirPos d
   -> More
   -> DirFailure d i (DirState d i) r
   -> DirSuccess d i (DirState d i) a r
   -> IResult i r
T.runParser DirParser d a
m DirBuffer d
DirState d ByteString
b (ByteString -> DirPos d
forall (d :: Dir). Directed d => ByteString -> DirPos d
startPos ByteString
s) More
Complete DirFailure d a
DirFailure d ByteString (DirState d ByteString) a
forall (d :: Dir) a. BsParserCon d => DirFailure d a
failK DirSuccess d a a
DirSuccess d ByteString (DirState d ByteString) a a
forall (d :: Dir) a. BsParserCon d => DirSuccess d a a
successK of
                  Fail ByteString
_ [] String
err   -> String -> Either String a
forall a b. a -> Either a b
Left String
err
                  Fail ByteString
_ [String]
ctxs String
err -> String -> Either String a
forall a b. a -> Either a b
Left (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" > " [String]
ctxs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
                  Done ByteString
_ a
a        -> a -> Either String a
forall a b. b -> Either a b
Right a
a
                  IResult ByteString a
_               -> String -> Either String a
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
  where
    b :: DirBuffer d
b = DriftF d -> ByteString -> DirBuffer d
forall (d :: Dir). DriftF d -> ByteString -> DirBuffer d
buffer' (Proxy d -> DriftF d
forall (d :: Dir). DefaultDrift d => Proxy d -> DriftF d
initDrift (forall {k} (t :: k). Proxy t
forall (t :: Dir). Proxy t
Proxy @d)) ByteString
s
{-# INLINE dirParseOnly #-}

-- | Run a parser that cannot be resupplied via a 'Partial' result.
--
-- This function does not force a parser to consume all of its input.
-- Instead, any residual input will be discarded.  To force a parser
-- to consume all of its input, use something like this:
--
-- @
--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
-- @
parseOnly :: Parser a -> ByteString -> Either String a
parseOnly :: forall a. Parser a -> ByteString -> Either String a
parseOnly = DirParser 'Forward a -> ByteString -> Either String a
forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> ByteString -> Either String a
dirParseOnly
{-# INLINE parseOnly #-}

parseBackOnly :: BackParser a -> ByteString -> Either String a
parseBackOnly :: forall a. BackParser a -> ByteString -> Either String a
parseBackOnly = DirParser 'Backward a -> ByteString -> Either String a
forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> ByteString -> Either String a
dirParseOnly
{-# INLINE parseBackOnly #-}

get :: BsParserCon d => DirParser d (Tagged d ByteString)
get :: forall (d :: Dir).
BsParserCon d =>
DirParser d (Tagged d ByteString)
get = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess
      d ByteString (DirState d ByteString) (Tagged d ByteString) r
 -> IResult ByteString r)
-> DirParser d ByteString (Tagged d ByteString)
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess
       d ByteString (DirState d ByteString) (Tagged d ByteString) r
  -> IResult ByteString r)
 -> DirParser d ByteString (Tagged d ByteString))
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess
         d ByteString (DirState d ByteString) (Tagged d ByteString) r
    -> IResult ByteString r)
-> DirParser d ByteString (Tagged d ByteString)
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
_lose DirSuccess
  d ByteString (DirState d ByteString) (Tagged d ByteString) r
succ ->
  DirSuccess
  d ByteString (DirState d ByteString) (Tagged d ByteString) r
succ DirState d ByteString
t DirPos d
pos More
more (DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirBuffer d -> Tagged d ByteString
peekRest ($(tw "from position/t") DirPos d
pos) DirBuffer d
DirState d ByteString
t)
{-# INLINE get #-}

endOfChunk :: BsParserCon d => DirParser d Bool
endOfChunk :: forall (d :: Dir). BsParserCon d => DirParser d Bool
endOfChunk = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) Bool r
 -> IResult ByteString r)
-> DirParser d ByteString Bool
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) Bool r
  -> IResult ByteString r)
 -> DirParser d ByteString Bool)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) Bool r
    -> IResult ByteString r)
-> DirParser d ByteString Bool
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
_lose DirSuccess d ByteString (DirState d ByteString) Bool r
succ ->
  DirSuccess d ByteString (DirState d ByteString) Bool r
succ DirState d ByteString
t DirPos d
pos More
more (Bool -> IResult ByteString r) -> Bool -> IResult ByteString r
forall a b. (a -> b) -> a -> b
$ $(tw "for/pos t") (Bool -> Bool
not (DirPos d -> Int -> Bool
forall (d :: Dir). Directed d => DirPos d -> Int -> Bool
isNotAll DirPos d
pos (DirBuffer d -> Int
forall (d :: Dir). DirBuffer d -> Int
Buf.length DirBuffer d
DirState d ByteString
t)))
{-# INLINE endOfChunk #-}

inputSpansChunks :: BsParserCon d => Int -> DirParser d Bool
inputSpansChunks :: forall (d :: Dir). BsParserCon d => Int -> DirParser d Bool
inputSpansChunks Int
i = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) Bool r
 -> IResult ByteString r)
-> DirParser d ByteString Bool
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) Bool r
  -> IResult ByteString r)
 -> DirParser d ByteString Bool)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) Bool r
    -> IResult ByteString r)
-> DirParser d ByteString Bool
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos_ More
more DirFailure d ByteString (DirState d ByteString) r
_lose DirSuccess d ByteString (DirState d ByteString) Bool r
succ ->
  let pos :: DirPos d
pos = DirPos d
pos_ DirPos d -> DirPos d -> DirPos d
forall a. Num a => a -> a -> a
+ DirPos d -> DirPos d
forall (d :: Dir). DirectedPlus d => DirPos d -> DirPos d
there (Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos Int
i)
  in if $(tw "/more pos pos_ i t") (DirPos d -> Int -> Bool
forall (d :: Dir). Directed d => DirPos d -> Int -> Bool
isNotAll DirPos d
pos (DirBuffer d -> Int
forall (d :: Dir). DirBuffer d -> Int
Buf.length DirBuffer d
DirState d ByteString
t) Bool -> Bool -> Bool
|| More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete)
     then DirSuccess d ByteString (DirState d ByteString) Bool r
succ DirState d ByteString
t DirPos d
pos More
more Bool
False
     else let lose' :: DirBuffer d -> DirPos d -> More -> IResult ByteString r
lose' DirBuffer d
t' DirPos d
pos' More
more' = DirSuccess d ByteString (DirState d ByteString) Bool r
succ DirBuffer d
DirState d ByteString
t' DirPos d
pos' More
more' Bool
False
              succ' :: DirBuffer d -> DirPos d -> More -> IResult ByteString r
succ' DirBuffer d
t' DirPos d
pos' More
more' = DirSuccess d ByteString (DirState d ByteString) Bool r
succ DirBuffer d
DirState d ByteString
t' DirPos d
pos' More
more' Bool
True
          in DirState d ByteString
-> DirPos d
-> More
-> (DirState d ByteString
    -> DirPos d -> More -> IResult ByteString r)
-> (DirState d ByteString
    -> DirPos d -> More -> IResult ByteString r)
-> IResult ByteString r
forall t (d :: Dir) r.
(Show t, DirChunk d t) =>
DirState d t
-> DirPos d
-> More
-> (DirState d t -> DirPos d -> More -> IResult t r)
-> (DirState d t -> DirPos d -> More -> IResult t r)
-> IResult t r
prompt DirState d ByteString
t DirPos d
pos More
more DirBuffer d -> DirPos d -> More -> IResult ByteString r
DirState d ByteString -> DirPos d -> More -> IResult ByteString r
lose' DirBuffer d -> DirPos d -> More -> IResult ByteString r
DirState d ByteString -> DirPos d -> More -> IResult ByteString r
succ'
{-# INLINE inputSpansChunks #-}

advance :: BsParserCon d => Int -> DirParser d ()
advance :: forall (d :: Dir). BsParserCon d => Int -> DirParser d ()
advance Int
n = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) () r
 -> IResult ByteString r)
-> DirParser d ByteString ()
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) () r
  -> IResult ByteString r)
 -> DirParser d ByteString ())
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) () r
    -> IResult ByteString r)
-> DirParser d ByteString ()
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
_lose DirSuccess d ByteString (DirState d ByteString) () r
succ ->
  DirSuccess d ByteString (DirState d ByteString) () r
succ DirState d ByteString
t (DirPos d
pos DirPos d -> DirPos d -> DirPos d
forall a. Num a => a -> a -> a
+ $(tw "ret by/more pos n t") (DirPos d -> DirPos d
forall (d :: Dir). DirectedPlus d => DirPos d -> DirPos d
there (Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos Int
n))) More
more ()
{-# INLINE advance #-}

ensureSuspended :: BsParserCon d
                => Int -> DirBuffer d -> DirPos d -> More
                -> DirFailure d r
                -> DirSuccess d ByteString r
                -> Result r
ensureSuspended :: forall (d :: Dir) r.
BsParserCon d =>
Int
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
ensureSuspended Int
n DirBuffer d
t DirPos d
pos More
more DirFailure d r
lose DirSuccess d ByteString r
succ =
    DirParser d ByteString ByteString
-> forall r.
   DirState d ByteString
   -> DirPos d
   -> More
   -> DirFailure d ByteString (DirState d ByteString) r
   -> DirSuccess d ByteString (DirState d ByteString) ByteString r
   -> IResult ByteString r
forall (d :: Dir) i a.
DirParser d i a
-> forall r.
   DirState d i
   -> DirPos d
   -> More
   -> DirFailure d i (DirState d i) r
   -> DirSuccess d i (DirState d i) a r
   -> IResult i r
runParser (DirParser d ByteString ()
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t ()
demandInput DirParser d ByteString ()
-> DirParser d ByteString ByteString
-> DirParser d ByteString ByteString
forall a b.
DirParser d ByteString a
-> DirParser d ByteString b -> DirParser d ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DirParser d ByteString ByteString
go) DirBuffer d
DirState d ByteString
t DirPos d
pos More
more DirFailure d r
DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString r
DirSuccess d ByteString (DirState d ByteString) ByteString r
succ
  where go :: DirParser d ByteString ByteString
go = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) ByteString r
 -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) ByteString r
  -> IResult ByteString r)
 -> DirParser d ByteString ByteString)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) ByteString r
    -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t' DirPos d
pos' More
more' DirFailure d ByteString (DirState d ByteString) r
lose' DirSuccess d ByteString (DirState d ByteString) ByteString r
succ' ->
          if $(tw "/t' pos' t pos n") (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DirPos d -> Int -> DirBuffer d -> Bool
forall (d :: Dir).
Directed d =>
DirPos d -> Int -> DirBuffer d -> Bool
lengthAtLeast DirPos d
pos' Int
n DirBuffer d
DirState d ByteString
t'
          then DirSuccess d ByteString (DirState d ByteString) ByteString r
succ' DirState d ByteString
t' DirPos d
pos' More
more' (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
substring DirPos d
pos' (Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos Int
n) DirBuffer d
DirState d ByteString
t')
          else DirParser d ByteString ByteString
-> forall r.
   DirState d ByteString
   -> DirPos d
   -> More
   -> DirFailure d ByteString (DirState d ByteString) r
   -> DirSuccess d ByteString (DirState d ByteString) ByteString r
   -> IResult ByteString r
forall (d :: Dir) i a.
DirParser d i a
-> forall r.
   DirState d i
   -> DirPos d
   -> More
   -> DirFailure d i (DirState d i) r
   -> DirSuccess d i (DirState d i) a r
   -> IResult i r
runParser (DirParser d ByteString ()
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t ()
demandInput DirParser d ByteString ()
-> DirParser d ByteString ByteString
-> DirParser d ByteString ByteString
forall a b.
DirParser d ByteString a
-> DirParser d ByteString b -> DirParser d ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DirParser d ByteString ByteString
go) DirState d ByteString
t' DirPos d
pos' More
more' DirFailure d ByteString (DirState d ByteString) r
lose' DirSuccess d ByteString (DirState d ByteString) ByteString r
succ'

-- | If at least @n@ elements of input are available, return the
-- current input, otherwise fail.
ensure :: BsParserCon d => Int -> DirParser d ByteString
ensure :: forall (d :: Dir). BsParserCon d => Int -> DirParser d ByteString
ensure Int
n = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess d ByteString (DirState d ByteString) ByteString r
 -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess d ByteString (DirState d ByteString) ByteString r
  -> IResult ByteString r)
 -> DirParser d ByteString ByteString)
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess d ByteString (DirState d ByteString) ByteString r
    -> IResult ByteString r)
-> DirParser d ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString (DirState d ByteString) ByteString r
succ ->
    if $(tw "/n pos") (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DirPos d -> Int -> DirBuffer d -> Bool
forall (d :: Dir).
Directed d =>
DirPos d -> Int -> DirBuffer d -> Bool
lengthAtLeast DirPos d
pos Int
n DirBuffer d
DirState d ByteString
t
    then DirSuccess d ByteString (DirState d ByteString) ByteString r
succ DirState d ByteString
t DirPos d
pos More
more (Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
substring DirPos d
pos (Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos Int
n) DirBuffer d
DirState d ByteString
t)
    -- The uncommon case is kept out-of-line to reduce code size:
    else Int
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> IResult ByteString r
forall (d :: Dir) r.
BsParserCon d =>
Int
-> DirBuffer d
-> DirPos d
-> More
-> DirFailure d r
-> DirSuccess d ByteString r
-> Result r
ensureSuspended Int
n DirBuffer d
DirState d ByteString
t DirPos d
pos More
more DirFailure d r
DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString r
DirSuccess d ByteString (DirState d ByteString) ByteString r
succ
{-# INLINE ensure #-}

-- | Return both the result of a parse and the portion of the input
-- that was consumed while it was being parsed.
match :: BsParserCon d => DirParser d a -> DirParser d (ByteString, a)
match :: forall (d :: Dir) a.
BsParserCon d =>
DirParser d a -> DirParser d (ByteString, a)
match DirParser d a
p = (forall r.
 DirState d ByteString
 -> DirPos d
 -> More
 -> DirFailure d ByteString (DirState d ByteString) r
 -> DirSuccess
      d ByteString (DirState d ByteString) (ByteString, a) r
 -> IResult ByteString r)
-> DirParser d ByteString (ByteString, a)
forall (d :: Dir) i a.
(forall r.
 DirState d i
 -> DirPos d
 -> More
 -> DirFailure d i (DirState d i) r
 -> DirSuccess d i (DirState d i) a r
 -> IResult i r)
-> DirParser d i a
T.Parser ((forall r.
  DirState d ByteString
  -> DirPos d
  -> More
  -> DirFailure d ByteString (DirState d ByteString) r
  -> DirSuccess
       d ByteString (DirState d ByteString) (ByteString, a) r
  -> IResult ByteString r)
 -> DirParser d ByteString (ByteString, a))
-> (forall r.
    DirState d ByteString
    -> DirPos d
    -> More
    -> DirFailure d ByteString (DirState d ByteString) r
    -> DirSuccess
         d ByteString (DirState d ByteString) (ByteString, a) r
    -> IResult ByteString r)
-> DirParser d ByteString (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
lose DirSuccess d ByteString (DirState d ByteString) (ByteString, a) r
succ ->
  let drift :: Int
drift = DirBuffer d -> Int
forall (d :: Dir). HasDrift d => DirBuffer d -> Int
Buf.getDrift DirBuffer d
DirState d ByteString
t
      succ' :: DirBuffer d -> DirPos d -> More -> a -> IResult ByteString r
succ' DirBuffer d
t' DirPos d
pos' More
more' a
a =
        let drift' :: Int
drift' = DirBuffer d -> Int
forall (d :: Dir). HasDrift d => DirBuffer d -> Int
Buf.getDrift DirBuffer d
t'
            dd :: DirPos d
dd = Int -> DirPos d
forall (d :: Dir). Int -> DirPos d
Pos (Int -> DirPos d) -> Int -> DirPos d
forall a b. (a -> b) -> a -> b
$ Int
drift' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
drift
            posD :: DirPos d
posD = DirPos d -> DirPos d -> DirPos d
forall (d :: Dir). Directed d => DirPos d -> DirPos d -> DirPos d
diffLen DirPos d
pos' DirPos d
pos
         in
        --   pos' = -1 pos = 0 => 0 - (-1) => n = 1
        --       (Tagged (Buf.substring (pos + 1 - n) n b))
          DirSuccess d ByteString (DirState d ByteString) (ByteString, a) r
succ DirBuffer d
DirState d ByteString
t' DirPos d
pos' More
more'
          ( Tagged d ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
forall (d :: Dir).
Directed d =>
DirPos d -> DirPos d -> DirBuffer d -> Tagged d ByteString
substring (DirPos d
pos DirPos d -> DirPos d -> DirPos d
forall a. Num a => a -> a -> a
+ DirPos d
dd) (DirPos d
dd DirPos d -> DirPos d -> DirPos d
forall a. Num a => a -> a -> a
+ DirPos d
posD) (DirBuffer d -> Tagged d ByteString)
-> DirBuffer d -> Tagged d ByteString
forall a b. (a -> b) -> a -> b
$
            $(tr "/drift drift' pos pos' t t' dd posD") DirBuffer d
t'
          , a
a
          )
  in DirParser d a
-> forall r.
   DirState d ByteString
   -> DirPos d
   -> More
   -> DirFailure d ByteString (DirState d ByteString) r
   -> DirSuccess d ByteString (DirState d ByteString) a r
   -> IResult ByteString r
forall (d :: Dir) i a.
DirParser d i a
-> forall r.
   DirState d i
   -> DirPos d
   -> More
   -> DirFailure d i (DirState d i) r
   -> DirSuccess d i (DirState d i) a r
   -> IResult i r
runParser DirParser d a
p DirState d ByteString
t DirPos d
pos More
more DirFailure d ByteString (DirState d ByteString) r
lose DirBuffer d -> DirPos d -> More -> a -> IResult ByteString r
DirSuccess d ByteString (DirState d ByteString) a r
succ'