{-# LANGUAGE BangPatterns, FlexibleInstances, GADTs, OverloadedStrings,
    Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      :  Data.Attoparsec.Text.Internal
-- Copyright   :  Bryan O'Sullivan 2007-2015
-- License     :  BSD3
--
-- Maintainer  :  [email protected]
-- 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 ((<|>), (<$>), pure, (*>))
import Control.Monad (when)
import Data.Attoparsec.Combinator ((<?>))
import Data.Attoparsec.Internal
import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
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 Text
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- | 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
  (Pos
k,Text
c) <- Int -> Parser (Pos, Text)
ensure Int
1
  let !h :: Char
h = Text -> Char
T.unsafeHead Text
c
  if Char -> Bool
p Char
h
    then Pos -> Parser ()
advance Pos
k forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
h
    else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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
  (Pos
k,Text
s) <- Int -> Parser (Pos, Text)
ensure Int
1
  if Char -> Bool
p (Text -> Char
T.unsafeHead Text
s)
    then Pos -> Parser ()
advance Pos
k
    else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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
  (Pos
k,Text
s) <- Int -> Parser (Pos, Text)
ensure Int
1
  let c :: a
c = Char -> a
f forall a b. (a -> b) -> a -> b
$! Text -> Char
T.unsafeHead Text
s
  if a -> Bool
p a
c
    then Pos -> Parser ()
advance Pos
k forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
c
    else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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
  (Pos
k,Text
s) <- Int -> Parser (Pos, Text)
ensure Int
n
  if Text -> Bool
p Text
s
    then Pos -> Parser ()
advance Pos
k forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
    else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"takeWith"

-- | Consume exactly @n@ characters of input.
take :: Int -> Parser Text
take :: Int -> Parser Text
take Int
n = Int -> (Text -> Bool) -> Parser Text
takeWith (forall a. Ord a => a -> a -> a
max Int
n Int
0) (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
 -> Pos
 -> More
 -> Failure r
 -> Success Text r
 -> Result r)
-> (Text -> Text) -> Text -> Parser Text
string_ (forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended forall a. a -> a
id) 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
 -> Pos
 -> More
 -> Failure r
 -> Success Text r
 -> Result r)
-> (Text -> Text) -> Text -> Parser Text
string_ forall r.
Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text -> Text
f Text
s0 = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State Text) Text r
succ ->
  let s :: Text
s  = Text -> Text
f Text
s0
      ft :: Text
ft = Text -> Text
f (Int -> Buffer -> Text
Buf.unbufferAt (Pos -> Int
fromPos Pos
pos) State 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          -> Success Text (State Text) Text r
succ State Text
t Pos
pos More
more Text
T.empty
         | Text -> Bool
T.null Text
ft         -> forall r.
Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text
s Text
s State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State Text) Text r
succ
         | Bool
otherwise         -> Failure Text (State Text) r
lose State Text
t Pos
pos More
more [] [Char]
"string"
       Just (Text
pfx,Text
ssfx,Text
tsfx)
         | Text -> Bool
T.null Text
ssfx       -> let l :: Pos
l = Int -> Pos
Pos (Text -> Int
Buf.lengthCodeUnits Text
pfx)
                                in Success Text (State Text) Text r
succ State Text
t (Pos
pos forall a. Num a => a -> a -> a
+ Pos
l) More
more (Pos -> Pos -> Buffer -> Text
substring Pos
pos Pos
l State Text
t)
         | Bool -> Bool
not (Text -> Bool
T.null Text
tsfx) -> Failure Text (State Text) r
lose State Text
t Pos
pos More
more [] [Char]
"string"
         | Bool
otherwise         -> forall r.
Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text
s Text
ssfx State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State 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
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended Text -> Text
f Text
s000 Text
s0 Buffer
t0 Pos
pos0 More
more0 Failure r
lose0 Success Text r
succ0 =
    forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser (forall t. Chunk t => Parser t t
demandInput_ forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
go) Buffer
t0 Pos
pos0 More
more0 Failure r
lose0 Success Text r
succ0
  where
    go :: Text -> Parser Text
go Text
s' = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State 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         -> Failure Text (State Text) r
lose State Text
t Pos
pos More
more [] [Char]
"string"
        Just (Text
_pfx,Text
ssfx,Text
tsfx)
          | Text -> Bool
T.null Text
ssfx -> let l :: Pos
l = Int -> Pos
Pos (Text -> Int
Buf.lengthCodeUnits Text
s000)
                           in Success Text (State Text) Text r
succ State Text
t (Pos
pos forall a. Num a => a -> a -> a
+ Pos
l) More
more (Pos -> Pos -> Buffer -> Text
substring Pos
pos Pos
l State Text
t)
          | Text -> Bool
T.null Text
tsfx -> forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended Text -> Text
f Text
s000 Text
ssfx State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State Text) Text r
succ
          | Bool
otherwise   -> Failure Text (State Text) r
lose State Text
t Pos
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 forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
fs = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"stringCI"
      | Bool
otherwise = do
      (Pos
k,Text
t) <- Int -> Parser (Pos, Text)
ensure Int
n
      if Text -> Text
T.toCaseFold Text
t forall a. Eq a => a -> a -> Bool
== Text
fs
        then Pos -> Parser ()
advance Pos
k forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
        else Int -> Parser Text
go (Int
nforall a. Num a => a -> a -> a
+Int
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser (Text, a)
match forall a b. (a -> b) -> a -> b
$ forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser Char
asciiCharCI) (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 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 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
    Text
t <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
    Bool
continue <- Pos -> Parser Bool
inputSpansChunks (Text -> Pos
size Text
t)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue Parser ()
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 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
    Text
h <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
    Bool
continue <- Pos -> Parser Bool
inputSpansChunks (Text -> Pos
size Text
h)
    -- only use slow concat path if necessary
    if Bool
continue
      then (Char -> Bool) -> [Text] -> Parser Text
takeWhileAcc Char -> Bool
p [Text
h]
      else forall (m :: * -> *) a. Monad m => a -> m a
return Text
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
    Text
h <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
    Bool
continue <- Pos -> Parser Bool
inputSpansChunks (Text -> Pos
size Text
h)
    if Bool
continue
      then [Text] -> Parser Text
go (Text
hforall a. a -> [a] -> [a]
:[Text]
acc)
      else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => [m] -> m
concatReverse (Text
hforall a. a -> [a] -> [a]
:[Text]
acc)
{-# INLINE takeWhileAcc #-}

takeRest :: Parser [Text]
takeRest :: Parser [Text]
takeRest = [Text] -> Parser [Text]
go []
 where
  go :: [Text] -> Parser [Text]
go [Text]
acc = do
    Bool
input <- forall t. Chunk t => Parser t Bool
wantInput
    if Bool
input
      then do
        Text
s <- Parser Text
get
        Pos -> Parser ()
advance (Text -> Pos
size Text
s)
        [Text] -> Parser [Text]
go (Text
sforall a. a -> [a] -> [a]
:[Text]
acc)
      else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Text]
acc)

-- | Consume all remaining input and return it as a single string.
takeText :: Parser Text
takeText :: Parser Text
takeText = [Text] -> Text
T.concat 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 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
nforall a. Num a => a -> a -> a
+Int
1) Text
t'
                       Maybe s
Nothing -> forall s. s -> Int -> Text -> Scan s
Finished s
s Int
n Text
t
      Maybe (Char, Text)
Nothing     -> forall s. s -> Scan s
Continue s
s
  go :: [Text] -> s -> Parser r
go [Text]
acc s
s = do
    Text
input <- Parser Text
get
    case s -> Int -> Text -> Scan s
scanner s
s Int
0 Text
input of
      Continue s
s'  -> do Bool
continue <- Pos -> Parser Bool
inputSpansChunks (Text -> Pos
size Text
input)
                         if Bool
continue
                           then [Text] -> s -> Parser r
go (Text
input forall a. a -> [a] -> [a]
: [Text]
acc) s
s'
                           else s -> [Text] -> Parser r
f s
s' (Text
input forall a. a -> [a] -> [a]
: [Text]
acc)
      Finished s
s' Int
n Text
t -> do Pos -> Parser ()
advance (Text -> Pos
size Text
input forall a. Num a => a -> a -> a
- Text -> Pos
size Text
t)
                            s -> [Text] -> Parser r
f s
s' (Int -> Text -> Text
T.take Int
n Text
input 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 = forall s r.
(s -> [Text] -> Parser r)
-> s -> (s -> Char -> Maybe s) -> Parser r
scan_ forall a b. (a -> b) -> a -> b
$ \s
_ [Text]
chunks -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 = forall s r.
(s -> [Text] -> Parser r)
-> s -> (s -> Char -> Maybe s) -> Parser r
scan_ forall a b. (a -> b) -> a -> b
$ \s
s [Text]
xs -> let !sx :: Text
sx = forall m. Monoid m => [m] -> m
concatReverse [Text]
xs in 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
  (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` forall t. Chunk t => Parser t ()
demandInput) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Bool
endOfChunk
  Text
h <- (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
  let size' :: Pos
size' = Text -> Pos
size Text
h
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Pos
size' forall a. Eq a => a -> a -> Bool
== Pos
0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"takeWhile1"
  Pos -> Parser ()
advance Pos
size'
  Bool
eoc <- Parser Bool
endOfChunk
  if Bool
eoc
    then (Char -> Bool) -> [Text] -> Parser Text
takeWhileAcc Char -> Bool
p [Text
h]
    else forall (m :: * -> *) a. Monad m => a -> m a
return Text
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 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 forall a b. (a -> b) -> a -> b
$ 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 (forall a. Eq a => a -> a -> Bool
== Char
c) forall i a. Parser i a -> [Char] -> Parser i a
<?> 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 (forall a. Eq a => a -> a -> Bool
/= Char
c) forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"not " forall a. [a] -> [a] -> [a]
++ 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 i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
_lose Success Text (State Text) (Maybe Char) r
succ ->
  case () of
    ()
_| Pos
pos forall a. Ord a => a -> a -> Bool
< Buffer -> Pos
lengthOf State Text
t ->
       let T.Iter !Char
c Int
_ = Buffer -> Int -> Iter
Buf.iter State Text
t (Pos -> Int
fromPos Pos
pos)
       in Success Text (State Text) (Maybe Char) r
succ State Text
t Pos
pos More
more (forall a. a -> Maybe a
Just Char
c)
     | More
more forall a. Eq a => a -> a -> Bool
== More
Complete ->
       Success Text (State Text) (Maybe Char) r
succ State Text
t Pos
pos More
more forall a. Maybe a
Nothing
     | Bool
otherwise ->
       let succ' :: Buffer -> Pos -> More -> IResult Text r
succ' Buffer
t' Pos
pos' More
more' =
             let T.Iter !Char
c Int
_ = Buffer -> Int -> Iter
Buf.iter Buffer
t' (Pos -> Int
fromPos Pos
pos')
             in Success Text (State Text) (Maybe Char) r
succ Buffer
t' Pos
pos' More
more' (forall a. a -> Maybe a
Just Char
c)
           lose' :: Buffer -> Pos -> More -> IResult Text r
lose' Buffer
t' Pos
pos' More
more' = Success Text (State Text) (Maybe Char) r
succ Buffer
t' Pos
pos' More
more' forall a. Maybe a
Nothing
       in forall t r.
Chunk t =>
State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State Text
t Pos
pos More
more Buffer -> Pos -> More -> IResult Text r
lose' Buffer -> Pos -> 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
  (Pos
_,Text
s) <- Int -> Parser (Pos, Text)
ensure Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text -> Char
T.unsafeHead Text
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' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text
string Text
"\r\n" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = 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 = 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 = forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser Parser a
m (Text -> Buffer
buffer Text
s) Pos
0 More
Incomplete forall a. Failure a
failK 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 forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser Parser a
m (Text -> Buffer
buffer Text
s) Pos
0 More
Complete forall a. Failure a
failK forall a. Success a a
successK of
                  Fail Text
_ [] [Char]
err   -> forall a b. a -> Either a b
Left [Char]
err
                  Fail Text
_ [[Char]]
ctxs [Char]
err -> forall a b. a -> Either a b
Left (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" > " [[Char]]
ctxs forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
err)
                  Done Text
_ a
a        -> forall a b. b -> Either a b
Right a
a
                  IResult Text a
_               -> forall a. HasCallStack => [Char] -> a
error [Char]
"parseOnly: impossible error!"
{-# INLINE parseOnly #-}

get :: Parser Text
get :: Parser Text
get = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
_lose Success Text (State Text) Text r
succ ->
  Success Text (State Text) Text r
succ State Text
t Pos
pos More
more (Int -> Buffer -> Text
Buf.dropCodeUnits (Pos -> Int
fromPos Pos
pos) State Text
t)
{-# INLINE get #-}

endOfChunk :: Parser Bool
endOfChunk :: Parser Bool
endOfChunk = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
_lose Success Text (State Text) Bool r
succ ->
  Success Text (State Text) Bool r
succ State Text
t Pos
pos More
more (Pos
pos forall a. Eq a => a -> a -> Bool
== Buffer -> Pos
lengthOf State Text
t)
{-# INLINE endOfChunk #-}

inputSpansChunks :: Pos -> Parser Bool
inputSpansChunks :: Pos -> Parser Bool
inputSpansChunks Pos
i = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos_ More
more Failure Text (State Text) r
_lose Success Text (State Text) Bool r
succ ->
  let pos :: Pos
pos = Pos
pos_ forall a. Num a => a -> a -> a
+ Pos
i
  in if Pos
pos forall a. Ord a => a -> a -> Bool
< Buffer -> Pos
lengthOf State Text
t Bool -> Bool -> Bool
|| More
more forall a. Eq a => a -> a -> Bool
== More
Complete
     then Success Text (State Text) Bool r
succ State Text
t Pos
pos More
more Bool
False
     else let lose' :: Buffer -> Pos -> More -> IResult Text r
lose' Buffer
t' Pos
pos' More
more' = Success Text (State Text) Bool r
succ Buffer
t' Pos
pos' More
more' Bool
False
              succ' :: Buffer -> Pos -> More -> IResult Text r
succ' Buffer
t' Pos
pos' More
more' = Success Text (State Text) Bool r
succ Buffer
t' Pos
pos' More
more' Bool
True
          in forall t r.
Chunk t =>
State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State Text
t Pos
pos More
more Buffer -> Pos -> More -> IResult Text r
lose' Buffer -> Pos -> More -> IResult Text r
succ'
{-# INLINE inputSpansChunks #-}

advance :: Pos -> Parser ()
advance :: Pos -> Parser ()
advance Pos
n = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
_lose Success Text (State Text) () r
succ -> Success Text (State Text) () r
succ State Text
t (Pos
posforall a. Num a => a -> a -> a
+Pos
n) More
more ()
{-# INLINE advance #-}

ensureSuspended :: Int -> Buffer -> Pos -> More
                -> Failure r -> Success (Pos, Text) r
                -> Result r
ensureSuspended :: forall r.
Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success (Pos, Text) r
-> Result r
ensureSuspended Int
n Buffer
t Pos
pos More
more Failure r
lose Success (Pos, Text) r
succ =
    forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser (forall t. Chunk t => Parser t ()
demandInput forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Pos, Text)
go) Buffer
t Pos
pos More
more Failure r
lose Success (Pos, Text) r
succ
  where go :: Parser (Pos, Text)
go = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t' Pos
pos' More
more' Failure Text (State Text) r
lose' Success Text (State Text) (Pos, Text) r
succ' ->
          case Pos -> Int -> Buffer -> Maybe Pos
lengthAtLeast Pos
pos' Int
n State Text
t' of
            Just Pos
n' -> Success Text (State Text) (Pos, Text) r
succ' State Text
t' Pos
pos' More
more' (Pos
n', Pos -> Pos -> Buffer -> Text
substring Pos
pos Pos
n' State Text
t')
            Maybe Pos
Nothing -> forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser (forall t. Chunk t => Parser t ()
demandInput forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Pos, Text)
go) State Text
t' Pos
pos' More
more' Failure Text (State Text) r
lose' Success Text (State Text) (Pos, 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 (Pos, Text)
ensure Int
n = forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State Text) (Pos, Text) r
succ ->
    case Pos -> Int -> Buffer -> Maybe Pos
lengthAtLeast Pos
pos Int
n State Text
t of
      Just Pos
n' -> Success Text (State Text) (Pos, Text) r
succ State Text
t Pos
pos More
more (Pos
n', Pos -> Pos -> Buffer -> Text
substring Pos
pos Pos
n' State Text
t)
      -- The uncommon case is kept out-of-line to reduce code size:
      Maybe Pos
Nothing -> forall r.
Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success (Pos, Text) r
-> Result r
ensureSuspended Int
n State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State Text) (Pos, 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 i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
T.Parser forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
lose Success Text (State Text) (Text, a) r
succ ->
  let succ' :: Buffer -> Pos -> More -> a -> IResult Text r
succ' Buffer
t' Pos
pos' More
more' a
a = Success Text (State Text) (Text, a) r
succ Buffer
t' Pos
pos' More
more'
                              (Pos -> Pos -> Buffer -> Text
substring Pos
pos (Pos
pos'forall a. Num a => a -> a -> a
-Pos
pos) Buffer
t', a
a)
  in forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser Parser a
p State Text
t Pos
pos More
more Failure Text (State Text) r
lose Buffer -> Pos -> More -> a -> IResult Text 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 :: Pos -> Int -> Buffer -> Maybe Pos
lengthAtLeast Pos
pos Int
n Buffer
t = Int -> Int -> Maybe Pos
go Int
0 (Pos -> Int
fromPos Pos
pos)
  where go :: Int -> Int -> Maybe Pos
go Int
i !Int
p
          | Int
i forall a. Eq a => a -> a -> Bool
== Int
n    = forall a. a -> Maybe a
Just (Int -> Pos
Pos Int
p forall a. Num a => a -> a -> a
- Pos
pos)
          | Int
p forall a. Eq a => a -> a -> Bool
== Int
len  = forall a. Maybe a
Nothing
          | Bool
otherwise = Int -> Int -> Maybe Pos
go (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
p forall a. Num a => a -> a -> a
+ Buffer -> Int -> Int
Buf.iter_ Buffer
t Int
p)
        Pos Int
len = Buffer -> Pos
lengthOf Buffer
t
{-# INLINE lengthAtLeast #-}

substring :: Pos -> Pos -> Buffer -> Text
substring :: Pos -> Pos -> 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 -> Pos
lengthOf = Int -> Pos
Pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
Buf.length

size :: Text -> Pos
size :: Text -> Pos
size (Text Array
_ Int
_ Int
l) = Int -> Pos
Pos Int
l