{-# LANGUAGE CPP, BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
Rank2Types, RecordWildCards, TypeFamilies #-}
module Data.Attoparsec.Internal.Types
(
Parser(..)
, State
, Failure
, Success
, Pos(..)
, IResult(..)
, More(..)
, (<>)
, Chunk(..)
) where
import Control.Applicative as App (Applicative(..), (<$>))
import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail (MonadFail(..))
import Data.Monoid as Mon (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Word (Word8)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (w2c)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Unsafe (Iter(..))
import Prelude hiding (succ)
import qualified Data.Attoparsec.ByteString.Buffer as B
import qualified Data.Attoparsec.Text.Buffer as T
newtype Pos = Pos { Pos -> Int
fromPos :: Int }
deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Eq Pos =>
(Pos -> Pos -> Ordering)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> Ord Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
$cp1Ord :: Eq Pos
Ord, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, Integer -> Pos
Pos -> Pos
Pos -> Pos -> Pos
(Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos)
-> (Pos -> Pos)
-> (Pos -> Pos)
-> (Integer -> Pos)
-> Num Pos
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Pos
$cfromInteger :: Integer -> Pos
signum :: Pos -> Pos
$csignum :: Pos -> Pos
abs :: Pos -> Pos
$cabs :: Pos -> Pos
negate :: Pos -> Pos
$cnegate :: Pos -> Pos
* :: Pos -> Pos -> Pos
$c* :: Pos -> Pos -> Pos
- :: Pos -> Pos -> Pos
$c- :: Pos -> Pos -> Pos
+ :: Pos -> Pos -> Pos
$c+ :: Pos -> Pos -> Pos
Num)
data IResult i r =
Fail i [String] String
| Partial (i -> IResult i r)
| Done i r
instance (Show i, Show r) => Show (IResult i r) where
showsPrec :: Int -> IResult i r -> ShowS
showsPrec d :: Int
d ir :: IResult i r
ir = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
case IResult i r
ir of
(Fail t :: i
t stk :: [String]
stk msg :: String
msg) -> String -> ShowS
showString "Fail" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> ShowS
forall a. Show a => a -> ShowS
f i
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ShowS
forall a. Show a => a -> ShowS
f [String]
stk ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
f String
msg
(Partial _) -> String -> ShowS
showString "Partial _"
(Done t :: i
t r :: r
r) -> String -> ShowS
showString "Done" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> ShowS
forall a. Show a => a -> ShowS
f i
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> ShowS
forall a. Show a => a -> ShowS
f r
r
where f :: Show a => a -> ShowS
f :: a -> ShowS
f x :: a
x = Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 a
x
instance (NFData i, NFData r) => NFData (IResult i r) where
rnf :: IResult i r -> ()
rnf (Fail t :: i
t stk :: [String]
stk msg :: String
msg) = i -> ()
forall a. NFData a => a -> ()
rnf i
t () -> () -> ()
forall a b. a -> b -> b
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
stk () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
msg
rnf (Partial _) = ()
rnf (Done t :: i
t r :: r
r) = i -> ()
forall a. NFData a => a -> ()
rnf i
t () -> () -> ()
forall a b. a -> b -> b
`seq` r -> ()
forall a. NFData a => a -> ()
rnf r
r
{-# INLINE rnf #-}
instance Functor (IResult i) where
fmap :: (a -> b) -> IResult i a -> IResult i b
fmap _ (Fail t :: i
t stk :: [String]
stk msg :: String
msg) = i -> [String] -> String -> IResult i b
forall i r. i -> [String] -> String -> IResult i r
Fail i
t [String]
stk String
msg
fmap f :: a -> b
f (Partial k :: i -> IResult i a
k) = (i -> IResult i b) -> IResult i b
forall i r. (i -> IResult i r) -> IResult i r
Partial ((a -> b) -> IResult i a -> IResult i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (IResult i a -> IResult i b)
-> (i -> IResult i a) -> i -> IResult i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> IResult i a
k)
fmap f :: a -> b
f (Done t :: i
t r :: a
r) = i -> b -> IResult i b
forall i r. i -> r -> IResult i r
Done i
t (a -> b
f a
r)
newtype Parser i a = Parser {
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 r.
State i -> Pos -> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
}
type family State i
type instance State ByteString = B.Buffer
type instance State Text = T.Buffer
type Failure i t r = t -> Pos -> More -> [String] -> String
-> IResult i r
type Success i t a r = t -> Pos -> More -> a -> IResult i r
data More = Complete | Incomplete
deriving (More -> More -> Bool
(More -> More -> Bool) -> (More -> More -> Bool) -> Eq More
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: More -> More -> Bool
$c/= :: More -> More -> Bool
== :: More -> More -> Bool
$c== :: More -> More -> Bool
Eq, Int -> More -> ShowS
[More] -> ShowS
More -> String
(Int -> More -> ShowS)
-> (More -> String) -> ([More] -> ShowS) -> Show More
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [More] -> ShowS
$cshowList :: [More] -> ShowS
show :: More -> String
$cshow :: More -> String
showsPrec :: Int -> More -> ShowS
$cshowsPrec :: Int -> More -> ShowS
Show)
instance Semigroup More where
c :: More
c@More
Complete <> :: More -> More -> More
<> _ = More
c
_ <> m :: More
m = More
m
instance Mon.Monoid More where
mappend :: More -> More -> More
mappend = More -> More -> More
forall a. Semigroup a => a -> a -> a
(<>)
mempty :: More
mempty = More
Incomplete
instance Monad (Parser i) where
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
#endif
return :: a -> Parser i a
return = a -> Parser i a
forall (f :: * -> *) a. Applicative f => a -> f a
App.pure
{-# INLINE return #-}
m :: Parser i a
m >>= :: Parser i a -> (a -> Parser i b) -> Parser i b
>>= k :: a -> Parser i b
k = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i r)
-> Parser i b
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
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i r)
-> Parser i b)
-> (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i r)
-> Parser i b
forall a b. (a -> b) -> a -> b
$ \t :: State i
t !Pos
pos more :: More
more lose :: Failure i (State i) r
lose succ :: Success i (State i) b r
succ ->
let succ' :: State i -> Pos -> More -> a -> IResult i r
succ' t' :: State i
t' !Pos
pos' more' :: More
more' a :: a
a = Parser i b
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i 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 (a -> Parser i b
k a
a) State i
t' Pos
pos' More
more' Failure i (State i) r
lose Success i (State i) b r
succ
in Parser i a
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> (State i -> Pos -> More -> a -> IResult i r)
-> IResult i 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 i a
m State i
t Pos
pos More
more Failure i (State i) r
lose State i -> Pos -> More -> a -> IResult i r
succ'
{-# INLINE (>>=) #-}
>> :: Parser i a -> Parser i b -> Parser i b
(>>) = Parser i a -> Parser i b -> Parser i b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE (>>) #-}
instance Fail.MonadFail (Parser i) where
fail :: String -> Parser i a
fail err :: String
err = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i 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
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser 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
forall a b. (a -> b) -> a -> b
$ \t :: State i
t pos :: Pos
pos more :: More
more lose :: Failure i (State i) r
lose _succ :: Success i (State i) a r
_succ -> Failure i (State i) r
lose State i
t Pos
pos More
more [] String
msg
where msg :: String
msg = "Failed reading: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
{-# INLINE fail #-}
plus :: Parser i a -> Parser i a -> Parser i a
plus :: Parser i a -> Parser i a -> Parser i a
plus f :: Parser i a
f g :: Parser i a
g = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i 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
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser 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
forall a b. (a -> b) -> a -> b
$ \t :: State i
t pos :: Pos
pos more :: More
more lose :: Failure i (State i) r
lose succ :: Success i (State i) a r
succ ->
let lose' :: Failure i (State i) r
lose' t' :: State i
t' _pos' :: Pos
_pos' more' :: More
more' _ctx :: [String]
_ctx _msg :: String
_msg = Parser i a
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i 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 i a
g State i
t' Pos
pos More
more' Failure i (State i) r
lose Success i (State i) a r
succ
in Parser i a
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i 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 i a
f State i
t Pos
pos More
more Failure i (State i) r
lose' Success i (State i) a r
succ
instance MonadPlus (Parser i) where
mzero :: Parser i a
mzero = String -> Parser i a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "mzero"
{-# INLINE mzero #-}
mplus :: Parser i a -> Parser i a -> Parser i a
mplus = Parser i a -> Parser i a -> Parser i a
forall i a. Parser i a -> Parser i a -> Parser i a
plus
instance Functor (Parser i) where
fmap :: (a -> b) -> Parser i a -> Parser i b
fmap f :: a -> b
f p :: Parser i a
p = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i r)
-> Parser i b
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
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i r)
-> Parser i b)
-> (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) b r
-> IResult i r)
-> Parser i b
forall a b. (a -> b) -> a -> b
$ \t :: State i
t pos :: Pos
pos more :: More
more lose :: Failure i (State i) r
lose succ :: Success i (State i) b r
succ ->
let succ' :: State i -> Pos -> More -> a -> IResult i r
succ' t' :: State i
t' pos' :: Pos
pos' more' :: More
more' a :: a
a = Success i (State i) b r
succ State i
t' Pos
pos' More
more' (a -> b
f a
a)
in Parser i a
-> State i
-> Pos
-> More
-> Failure i (State i) r
-> (State i -> Pos -> More -> a -> IResult i r)
-> IResult i 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 i a
p State i
t Pos
pos More
more Failure i (State i) r
lose State i -> Pos -> More -> a -> IResult i r
succ'
{-# INLINE fmap #-}
apP :: Parser i (a -> b) -> Parser i a -> Parser i b
apP :: Parser i (a -> b) -> Parser i a -> Parser i b
apP d :: Parser i (a -> b)
d e :: Parser i a
e = do
a -> b
b <- Parser i (a -> b)
d
a
a <- Parser i a
e
b -> Parser i b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
b a
a)
{-# INLINE apP #-}
instance Applicative (Parser i) where
pure :: a -> Parser i a
pure v :: a
v = (forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser i 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
Parser ((forall r.
State i
-> Pos
-> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r)
-> Parser 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
forall a b. (a -> b) -> a -> b
$ \t :: State i
t !Pos
pos more :: More
more _lose :: Failure i (State i) r
_lose succ :: Success i (State i) a r
succ -> Success i (State i) a r
succ State i
t Pos
pos More
more a
v
{-# INLINE pure #-}
<*> :: Parser i (a -> b) -> Parser i a -> Parser i b
(<*>) = Parser i (a -> b) -> Parser i a -> Parser i b
forall i a b. Parser i (a -> b) -> Parser i a -> Parser i b
apP
{-# INLINE (<*>) #-}
m :: Parser i a
m *> :: Parser i a -> Parser i b -> Parser i b
*> k :: Parser i b
k = Parser i a
m Parser i a -> (a -> Parser i b) -> Parser i b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \_ -> Parser i b
k
{-# INLINE (*>) #-}
x :: Parser i a
x <* :: Parser i a -> Parser i b -> Parser i a
<* y :: Parser i b
y = Parser i a
x Parser i a -> (a -> Parser i a) -> Parser i a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> Parser i b
y Parser i b -> Parser i a -> Parser i a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Parser i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE (<*) #-}
instance Semigroup (Parser i a) where
<> :: Parser i a -> Parser i a -> Parser i a
(<>) = Parser i a -> Parser i a -> Parser i a
forall i a. Parser i a -> Parser i a -> Parser i a
plus
{-# INLINE (<>) #-}
instance Monoid (Parser i a) where
mempty :: Parser i a
mempty = String -> Parser i a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "mempty"
{-# INLINE mempty #-}
mappend :: Parser i a -> Parser i a -> Parser i a
mappend = Parser i a -> Parser i a -> Parser i a
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
instance Alternative (Parser i) where
empty :: Parser i a
empty = String -> Parser i a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "empty"
{-# INLINE empty #-}
<|> :: Parser i a -> Parser i a -> Parser i a
(<|>) = Parser i a -> Parser i a -> Parser i a
forall i a. Parser i a -> Parser i a -> Parser i a
plus
{-# INLINE (<|>) #-}
many :: Parser i a -> Parser i [a]
many v :: Parser i a
v = Parser i [a]
many_v
where
many_v :: Parser i [a]
many_v = Parser i [a]
some_v Parser i [a] -> Parser i [a] -> Parser i [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser i [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
some_v :: Parser i [a]
some_v = (:) (a -> [a] -> [a]) -> Parser i a -> Parser i ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser i a
v Parser i ([a] -> [a]) -> Parser i [a] -> Parser i [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser i [a]
many_v
{-# INLINE many #-}
some :: Parser i a -> Parser i [a]
some v :: Parser i a
v = Parser i [a]
some_v
where
many_v :: Parser i [a]
many_v = Parser i [a]
some_v Parser i [a] -> Parser i [a] -> Parser i [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser i [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
some_v :: Parser i [a]
some_v = (:) (a -> [a] -> [a]) -> Parser i a -> Parser i ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser i a
v Parser i ([a] -> [a]) -> Parser i [a] -> Parser i [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser i [a]
many_v
{-# INLINE some #-}
class Monoid c => Chunk c where
type ChunkElem c
nullChunk :: c -> Bool
pappendChunk :: State c -> c -> State c
atBufferEnd :: c -> State c -> Pos
bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int)
chunkElemToChar :: c -> ChunkElem c -> Char
instance Chunk ByteString where
type ChunkElem ByteString = Word8
nullChunk :: ByteString -> Bool
nullChunk = ByteString -> Bool
BS.null
{-# INLINE nullChunk #-}
pappendChunk :: State ByteString -> ByteString -> State ByteString
pappendChunk = Buffer -> ByteString -> Buffer
State ByteString -> ByteString -> State ByteString
B.pappend
{-# INLINE pappendChunk #-}
atBufferEnd :: ByteString -> State ByteString -> Pos
atBufferEnd _ = Int -> Pos
Pos (Int -> Pos) -> (Buffer -> Int) -> Buffer -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
B.length
{-# INLINE atBufferEnd #-}
bufferElemAt :: ByteString
-> Pos -> State ByteString -> Maybe (ChunkElem ByteString, Int)
bufferElemAt _ (Pos i :: Int
i) buf :: State ByteString
buf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> Int
B.length Buffer
State ByteString
buf = (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Buffer -> Int -> Word8
B.unsafeIndex Buffer
State ByteString
buf Int
i, 1)
| Bool
otherwise = Maybe (ChunkElem ByteString, Int)
forall a. Maybe a
Nothing
{-# INLINE bufferElemAt #-}
chunkElemToChar :: ByteString -> ChunkElem ByteString -> Char
chunkElemToChar _ = Word8 -> Char
ChunkElem ByteString -> Char
w2c
{-# INLINE chunkElemToChar #-}
instance Chunk Text where
type ChunkElem Text = Char
nullChunk :: Text -> Bool
nullChunk = Text -> Bool
Text.null
{-# INLINE nullChunk #-}
pappendChunk :: State Text -> Text -> State Text
pappendChunk = Buffer -> Text -> Buffer
State Text -> Text -> State Text
T.pappend
{-# INLINE pappendChunk #-}
atBufferEnd :: Text -> State Text -> Pos
atBufferEnd _ = Int -> Pos
Pos (Int -> Pos) -> (Buffer -> Int) -> Buffer -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
T.length
{-# INLINE atBufferEnd #-}
bufferElemAt :: Text -> Pos -> State Text -> Maybe (ChunkElem Text, Int)
bufferElemAt _ (Pos i :: Int
i) buf :: State Text
buf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Buffer -> Int
T.length Buffer
State Text
buf = let Iter c :: Char
c l :: Int
l = Buffer -> Int -> Iter
T.iter Buffer
State Text
buf Int
i in (Char, Int) -> Maybe (Char, Int)
forall a. a -> Maybe a
Just (Char
c, Int
l)
| Bool
otherwise = Maybe (ChunkElem Text, Int)
forall a. Maybe a
Nothing
{-# INLINE bufferElemAt #-}
chunkElemToChar :: Text -> ChunkElem Text -> Char
chunkElemToChar _ = ChunkElem Text -> Char
forall a. a -> a
id
{-# INLINE chunkElemToChar #-}