{-# LANGUAGE BangPatterns, FlexibleInstances, GADTs, OverloadedStrings,
Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Attoparsec.Text.Internal
(
Parser
, Result
, parse
, parseOnly
, module Data.Attoparsec.Combinator
, satisfy
, satisfyWith
, anyChar
, skip
, char
, notChar
, peekChar
, peekChar'
, inClass
, notInClass
, skipWhile
, string
, stringCI
, asciiCI
, take
, scan
, runScanner
, takeWhile
, takeWhile1
, takeTill
, takeText
, takeLazyText
, 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 :: String -> Parser a
fromString = Text -> Parser Text
string (Text -> Parser Text) -> (String -> Text) -> String -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
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 Parser () -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
h
else String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfy"
{-# INLINE satisfy #-}
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 String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"skip"
satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
satisfyWith :: (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 (Char -> a) -> Char -> a
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 Parser () -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c
else String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfyWith"
{-# INLINE satisfyWith #-}
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 Parser () -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
else String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"takeWith"
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 :: 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_ ((Text -> Text)
-> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> Pos
-> 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
-> 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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text)
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text
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) Buffer
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 -> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> IResult Text r
forall r.
Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text
s Text
s Buffer
State Text
t Pos
pos More
more Failure r
Failure Text (State Text) r
lose Success Text r
Success Text (State Text) Text r
succ
| Bool
otherwise -> Failure Text (State Text) r
lose State Text
t Pos
pos More
more [] String
"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 Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Pos
l) More
more (Pos -> Pos -> Buffer -> Text
substring Pos
pos Pos
l Buffer
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 [] String
"string"
| Bool
otherwise -> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> IResult Text r
forall r.
Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
suspended Text
s Text
ssfx Buffer
State Text
t Pos
pos More
more Failure r
Failure Text (State Text) r
lose Success Text r
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 :: (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 =
Parser Text
-> State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> Result r
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 Text
forall t. Chunk t => Parser t t
demandInput_ Parser Text -> (Text -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
go) Buffer
State Text
t0 Pos
pos0 More
more0 Failure r
Failure Text (State Text) r
lose0 Success Text r
Success Text (State Text) Text r
succ0
where
go :: Text -> Parser Text
go Text
s' = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text)
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text
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 [] String
"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 Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Pos
l) More
more (Pos -> Pos -> Buffer -> Text
substring Pos
pos Pos
l Buffer
State Text
t)
| Text -> Bool
T.null Text
tsfx -> (Text -> Text)
-> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> IResult Text r
forall r.
(Text -> Text)
-> Text
-> Text
-> Buffer
-> Pos
-> More
-> Failure r
-> Success Text r
-> Result r
stringSuspended Text -> Text
f Text
s000 Text
ssfx Buffer
State Text
t Pos
pos More
more Failure r
Failure Text (State Text) r
lose Success Text r
Success Text (State Text) Text r
succ
| Bool
otherwise -> Failure Text (State Text) r
lose State Text
t Pos
pos More
more [] String
"string"
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 = String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"stringCI"
| Bool
otherwise = do
(Pos
k,Text
t) <- Int -> Parser (Pos, Text)
ensure Int
n
if Text -> Text
T.toCaseFold Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fs
then Pos -> Parser ()
advance Pos
k Parser () -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
else Int -> Parser Text
go (Int
nInt -> Int -> Int
forall 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" #-}
asciiCI :: Text -> Parser Text
asciiCI :: Text -> Parser Text
asciiCI Text
s = ((Text, ()) -> Text) -> Parser Text (Text, ()) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ()) -> Text
forall a b. (a, b) -> a
fst (Parser Text (Text, ()) -> Parser Text)
-> Parser Text (Text, ()) -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Text (Text, ())
forall a. Parser a -> Parser (Text, a)
match (Parser () -> Parser Text (Text, ()))
-> Parser () -> Parser 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 (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 (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 (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 (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 #-}
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 (Text -> Text) -> Parser Text -> Parser Text
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)
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue Parser ()
go
{-# INLINE skipWhile #-}
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 #-}
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 (Text -> Text) -> Parser Text -> Parser Text
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 (Char -> Bool) -> [Text] -> Parser Text
takeWhileAcc Char -> Bool
p [Text
h]
else Text -> Parser Text
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 (Text -> Text) -> Parser Text -> Parser Text
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
hText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
acc)
else Text -> Parser Text
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
hText -> [Text] -> [Text]
forall 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 <- Parser Bool
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
sText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
acc)
else [Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
acc)
takeText :: Parser Text
takeText :: Parser Text
takeText = [Text] -> Text
T.concat ([Text] -> Text) -> Parser [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Text]
takeRest
takeLazyText :: Parser L.Text
takeLazyText :: Parser Text
takeLazyText = [Text] -> Text
L.fromChunks ([Text] -> Text) -> Parser [Text] -> Parser Text
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_ :: (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
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) s
s'
else s -> [Text] -> Parser r
f s
s' (Text
input Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc)
Finished s
s' Int
n Text
t -> do Pos -> Parser ()
advance (Text -> Pos
size Text
input Pos -> Pos -> Pos
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc)
{-# INLINE scan_ #-}
scan :: s -> (s -> Char -> Maybe s) -> Parser Text
scan :: 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 (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 #-}
runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Text
sx, s
s)
{-# INLINE runScanner #-}
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. Chunk t => Parser t ()
demandInput) (Bool -> Parser ()) -> Parser Bool -> Parser ()
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 (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
get
let size' :: Pos
size' = Text -> Pos
size Text
h
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Pos
size' Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
0) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
h
{-# INLINE takeWhile1 #-}
inClass :: String -> Char -> Bool
inClass :: String -> Char -> Bool
inClass String
s = (Char -> FastSet -> Bool
`Set.member` FastSet
mySet)
where mySet :: FastSet
mySet = String -> FastSet
Set.charClass String
s
{-# NOINLINE mySet #-}
{-# INLINE inClass #-}
notInClass :: String -> Char -> Bool
notInClass :: String -> Char -> Bool
notInClass String
s = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char -> Bool
inClass String
s
{-# INLINE notInClass #-}
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 #-}
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 -> String -> Parser Char
forall i a. Parser i a -> String -> Parser i a
<?> Char -> String
forall a. Show a => a -> String
show Char
c
{-# INLINE char #-}
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 -> String -> Parser Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"not " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
{-# INLINE notChar #-}
peekChar :: Parser (Maybe Char)
peekChar :: Parser (Maybe Char)
peekChar = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Maybe Char) r
-> IResult Text r)
-> Parser (Maybe Char)
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Maybe Char) r
-> IResult Text r)
-> Parser (Maybe Char))
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Maybe Char) r
-> IResult Text r)
-> Parser (Maybe Char)
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 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> Pos
lengthOf Buffer
State Text
t ->
let T.Iter !Char
c Int
_ = Buffer -> Int -> Iter
Buf.iter Buffer
State Text
t (Pos -> Int
fromPos Pos
pos)
in Success Text (State Text) (Maybe Char) r
succ State Text
t Pos
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 ->
Success Text (State Text) (Maybe Char) r
succ State Text
t Pos
pos More
more Maybe Char
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
State Text
t' Pos
pos' More
more' (Char -> Maybe Char
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
State Text
t' Pos
pos' More
more' Maybe Char
forall a. Maybe a
Nothing
in State Text
-> Pos
-> More
-> (State Text -> Pos -> More -> IResult Text r)
-> (State Text -> Pos -> More -> IResult Text r)
-> IResult Text r
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
State Text -> Pos -> More -> IResult Text r
lose' Buffer -> Pos -> More -> IResult Text r
State Text -> Pos -> More -> IResult Text r
succ'
{-# INLINE peekChar #-}
peekChar' :: Parser Char
peekChar' :: Parser Char
peekChar' = do
(Pos
_,Text
s) <- Int -> Parser (Pos, Text)
ensure Int
1
Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$! Text -> Char
T.unsafeHead Text
s
{-# INLINE peekChar' #-}
endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = (Char -> Parser Char
char Char
'\n' Parser Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text
string Text
"\r\n" Parser Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
failK :: Failure a
failK :: Failure a
failK Buffer
t (Pos Int
pos) More
_more [String]
stack String
msg = Text -> [String] -> String -> IResult Text a
forall i r. i -> [String] -> String -> IResult i r
Fail (Int -> Buffer -> Text
Buf.dropCodeUnits Int
pos Buffer
t) [String]
stack String
msg
{-# INLINE failK #-}
successK :: Success a a
successK :: 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 #-}
parse :: Parser a -> Text -> Result a
parse :: Parser a -> Text -> Result a
parse Parser a
m Text
s = Parser a
-> State Text
-> Pos
-> More
-> Failure Text (State Text) a
-> Success Text (State Text) a a
-> Result a
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 Failure Text (State Text) a
forall a. Failure a
failK Success Text (State Text) a a
forall a. Success a a
successK
{-# INLINE parse #-}
parseOnly :: Parser a -> Text -> Either String a
parseOnly :: Parser a -> Text -> Either String a
parseOnly Parser a
m Text
s = case Parser a
-> State Text
-> Pos
-> More
-> Failure Text (State Text) a
-> Success Text (State Text) a a
-> IResult Text a
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 Failure Text (State Text) a
forall a. Failure a
failK Success Text (State Text) a a
forall a. Success a a
successK of
Fail Text
_ [] String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
Fail Text
_ [String]
ctxs String
err -> String -> Either String a
forall a b. a -> Either a b
Left (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" > " [String]
ctxs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
Done Text
_ a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
IResult Text a
_ -> String -> Either String a
forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseOnly #-}
get :: Parser Text
get :: Parser Text
get = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text)
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Text r
-> IResult Text r)
-> Parser Text
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) Buffer
State Text
t)
{-# INLINE get #-}
endOfChunk :: Parser Bool
endOfChunk :: Parser Bool
endOfChunk = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Bool r
-> IResult Text r)
-> Parser Bool
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Bool r
-> IResult Text r)
-> Parser Bool)
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Bool r
-> IResult Text r)
-> Parser Bool
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 Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer -> Pos
lengthOf Buffer
State Text
t)
{-# INLINE endOfChunk #-}
inputSpansChunks :: Pos -> Parser Bool
inputSpansChunks :: Pos -> Parser Bool
inputSpansChunks Pos
i = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Bool r
-> IResult Text r)
-> Parser Bool
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Bool r
-> IResult Text r)
-> Parser Bool)
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Bool r
-> IResult Text r)
-> Parser Bool
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_ Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Pos
i
in if Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> Pos
lengthOf Buffer
State Text
t Bool -> Bool -> Bool
|| More
more More -> More -> Bool
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
State Text
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
State Text
t' Pos
pos' More
more' Bool
True
in State Text
-> Pos
-> More
-> (State Text -> Pos -> More -> IResult Text r)
-> (State Text -> Pos -> More -> IResult Text r)
-> IResult Text r
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
State Text -> Pos -> More -> IResult Text r
lose' Buffer -> Pos -> More -> IResult Text r
State Text -> Pos -> More -> IResult Text r
succ'
{-# INLINE inputSpansChunks #-}
advance :: Pos -> Parser ()
advance :: Pos -> Parser ()
advance Pos
n = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) () r
-> IResult Text r)
-> Parser ()
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) () r
-> IResult Text r)
-> Parser ())
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) () r
-> IResult Text r)
-> 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
posPos -> Pos -> Pos
forall 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 :: 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 =
Parser (Pos, Text)
-> State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> Result r
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 ()
forall t. Chunk t => Parser t ()
demandInput Parser () -> Parser (Pos, Text) -> Parser (Pos, Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Pos, Text)
go) Buffer
State Text
t Pos
pos More
more Failure r
Failure Text (State Text) r
lose Success (Pos, Text) r
Success Text (State Text) (Pos, Text) r
succ
where go :: Parser (Pos, Text)
go = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r)
-> Parser (Pos, Text)
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r)
-> Parser (Pos, Text))
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r)
-> Parser (Pos, Text)
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 Buffer
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' Buffer
State Text
t')
Maybe Pos
Nothing -> Parser (Pos, Text)
-> State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r
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 ()
forall t. Chunk t => Parser t ()
demandInput Parser () -> Parser (Pos, Text) -> Parser (Pos, Text)
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'
ensure :: Int -> Parser (Pos, Text)
ensure :: Int -> Parser (Pos, Text)
ensure Int
n = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r)
-> Parser (Pos, Text)
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r)
-> Parser (Pos, Text))
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Pos, Text) r
-> IResult Text r)
-> Parser (Pos, Text)
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 Buffer
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' Buffer
State Text
t)
Maybe Pos
Nothing -> Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success (Pos, Text) r
-> IResult Text r
forall r.
Int
-> Buffer
-> Pos
-> More
-> Failure r
-> Success (Pos, Text) r
-> Result r
ensureSuspended Int
n Buffer
State Text
t Pos
pos More
more Failure r
Failure Text (State Text) r
lose Success (Pos, Text) r
Success Text (State Text) (Pos, Text) r
succ
{-# INLINE ensure #-}
match :: Parser a -> Parser (Text, a)
match :: Parser a -> Parser (Text, a)
match Parser a
p = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Text, a) r
-> IResult Text r)
-> Parser (Text, a)
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 r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Text, a) r
-> IResult Text r)
-> Parser (Text, a))
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) (Text, a) r
-> IResult Text r)
-> Parser (Text, a)
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
State Text
t' Pos
pos' More
more'
(Pos -> Pos -> Buffer -> Text
substring Pos
pos (Pos
pos'Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
-Pos
pos) Buffer
t', a
a)
in Parser a
-> State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) a r
-> IResult Text r
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
Success Text (State Text) a r
succ'
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Pos -> Maybe Pos
forall a. a -> Maybe a
Just (Int -> Pos
Pos Int
p Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
- Pos
pos)
| Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = Maybe Pos
forall a. Maybe a
Nothing
| Bool
otherwise = Int -> Int -> Maybe Pos
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 -> 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 (Int -> Pos) -> (Buffer -> Int) -> Buffer -> 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