{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Replace.Attoparsec.Text.Lazy
(
streamEdit
, streamEditT
, anyTill
)
where
import Data.Functor.Identity
import Control.Applicative
import Data.Attoparsec.Text.Lazy as A hiding (parseOnly)
import qualified Data.Attoparsec.Text as AS
import Data.List as List ( intercalate )
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Internal.Lazy as TI
import qualified Data.Text as TS
import qualified Data.Text.Internal as TIS
import qualified Data.Attoparsec.Internal.Types as AT
import Data.Coerce
streamEdit
:: forall a. Parser a
-> (a -> TS.Text)
-> T.Text
-> T.Text
streamEdit :: Parser a -> (a -> Text) -> Text -> Text
streamEdit = (Parser a -> (a -> Identity Text) -> Text -> Identity Text)
-> Parser a -> (a -> Text) -> Text -> Text
coerce (Applicative Identity =>
Parser a -> (a -> Identity Text) -> Text -> Identity Text
forall (m :: * -> *) a.
Applicative m =>
Parser a -> (a -> m Text) -> Text -> m Text
streamEditT @Identity @a)
{-# INLINABLE streamEdit #-}
streamEditT
:: (Applicative m)
=> Parser a
-> (a -> m TS.Text)
-> T.Text
-> m T.Text
streamEditT :: Parser a -> (a -> m Text) -> Text -> m Text
streamEditT Parser a
sep a -> m Text
editor = (Builder -> Text) -> m Builder -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder -> Text
TB.toLazyText (m Builder -> m Text) -> (Text -> m Builder) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> (Text -> Result (Text, a)) -> Text -> m Builder
go Builder
forall a. Monoid a => a
mempty Text -> Result (Text, a)
defP
where
defP :: Text -> Result (Text, a)
defP = Parser (Text, a) -> Text -> Result (Text, a)
forall a. Parser a -> Text -> Result a
AS.parse (Parser a -> Parser (Text, a)
forall a. Parser a -> Parser (Text, a)
anyTill Parser a
sep)
go :: Builder -> (Text -> Result (Text, a)) -> Text -> m Builder
go Builder
failRet Text -> Result (Text, a)
p Text
input = case Text
input of
Text
TI.Empty -> Builder -> m Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
failRet
TI.Chunk Text
c Text
cs -> case Text -> Result (Text, a)
p Text
c of
AS.Fail{} -> (Builder
failRet Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder
TB.fromText Text
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> m Builder -> m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> (Text -> Result (Text, a)) -> Text -> m Builder
go Builder
forall a. Monoid a => a
mempty Text -> Result (Text, a)
defP Text
cs
AS.Partial Text -> Result (Text, a)
f -> Builder -> (Text -> Result (Text, a)) -> Text -> m Builder
go (Builder
failRet Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
c) Text -> Result (Text, a)
f Text
cs
AS.Done Text
next (Text, a)
r -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> m [Builder] -> m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Builder] -> m [Builder]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ Builder -> m Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Builder
TB.fromLazyText ((Text, a) -> Text
forall a b. (a, b) -> a
fst (Text, a)
r))
, Text -> Builder
TB.fromText (Text -> Builder) -> m Text -> m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Text
editor ((Text, a) -> a
forall a b. (a, b) -> b
snd (Text, a)
r)
, Builder -> (Text -> Result (Text, a)) -> Text -> m Builder
go Builder
forall a. Monoid a => a
mempty Text -> Result (Text, a)
defP (Text -> Text -> Text
TI.chunk Text
next Text
cs)
]
{-# INLINABLE streamEditT #-}
anyTill
:: Parser a
-> Parser (T.Text, a)
anyTill :: Parser a -> Parser (Text, a)
anyTill Parser a
sep = do
Int
begin <- Parser Int
getOffset
(Int
end, a
x) <- Parser Text (Int, a)
go
Text
prefix <- Int -> Int -> Parser Text
substring Int
begin Int
end
(Text, a) -> Parser (Text, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
prefix, a
x)
where
go :: Parser Text (Int, a)
go = do
Int
end <- Parser Int
getOffset
Maybe a
r <- Parser a -> Parser Text (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser a -> Parser Text (Maybe a))
-> Parser a -> Parser Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ Parser a -> Parser a
forall i a. Parser i a -> Parser i a
try Parser a
sep
case Maybe a
r of
Maybe a
Nothing -> Parser Bool
atChunkEnd Parser Bool
-> (Bool -> Parser Text (Int, a)) -> Parser Text (Int, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Parser Text (Int, a)
forall (f :: * -> *) a. Alternative f => f a
empty
Bool
False -> Parser Char
anyChar Parser Char -> Parser Text (Int, a) -> Parser Text (Int, a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text (Int, a)
go
Just a
x -> (Int, a) -> Parser Text (Int, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
end, a
x)
atChunkEnd :: Parser Bool
atChunkEnd :: Parser Bool
atChunkEnd = (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
AT.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 -> Pos
forall a. Num a => a -> a -> a
+ Pos
1 Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> State Text -> Pos
forall c. Chunk c => c -> State c -> Pos
AT.atBufferEnd (Text
forall a. HasCallStack => a
undefined :: TS.Text) State Text
t)
getOffset :: Parser Int
getOffset :: Parser Int
getOffset = (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Int r
-> IResult Text r)
-> Parser Int
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
AT.Parser ((forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Int r
-> IResult Text r)
-> Parser Int)
-> (forall r.
State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) Int r
-> IResult Text r)
-> Parser Int
forall a b. (a -> b) -> a -> b
$ \State Text
t Pos
pos More
more Failure Text (State Text) r
_ Success Text (State Text) Int r
succ' -> Success Text (State Text) Int r
succ' State Text
t Pos
pos More
more (Pos -> Int
AT.fromPos Pos
pos)
{-# INLINABLE getOffset #-}
substring :: Int -> Int -> Parser T.Text
substring :: Int -> Int -> Parser Text
substring !Int
bgn !Int
end = (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
AT.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
succes ->
let succes' :: p -> p -> p -> Text -> IResult Text r
succes' p
_t p
_pos p
_more Text
a = Success Text (State Text) Text r
succes State Text
t Pos
pos More
more (Text -> Text
T.fromStrict Text
a)
in
Parser Text Text
-> State Text
-> Pos
-> More
-> Failure Text (State Text) r
-> Success Text (State Text) 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
AT.runParser (Int -> Parser Text Text
takeCheat (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bgn)) State Text
t (Int -> Pos
AT.Pos Int
bgn) More
more Failure Text (State Text) r
lose Success Text (State Text) Text r
forall p p p. p -> p -> p -> Text -> IResult Text r
succes'
where
takeCheat :: Int -> Parser TS.Text
takeCheat :: Int -> Parser Text Text
takeCheat Int
len = do
(TIS.Text Array
arr Int
off Int
_len) <- Int -> Parser Text Text
A.take Int
0
Text -> Parser Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
TIS.Text Array
arr Int
off Int
len)
eitherResult' :: Result r -> Either String r
eitherResult' :: Result r -> Either String r
eitherResult' (Done Text
_ r
r) = r -> Either String r
forall a b. b -> Either a b
Right r
r
eitherResult' (Fail Text
_ [] String
msg) = String -> Either String r
forall a b. a -> Either a b
Left String
msg
eitherResult' (Fail Text
_ [String]
ctxs String
msg) = String -> Either String r
forall a b. a -> Either a b
Left (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
" > " [String]
ctxs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)
parseOnly :: A.Parser a -> T.Text -> Either String a
parseOnly :: Parser a -> Text -> Either String a
parseOnly Parser a
p = Result a -> Either String a
forall r. Result r -> Either String r
eitherResult' (Result a -> Either String a)
-> (Text -> Result a) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
parse Parser a
p
{-# INLINE parseOnly #-}