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

module Data.Attoparsec.Text.Internal
    (
    -- * Parser types
      Parser
    , Result

    -- * Running parsers
    , parse
    , parseOnly

    -- * Combinators
    , module Data.Attoparsec.Combinator

    -- * Parsing individual characters
    , satisfy
    , satisfyWith
    , anyChar
    , skip
    , char
    , notChar

    -- ** Lookahead
    , peekChar
    , peekChar'

    -- ** Character classes
    , inClass
    , notInClass

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

    -- ** Consume all remaining input
    , takeText
    , takeLazyText

    -- * Utilities
    , endOfLine
    , endOfInput
    , match
    , atEnd
    ) where

import Control.Applicative ((<|>))
import Control.Monad (when)
import Data.Attoparsec.Combinator ((<?>))
import Data.Attoparsec.Internal hiding (concatReverse)
import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success, concatReverse)
import qualified Data.Attoparsec.Text.Buffer as Buf
import Data.Attoparsec.Text.Buffer (Buffer, buffer)
import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
import Data.List (intercalate)
import Data.String (IsString(..))
import Data.Text.Internal (Text(..))
import Prelude hiding (getChar, succ, take, takeWhile)
import qualified Data.Attoparsec.Internal.Types as T
import qualified Data.Attoparsec.Text.FastSet as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Unsafe as T

type Parser = T.Parser Text
type Result = IResult Text
type Failure r = T.Failure Text Buffer r
type Success a r = T.Success Text Buffer a r

instance (a ~ Text) => IsString (Parser a) where
    fromString :: [Char] -> Parser a
fromString = Text -> Parser a
Text -> Parser Text
string (Text -> Parser a) -> ([Char] -> Text) -> [Char] -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- | Concatenate a monoid after reversing its elements.  Used to
-- glue together a series of textual chunks that have been accumulated
-- \"backwards\".
concatReverse :: Monoid m => [m] -> m
concatReverse :: forall m. Monoid m => [m] -> m
concatReverse [m
x] = m
x
concatReverse [m]
xs  = [m] -> m
forall m. Monoid m => [m] -> m
mconcat ([m] -> [m]
forall a. [a] -> [a]
reverse [m]
xs)
{-# INLINE concatReverse #-}

-- | The parser @satisfy p@ succeeds for any character for which the
-- predicate @p@ returns 'True'. Returns the character that is
-- actually parsed.
--
-- >digit = satisfy isDigit
-- >    where isDigit c = c >= '0' && c <= '9'
satisfy :: (Char -> Bool) -> Parser Char
satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
p = do
  (k,c) <- Int -> Parser (DirPos 'Forward, Text)
ensure Int
1
  let !h = Text -> Char
T.unsafeHead Text
c
  if p h
    then advance k >> return h
    else fail "satisfy"
{-# INLINE satisfy #-}

-- | The parser @skip p@ succeeds for any character for which the
-- predicate @p@ returns 'True'.
--
-- >skipDigit = skip isDigit
-- >    where isDigit c = c >= '0' && c <= '9'
skip :: (Char -> Bool) -> Parser ()
skip :: (Char -> Bool) -> Parser ()
skip Char -> Bool
p = do
  (k,s) <- Int -> Parser (DirPos 'Forward, Text)
ensure Int
1
  if p (T.unsafeHead s)
    then advance k
    else fail "skip"

-- | The parser @satisfyWith f p@ transforms a character, and succeeds
-- if the predicate @p@ returns 'True' on the transformed value. The
-- parser returns the transformed character that was parsed.
satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
satisfyWith :: forall a. (Char -> a) -> (a -> Bool) -> Parser a
satisfyWith Char -> a
f a -> Bool
p = do
  (k,s) <- Int -> Parser (DirPos 'Forward, Text)
ensure Int
1
  let c = Char -> a
f (Char -> a) -> Char -> a
forall a b. (a -> b) -> a -> b
$! Text -> Char
T.unsafeHead Text
s
  if p c
    then advance k >> return c
    else fail "satisfyWith"
{-# INLINE satisfyWith #-}

-- | Consume @n@ characters of input, but succeed only if the
-- predicate returns 'True'.
takeWith :: Int -> (Text -> Bool) -> Parser Text
takeWith :: Int -> (Text -> Bool) -> Parser Text
takeWith Int
n Text -> Bool
p = do
  (k,s) <- Int -> Parser (DirPos 'Forward, Text)
ensure Int
n
  if p s
    then advance k >> return s
    else fail "takeWith"

-- | Consume exactly @n@ characters of input.
take :: Int -> Parser Text
take :: Int -> Parser Text
take Int
n = Int -> (Text -> Bool) -> Parser Text
takeWith (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0) (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)
{-# INLINE take #-}

-- | @string s@ parses a sequence of characters 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 :: Text -> Parser Text
string :: Text -> Parser Text
string Text
s = (forall r.
 Text
 -> Text
 -> Buffer
 -> DirPos 'Forward
 -> More
 -> Failure r
 -> Success Text r
 -> Result r)
-> (Text -> Text) -> Text -> Parser Text
string_ ((Text -> Text)
-> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended Text -> Text
forall a. a -> a
id) Text -> Text
forall a. a -> a
id Text
s
{-# INLINE string #-}

string_ :: (forall r. Text -> Text -> Buffer -> Pos -> More
            -> Failure r -> Success Text r -> Result r)
        -> (Text -> Text)
        -> Text -> Parser Text
string_ :: (forall r.
 Text
 -> Text
 -> Buffer
 -> DirPos 'Forward
 -> More
 -> Failure r
 -> Success Text r
 -> Result r)
-> (Text -> Text) -> Text -> Parser Text
string_ forall r.
Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text -> Text
f Text
s0 = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
 -> IResult Text r)
-> Parser Text
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
  -> IResult Text r)
 -> Parser Text)
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
    -> IResult Text r)
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ ->
  let s :: Text
s  = Text -> Text
f Text
s0
      ft :: Text
ft = Text -> Text
f (Int -> Buffer -> Text
Buf.unbufferAt (DirPos 'Forward -> Int
forall (d :: Dir). DirPos d -> Int
fromPos DirPos 'Forward
pos) Buffer
DirState 'Forward Text
t)
  in case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
s Text
ft of
       Maybe (Text, Text, Text)
Nothing
         | Text -> Bool
T.null Text
s          -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more Text
T.empty
         | Text -> Bool
T.null Text
ft         -> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> IResult Text r
forall r.
Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text
s Text
s Buffer
DirState 'Forward Text
t DirPos 'Forward
pos More
more Failure r
DirFailure 'Forward Text (DirState 'Forward Text) r
lose Success Text r
DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ
         | Bool
otherwise         -> DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirState 'Forward Text
t DirPos 'Forward
pos More
more [] [Char]
"string"
       Just (Text
pfx,Text
ssfx,Text
tsfx)
         | Text -> Bool
T.null Text
ssfx       -> let l :: DirPos 'Forward
l = Int -> DirPos 'Forward
forall (d :: Dir). Int -> DirPos d
Pos (Text -> Int
Buf.lengthCodeUnits Text
pfx)
                                in DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ DirState 'Forward Text
t (DirPos 'Forward
pos DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
+ DirPos 'Forward
l) More
more (DirPos 'Forward -> DirPos 'Forward -> Buffer -> Text
substring DirPos 'Forward
pos DirPos 'Forward
l Buffer
DirState 'Forward Text
t)
         | Bool -> Bool
not (Text -> Bool
T.null Text
tsfx) -> DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirState 'Forward Text
t DirPos 'Forward
pos More
more [] [Char]
"string"
         | Bool
otherwise         -> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> IResult Text r
forall r.
Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text
s Text
ssfx Buffer
DirState 'Forward Text
t DirPos 'Forward
pos More
more Failure r
DirFailure 'Forward Text (DirState 'Forward Text) r
lose Success Text r
DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ
{-# INLINE string_ #-}

stringSuspended :: (Text -> Text)
                -> Text -> Text -> Buffer -> Pos -> More
                -> Failure r
                -> Success Text r
                -> Result r
stringSuspended :: forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended Text -> Text
f Text
s000 Text
s0 Buffer
t0 DirPos 'Forward
pos0 More
more0 Failure r
lose0 Success Text r
succ0 =
    Parser Text
-> forall r.
   DirState 'Forward Text
   -> DirPos 'Forward
   -> More
   -> DirFailure 'Forward Text (DirState 'Forward Text) r
   -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
   -> IResult Text 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 (Parser Text
forall (d :: Dir) t. DirChunk d t => DirParser d t t
demandInput_ Parser Text -> (Text -> Parser Text) -> Parser Text
forall a b.
DirParser 'Forward Text a
-> (a -> DirParser 'Forward Text b) -> DirParser 'Forward Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
go) Buffer
DirState 'Forward Text
t0 DirPos 'Forward
pos0 More
more0 Failure r
DirFailure 'Forward Text (DirState 'Forward Text) r
lose0 Success Text r
DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ0
  where
    go :: Text -> Parser Text
go Text
s' = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
 -> IResult Text r)
-> Parser Text
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
  -> IResult Text r)
 -> Parser Text)
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
    -> IResult Text r)
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ ->
      let s :: Text
s = Text -> Text
f Text
s'
      in case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
s0 Text
s of
        Maybe (Text, Text, Text)
Nothing         -> DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirState 'Forward Text
t DirPos 'Forward
pos More
more [] [Char]
"string"
        Just (Text
_pfx,Text
ssfx,Text
tsfx)
          | Text -> Bool
T.null Text
ssfx -> let l :: DirPos 'Forward
l = Int -> DirPos 'Forward
forall (d :: Dir). Int -> DirPos d
Pos (Text -> Int
Buf.lengthCodeUnits Text
s000)
                           in DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ DirState 'Forward Text
t (DirPos 'Forward
pos DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
+ DirPos 'Forward
l) More
more (DirPos 'Forward -> DirPos 'Forward -> Buffer -> Text
substring DirPos 'Forward
pos DirPos 'Forward
l Buffer
DirState 'Forward Text
t)
          | Text -> Bool
T.null Text
tsfx -> (Text -> Text)
-> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> IResult Text r
forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended Text -> Text
f Text
s000 Text
ssfx Buffer
DirState 'Forward Text
t DirPos 'Forward
pos More
more Failure r
DirFailure 'Forward Text (DirState 'Forward Text) r
lose Success Text r
DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ
          | Bool
otherwise   -> DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirState 'Forward Text
t DirPos 'Forward
pos More
more [] [Char]
"string"

-- | Satisfy a literal string, ignoring case.
--
-- Note: this function is currently quite inefficient. Unicode case
-- folding can change the length of a string (\"&#223;\" becomes
-- "ss"), which makes a simple, efficient implementation tricky.  We
-- have (for now) chosen simplicity over efficiency.
stringCI :: Text -> Parser Text
stringCI :: Text -> Parser Text
stringCI Text
s = Int -> Parser Text
go Int
0
  where
    go :: Int -> Parser Text
go !Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
fs = [Char] -> Parser Text
forall a. [Char] -> DirParser 'Forward Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"stringCI"
      | Bool
otherwise = do
      (k,t) <- Int -> Parser (DirPos 'Forward, Text)
ensure Int
n
      if T.toCaseFold t == fs
        then advance k >> return t
        else go (n+1)
    fs :: Text
fs = Text -> Text
T.toCaseFold Text
s
{-# INLINE stringCI #-}
{-# DEPRECATED stringCI "this is very inefficient, use asciiCI instead" #-}

-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
asciiCI :: Text -> Parser Text
asciiCI :: Text -> Parser Text
asciiCI Text
s = ((Text, ()) -> Text)
-> DirParser 'Forward Text (Text, ()) -> Parser Text
forall a b.
(a -> b) -> DirParser 'Forward Text a -> DirParser 'Forward Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ()) -> Text
forall a b. (a, b) -> a
fst (DirParser 'Forward Text (Text, ()) -> Parser Text)
-> DirParser 'Forward Text (Text, ()) -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> DirParser 'Forward Text (Text, ())
forall a. Parser a -> Parser (Text, a)
match (Parser () -> DirParser 'Forward Text (Text, ()))
-> Parser () -> DirParser 'Forward Text (Text, ())
forall a b. (a -> b) -> a -> b
$ (Char -> Parser () -> Parser ()) -> Parser () -> Text -> Parser ()
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (Parser Char -> Parser () -> Parser ()
forall a b.
DirParser 'Forward Text a
-> DirParser 'Forward Text b -> DirParser 'Forward Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) (Parser Char -> Parser () -> Parser ())
-> (Char -> Parser Char) -> Char -> Parser () -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser Char
asciiCharCI) (() -> Parser ()
forall a. a -> DirParser 'Forward Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
s
{-# INLINE asciiCI #-}

asciiCharCI :: Char -> Parser Char
asciiCharCI :: Char -> Parser Char
asciiCharCI Char
c
  | Char -> Bool
isAsciiUpper Char
c = Char -> Parser Char
char Char
c Parser Char -> Parser Char -> Parser Char
forall a.
DirParser 'Forward Text a
-> DirParser 'Forward Text a -> DirParser 'Forward Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char (Char -> Char
toLower Char
c)
  | Char -> Bool
isAsciiLower Char
c = Char -> Parser Char
char Char
c Parser Char -> Parser Char -> Parser Char
forall a.
DirParser 'Forward Text a
-> DirParser 'Forward Text a -> DirParser 'Forward Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char (Char -> Char
toUpper Char
c)
  | Bool
otherwise = Char -> Parser Char
char Char
c
{-# INLINE asciiCharCI #-}

-- | Skip past input for as long as the predicate returns 'True'.
skipWhile :: (Char -> Bool) -> Parser ()
skipWhile :: (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
p = Parser ()
go
 where
  go :: Parser ()
go = do
    t <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
    continue <- inputSpansChunks (size 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 character 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 :: (Char -> Bool) -> Parser Text
takeTill :: (Char -> Bool) -> Parser Text
takeTill Char -> Bool
p = (Char -> Bool) -> Parser Text
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> 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 character 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 :: (Char -> Bool) -> Parser Text
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
p = do
    h <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
    continue <- inputSpansChunks (size h)
    -- only use slow concat path if necessary
    if continue
      then takeWhileAcc p [h]
      else return h
{-# INLINE takeWhile #-}

takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
takeWhileAcc Char -> Bool
p = [Text] -> Parser Text
go
 where
  go :: [Text] -> Parser Text
go [Text]
acc = do
    h <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
    continue <- inputSpansChunks (size h)
    if continue
      then go (h:acc)
      else return $ concatReverse (h:acc)
{-# INLINE takeWhileAcc #-}

takeRest :: Parser [Text]
takeRest :: Parser [Text]
takeRest = [Text] -> Parser [Text]
go []
 where
  go :: [Text] -> Parser [Text]
go [Text]
acc = do
    input <- Parser Bool
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t Bool
wantInput
    if input
      then do
        s <- get
        advance (size s)
        go (s:acc)
      else return (reverse acc)

-- | Consume all remaining input and return it as a single string.
takeText :: Parser Text
takeText :: Parser Text
takeText = [Text] -> Text
T.concat ([Text] -> Text) -> Parser [Text] -> Parser Text
forall a b.
(a -> b) -> DirParser 'Forward Text a -> DirParser 'Forward Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Text]
takeRest

-- | Consume all remaining input and return it as a single string.
takeLazyText :: Parser L.Text
takeLazyText :: Parser Text
takeLazyText = [Text] -> Text
L.fromChunks ([Text] -> Text) -> Parser [Text] -> Parser Text
forall a b.
(a -> b) -> DirParser 'Forward Text a -> DirParser 'Forward Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Text]
takeRest

data Scan s = Continue s
            | Finished s {-# UNPACK #-} !Int Text

scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
scan_ :: forall s r.
(s -> [Text] -> Parser r)
-> s -> (s -> Char -> Maybe s) -> Parser r
scan_ s -> [Text] -> Parser r
f s
s0 s -> Char -> Maybe s
p = [Text] -> s -> Parser r
go [] s
s0
 where
  scanner :: s -> Int -> Text -> Scan s
scanner s
s !Int
n Text
t =
    case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
c,Text
t') -> case s -> Char -> Maybe s
p s
s Char
c of
                       Just s
s' -> s -> Int -> Text -> Scan s
scanner s
s' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Text
t'
                       Maybe s
Nothing -> s -> Int -> Text -> Scan s
forall s. s -> Int -> Text -> Scan s
Finished s
s Int
n Text
t
      Maybe (Char, Text)
Nothing     -> s -> Scan s
forall s. s -> Scan s
Continue s
s
  go :: [Text] -> s -> Parser r
go [Text]
acc s
s = do
    input <- Parser Text
get
    case scanner s 0 input of
      Continue s
s'  -> do continue <- DirPos 'Forward -> Parser Bool
inputSpansChunks (Text -> DirPos 'Forward
size Text
input)
                         if continue
                           then go (input : acc) s'
                           else f s' (input : acc)
      Finished s
s' Int
n Text
t -> do DirPos 'Forward -> Parser ()
advance (Text -> DirPos 'Forward
size Text
input DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
- Text -> DirPos 'Forward
size Text
t)
                            s -> [Text] -> Parser r
f s
s' (Int -> Text -> Text
T.take Int
n Text
input Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
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 character 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 character 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 :: s -> (s -> Char -> Maybe s) -> Parser Text
scan :: forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan = (s -> [Text] -> Parser Text)
-> s -> (s -> Char -> Maybe s) -> Parser Text
forall s r.
(s -> [Text] -> Parser r)
-> s -> (s -> Char -> Maybe s) -> Parser r
scan_ ((s -> [Text] -> Parser Text)
 -> s -> (s -> Char -> Maybe s) -> Parser Text)
-> (s -> [Text] -> Parser Text)
-> s
-> (s -> Char -> Maybe s)
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \s
_ [Text]
chunks -> Text -> Parser Text
forall a. a -> DirParser 'Forward Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
forall m. Monoid m => [m] -> m
concatReverse [Text]
chunks
{-# INLINE scan #-}

-- | Like 'scan', but generalized to return the final state of the
-- scanner.
runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner :: forall s. s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner = (s -> [Text] -> Parser (Text, s))
-> s -> (s -> Char -> Maybe s) -> Parser (Text, s)
forall s r.
(s -> [Text] -> Parser r)
-> s -> (s -> Char -> Maybe s) -> Parser r
scan_ ((s -> [Text] -> Parser (Text, s))
 -> s -> (s -> Char -> Maybe s) -> Parser (Text, s))
-> (s -> [Text] -> Parser (Text, s))
-> s
-> (s -> Char -> Maybe s)
-> Parser (Text, s)
forall a b. (a -> b) -> a -> b
$ \s
s [Text]
xs -> let !sx :: Text
sx = [Text] -> Text
forall m. Monoid m => [m] -> m
concatReverse [Text]
xs in (Text, s) -> Parser (Text, s)
forall a. a -> DirParser 'Forward Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
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
-- character of input: it will fail if the predicate never returns
-- 'True' or if there is no input left.
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
p = do
  (Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` Parser ()
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t ()
demandInput) (Bool -> Parser ()) -> Parser Bool -> Parser ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Bool
endOfChunk
  h <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
  let size' = Text -> DirPos 'Forward
size Text
h
  when (size' == 0) $ fail "takeWhile1"
  advance size'
  eoc <- endOfChunk
  if eoc
    then takeWhileAcc p [h]
    else return h
{-# INLINE takeWhile1 #-}

-- | Match any character 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 -> Char -> Bool
inClass :: [Char] -> Char -> Bool
inClass [Char]
s = (Char -> FastSet -> Bool
`Set.member` FastSet
mySet)
    where mySet :: FastSet
mySet = [Char] -> FastSet
Set.charClass [Char]
s
          {-# NOINLINE mySet #-}
{-# INLINE inClass #-}

-- | Match any character not in a set.
notInClass :: String -> Char -> Bool
notInClass :: [Char] -> Char -> Bool
notInClass [Char]
s = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Char -> Bool
inClass [Char]
s
{-# INLINE notInClass #-}

-- | Match any character.
anyChar :: Parser Char
anyChar :: Parser Char
anyChar = (Char -> Bool) -> Parser Char
satisfy ((Char -> Bool) -> Parser Char) -> (Char -> Bool) -> Parser Char
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True
{-# INLINE anyChar #-}

-- | Match a specific character.
char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
c = (Char -> Bool) -> Parser Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Parser Char -> [Char] -> Parser Char
forall (d :: Dir) i a. DirParser d i a -> [Char] -> DirParser d i a
<?> Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c
{-# INLINE char #-}

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

-- | Match any character, 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.
peekChar :: Parser (Maybe Char)
peekChar :: Parser (Maybe Char)
peekChar = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
 -> IResult Text r)
-> Parser (Maybe Char)
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
  -> IResult Text r)
 -> Parser (Maybe Char))
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
    -> IResult Text r)
-> Parser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
_lose DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
succ ->
  case () of
    ()
_| DirPos 'Forward
pos DirPos 'Forward -> DirPos 'Forward -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> DirPos 'Forward
lengthOf Buffer
DirState 'Forward Text
t ->
       let T.Iter !Char
c Int
_ = Buffer -> Int -> Iter
Buf.iter Buffer
DirState 'Forward Text
t (DirPos 'Forward -> Int
forall (d :: Dir). DirPos d -> Int
fromPos DirPos 'Forward
pos)
       in DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)
     | More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete ->
       DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more Maybe Char
forall a. Maybe a
Nothing
     | Bool
otherwise ->
       let succ' :: Buffer -> DirPos 'Forward -> More -> IResult Text r
succ' Buffer
t' DirPos 'Forward
pos' More
more' =
             let T.Iter !Char
c Int
_ = Buffer -> Int -> Iter
Buf.iter Buffer
t' (DirPos 'Forward -> Int
forall (d :: Dir). DirPos d -> Int
fromPos DirPos 'Forward
pos')
             in DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
succ Buffer
DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)
           lose' :: Buffer -> DirPos 'Forward -> More -> IResult Text r
lose' Buffer
t' DirPos 'Forward
pos' More
more' = DirSuccess 'Forward Text (DirState 'Forward Text) (Maybe Char) r
succ Buffer
DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' Maybe Char
forall a. Maybe a
Nothing
       in DirState 'Forward Text
-> DirPos 'Forward
-> More
-> (DirState 'Forward Text
    -> DirPos 'Forward -> More -> IResult Text r)
-> (DirState 'Forward Text
    -> DirPos 'Forward -> More -> IResult Text r)
-> IResult Text 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 'Forward Text
t DirPos 'Forward
pos More
more Buffer -> DirPos 'Forward -> More -> IResult Text r
DirState 'Forward Text -> DirPos 'Forward -> More -> IResult Text r
lose' Buffer -> DirPos 'Forward -> More -> IResult Text r
DirState 'Forward Text -> DirPos 'Forward -> More -> IResult Text r
succ'
{-# INLINE peekChar #-}

-- | Match any character, to perform lookahead.  Does not consume any
-- input, but will fail if end of input has been reached.
peekChar' :: Parser Char
peekChar' :: Parser Char
peekChar' = do
  (_,s) <- Int -> Parser (DirPos 'Forward, Text)
ensure Int
1
  return $! T.unsafeHead s
{-# INLINE peekChar' #-}

-- | Match either a single newline character @\'\\n\'@, or a carriage
-- return followed by a newline character @\"\\r\\n\"@.
endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = (Char -> Parser Char
char Char
'\n' Parser Char -> Parser () -> Parser ()
forall a b.
DirParser 'Forward Text a
-> DirParser 'Forward Text b -> DirParser 'Forward Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall a. a -> DirParser 'Forward Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser () -> Parser () -> Parser ()
forall a.
DirParser 'Forward Text a
-> DirParser 'Forward Text a -> DirParser 'Forward Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text
string Text
"\r\n" Parser Text -> Parser () -> Parser ()
forall a b.
DirParser 'Forward Text a
-> DirParser 'Forward Text b -> DirParser 'Forward Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall a. a -> DirParser 'Forward Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Terminal failure continuation.
failK :: Failure a
failK :: forall a. Failure a
failK Buffer
t (Pos Int
pos) More
_more [[Char]]
stack [Char]
msg = Text -> [[Char]] -> [Char] -> IResult Text a
forall i r. i -> [[Char]] -> [Char] -> IResult i r
Fail (Int -> Buffer -> Text
Buf.dropCodeUnits Int
pos Buffer
t) [[Char]]
stack [Char]
msg
{-# INLINE failK #-}

-- | Terminal success continuation.
successK :: Success a a
successK :: forall a. Success a a
successK Buffer
t (Pos Int
pos) More
_more a
a = Text -> a -> IResult Text a
forall i r. i -> r -> IResult i r
Done (Int -> Buffer -> Text
Buf.dropCodeUnits Int
pos Buffer
t) a
a
{-# INLINE successK #-}

-- | Run a parser.
parse :: Parser a -> Text -> Result a
parse :: forall a. Parser a -> Text -> Result a
parse Parser a
m Text
s = Parser a
-> forall r.
   DirState 'Forward Text
   -> DirPos 'Forward
   -> More
   -> DirFailure 'Forward Text (DirState 'Forward Text) r
   -> DirSuccess 'Forward Text (DirState 'Forward Text) a r
   -> IResult Text 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 Parser a
m (Text -> Buffer
buffer Text
s) DirPos 'Forward
0 More
Incomplete Failure a
DirFailure 'Forward Text (DirState 'Forward Text) a
forall a. Failure a
failK Success a a
DirSuccess 'Forward Text (DirState 'Forward Text) a a
forall a. Success a a
successK
{-# INLINE parse #-}

-- | 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 -> Text -> Either String a
parseOnly :: forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser a
m Text
s = case Parser a
-> forall r.
   DirState 'Forward Text
   -> DirPos 'Forward
   -> More
   -> DirFailure 'Forward Text (DirState 'Forward Text) r
   -> DirSuccess 'Forward Text (DirState 'Forward Text) a r
   -> IResult Text 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 Parser a
m (Text -> Buffer
buffer Text
s) DirPos 'Forward
0 More
Complete Failure a
DirFailure 'Forward Text (DirState 'Forward Text) a
forall a. Failure a
failK Success a a
DirSuccess 'Forward Text (DirState 'Forward Text) a a
forall a. Success a a
successK of
                  Fail Text
_ [] [Char]
err   -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
err
                  Fail Text
_ [[Char]]
ctxs [Char]
err -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" > " [[Char]]
ctxs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err)
                  Done Text
_ a
a        -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
a
                  IResult Text a
_               -> [Char] -> Either [Char] a
forall a. HasCallStack => [Char] -> a
error [Char]
"parseOnly: impossible error!"
{-# INLINE parseOnly #-}

get :: Parser Text
get :: Parser Text
get = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
 -> IResult Text r)
-> Parser Text
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
  -> IResult Text r)
 -> Parser Text)
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) Text r
    -> IResult Text r)
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
_lose DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ ->
  DirSuccess 'Forward Text (DirState 'Forward Text) Text r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more (Int -> Buffer -> Text
Buf.dropCodeUnits (DirPos 'Forward -> Int
forall (d :: Dir). DirPos d -> Int
fromPos DirPos 'Forward
pos) Buffer
DirState 'Forward Text
t)
{-# INLINE get #-}

endOfChunk :: Parser Bool
endOfChunk :: Parser Bool
endOfChunk = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
 -> IResult Text r)
-> Parser 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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
  -> IResult Text r)
 -> Parser Bool)
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
    -> IResult Text r)
-> Parser Bool
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
_lose DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
succ ->
  DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more (DirPos 'Forward
pos DirPos 'Forward -> DirPos 'Forward -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer -> DirPos 'Forward
lengthOf Buffer
DirState 'Forward Text
t)
{-# INLINE endOfChunk #-}

inputSpansChunks :: Pos -> Parser Bool
inputSpansChunks :: DirPos 'Forward -> Parser Bool
inputSpansChunks DirPos 'Forward
i = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
 -> IResult Text r)
-> Parser 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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
  -> IResult Text r)
 -> Parser Bool)
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
    -> IResult Text r)
-> Parser Bool
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos_ More
more DirFailure 'Forward Text (DirState 'Forward Text) r
_lose DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
succ ->
  let pos :: DirPos 'Forward
pos = DirPos 'Forward
pos_ DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
+ DirPos 'Forward
i
  in if DirPos 'Forward
pos DirPos 'Forward -> DirPos 'Forward -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> DirPos 'Forward
lengthOf Buffer
DirState 'Forward Text
t Bool -> Bool -> Bool
|| More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete
     then DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more Bool
False
     else let lose' :: Buffer -> DirPos 'Forward -> More -> IResult Text r
lose' Buffer
t' DirPos 'Forward
pos' More
more' = DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
succ Buffer
DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' Bool
False
              succ' :: Buffer -> DirPos 'Forward -> More -> IResult Text r
succ' Buffer
t' DirPos 'Forward
pos' More
more' = DirSuccess 'Forward Text (DirState 'Forward Text) Bool r
succ Buffer
DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' Bool
True
          in DirState 'Forward Text
-> DirPos 'Forward
-> More
-> (DirState 'Forward Text
    -> DirPos 'Forward -> More -> IResult Text r)
-> (DirState 'Forward Text
    -> DirPos 'Forward -> More -> IResult Text r)
-> IResult Text 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 'Forward Text
t DirPos 'Forward
pos More
more Buffer -> DirPos 'Forward -> More -> IResult Text r
DirState 'Forward Text -> DirPos 'Forward -> More -> IResult Text r
lose' Buffer -> DirPos 'Forward -> More -> IResult Text r
DirState 'Forward Text -> DirPos 'Forward -> More -> IResult Text r
succ'
{-# INLINE inputSpansChunks #-}

advance :: Pos -> Parser ()
advance :: DirPos 'Forward -> Parser ()
advance DirPos 'Forward
n = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) () r
 -> IResult Text r)
-> Parser ()
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) () r
  -> IResult Text r)
 -> Parser ())
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) () r
    -> IResult Text r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
_lose DirSuccess 'Forward Text (DirState 'Forward Text) () r
succ -> DirSuccess 'Forward Text (DirState 'Forward Text) () r
succ DirState 'Forward Text
t (DirPos 'Forward
posDirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
+DirPos 'Forward
n) More
more ()
{-# INLINE advance #-}

ensureSuspended :: Int -> Buffer -> Pos -> More
                -> Failure r -> Success (Pos, Text) r
                -> Result r
ensureSuspended :: forall r.
Int
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success (DirPos 'Forward, Text) r
-> Result r
ensureSuspended Int
n Buffer
t DirPos 'Forward
pos More
more Failure r
lose Success (DirPos 'Forward, Text) r
succ =
    Parser (DirPos 'Forward, Text)
-> forall r.
   DirState 'Forward Text
   -> DirPos 'Forward
   -> More
   -> DirFailure 'Forward Text (DirState 'Forward Text) r
   -> DirSuccess
        'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
   -> IResult Text 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 (Parser ()
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t ()
demandInput Parser ()
-> Parser (DirPos 'Forward, Text) -> Parser (DirPos 'Forward, Text)
forall a b.
DirParser 'Forward Text a
-> DirParser 'Forward Text b -> DirParser 'Forward Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (DirPos 'Forward, Text)
go) Buffer
DirState 'Forward Text
t DirPos 'Forward
pos More
more Failure r
DirFailure 'Forward Text (DirState 'Forward Text) r
lose Success (DirPos 'Forward, Text) r
DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
succ
  where go :: Parser (DirPos 'Forward, Text)
go = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess
      'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
 -> IResult Text r)
-> Parser (DirPos 'Forward, Text)
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess
       'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
  -> IResult Text r)
 -> Parser (DirPos 'Forward, Text))
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess
         'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
    -> IResult Text r)
-> Parser (DirPos 'Forward, Text)
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' DirFailure 'Forward Text (DirState 'Forward Text) r
lose' DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
succ' ->
          case DirPos 'Forward -> Int -> Buffer -> Maybe (DirPos 'Forward)
lengthAtLeast DirPos 'Forward
pos' Int
n Buffer
DirState 'Forward Text
t' of
            Just DirPos 'Forward
n' -> DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
succ' DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' (DirPos 'Forward
n', DirPos 'Forward -> DirPos 'Forward -> Buffer -> Text
substring DirPos 'Forward
pos DirPos 'Forward
n' Buffer
DirState 'Forward Text
t')
            Maybe (DirPos 'Forward)
Nothing -> Parser (DirPos 'Forward, Text)
-> forall r.
   DirState 'Forward Text
   -> DirPos 'Forward
   -> More
   -> DirFailure 'Forward Text (DirState 'Forward Text) r
   -> DirSuccess
        'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
   -> IResult Text 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 (Parser ()
forall t (d :: Dir). (Show t, DirChunk d t) => DirParser d t ()
demandInput Parser ()
-> Parser (DirPos 'Forward, Text) -> Parser (DirPos 'Forward, Text)
forall a b.
DirParser 'Forward Text a
-> DirParser 'Forward Text b -> DirParser 'Forward Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (DirPos 'Forward, Text)
go) DirState 'Forward Text
t' DirPos 'Forward
pos' More
more' DirFailure 'Forward Text (DirState 'Forward Text) r
lose' DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
succ'

-- | If at least @n@ elements of input are available, return the
-- current input, otherwise fail.
ensure :: Int -> Parser (Pos, Text)
ensure :: Int -> Parser (DirPos 'Forward, Text)
ensure Int
n = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess
      'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
 -> IResult Text r)
-> Parser (DirPos 'Forward, Text)
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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess
       'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
  -> IResult Text r)
 -> Parser (DirPos 'Forward, Text))
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess
         'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
    -> IResult Text r)
-> Parser (DirPos 'Forward, Text)
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
succ ->
    case DirPos 'Forward -> Int -> Buffer -> Maybe (DirPos 'Forward)
lengthAtLeast DirPos 'Forward
pos Int
n Buffer
DirState 'Forward Text
t of
      Just DirPos 'Forward
n' -> DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) r
succ DirState 'Forward Text
t DirPos 'Forward
pos More
more (DirPos 'Forward
n', DirPos 'Forward -> DirPos 'Forward -> Buffer -> Text
substring DirPos 'Forward
pos DirPos 'Forward
n' Buffer
DirState 'Forward Text
t)
      -- The uncommon case is kept out-of-line to reduce code size:
      Maybe (DirPos 'Forward)
Nothing -> Int
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success (DirPos 'Forward, Text) r
-> IResult Text r
forall r.
Int
-> Buffer
-> DirPos 'Forward
-> More
-> Failure r
-> Success (DirPos 'Forward, Text) r
-> Result r
ensureSuspended Int
n Buffer
DirState 'Forward Text
t DirPos 'Forward
pos More
more Failure r
DirFailure 'Forward Text (DirState 'Forward Text) r
lose Success (DirPos 'Forward, Text) r
DirSuccess
  'Forward Text (DirState 'Forward Text) (DirPos 'Forward, Text) 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 :: Parser a -> Parser (Text, a)
match :: forall a. Parser a -> Parser (Text, a)
match Parser a
p = (forall r.
 DirState 'Forward Text
 -> DirPos 'Forward
 -> More
 -> DirFailure 'Forward Text (DirState 'Forward Text) r
 -> DirSuccess 'Forward Text (DirState 'Forward Text) (Text, a) r
 -> IResult Text r)
-> DirParser 'Forward Text (Text, 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 'Forward Text
  -> DirPos 'Forward
  -> More
  -> DirFailure 'Forward Text (DirState 'Forward Text) r
  -> DirSuccess 'Forward Text (DirState 'Forward Text) (Text, a) r
  -> IResult Text r)
 -> DirParser 'Forward Text (Text, a))
-> (forall r.
    DirState 'Forward Text
    -> DirPos 'Forward
    -> More
    -> DirFailure 'Forward Text (DirState 'Forward Text) r
    -> DirSuccess 'Forward Text (DirState 'Forward Text) (Text, a) r
    -> IResult Text r)
-> DirParser 'Forward Text (Text, a)
forall a b. (a -> b) -> a -> b
$ \DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
lose DirSuccess 'Forward Text (DirState 'Forward Text) (Text, a) r
succ ->
  let succ' :: Buffer -> DirPos 'Forward -> More -> a -> IResult Text r
succ' Buffer
t' DirPos 'Forward
pos' More
more' a
a = DirSuccess 'Forward Text (DirState 'Forward Text) (Text, a) r
succ Buffer
DirState 'Forward Text
t' DirPos 'Forward
pos' More
more'
                              (DirPos 'Forward -> DirPos 'Forward -> Buffer -> Text
substring DirPos 'Forward
pos (DirPos 'Forward
pos'DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
-DirPos 'Forward
pos) Buffer
t', a
a)
  in Parser a
-> forall r.
   DirState 'Forward Text
   -> DirPos 'Forward
   -> More
   -> DirFailure 'Forward Text (DirState 'Forward Text) r
   -> DirSuccess 'Forward Text (DirState 'Forward Text) a r
   -> IResult Text 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 Parser a
p DirState 'Forward Text
t DirPos 'Forward
pos More
more DirFailure 'Forward Text (DirState 'Forward Text) r
lose Buffer -> DirPos 'Forward -> More -> a -> IResult Text r
DirSuccess 'Forward Text (DirState 'Forward Text) a r
succ'

-- | Ensure that at least @n@ code points of input are available.
-- Returns the number of words consumed while traversing.
lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
lengthAtLeast :: DirPos 'Forward -> Int -> Buffer -> Maybe (DirPos 'Forward)
lengthAtLeast DirPos 'Forward
pos Int
n Buffer
t = Int -> Int -> Maybe (DirPos 'Forward)
go Int
0 (DirPos 'Forward -> Int
forall (d :: Dir). DirPos d -> Int
fromPos DirPos 'Forward
pos)
  where go :: Int -> Int -> Maybe (DirPos 'Forward)
go Int
i !Int
p
          | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n    = DirPos 'Forward -> Maybe (DirPos 'Forward)
forall a. a -> Maybe a
Just (Int -> DirPos 'Forward
forall (d :: Dir). Int -> DirPos d
Pos Int
p DirPos 'Forward -> DirPos 'Forward -> DirPos 'Forward
forall a. Num a => a -> a -> a
- DirPos 'Forward
pos)
          | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len  = Maybe (DirPos 'Forward)
forall a. Maybe a
Nothing
          | Bool
otherwise = Int -> Int -> Maybe (DirPos 'Forward)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Buffer -> Int -> Int
Buf.iter_ Buffer
t Int
p)
        Pos Int
len = Buffer -> DirPos 'Forward
lengthOf Buffer
t
{-# INLINE lengthAtLeast #-}

substring :: Pos -> Pos -> Buffer -> Text
substring :: DirPos 'Forward -> DirPos 'Forward -> Buffer -> Text
substring (Pos Int
pos) (Pos Int
n) = Int -> Int -> Buffer -> Text
Buf.substring Int
pos Int
n
{-# INLINE substring #-}

lengthOf :: Buffer -> Pos
lengthOf :: Buffer -> DirPos 'Forward
lengthOf = Int -> DirPos 'Forward
forall (d :: Dir). Int -> DirPos d
Pos (Int -> DirPos 'Forward)
-> (Buffer -> Int) -> Buffer -> DirPos 'Forward
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
Buf.length

size :: Text -> Pos
size :: Text -> DirPos 'Forward
size (Text Array
_ Int
_ Int
l) = Int -> DirPos 'Forward
forall (d :: Dir). Int -> DirPos d
Pos Int
l