{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
module Replace.Attoparsec.ByteString
(
breakCap
, splitCap
, streamEdit
, streamEditT
, anyTill
, sepCap
, findAll
, findAllCap
)
where
import Data.Functor.Identity
import Data.Bifunctor
import Control.Applicative
import Control.Monad
import Data.Attoparsec.ByteString as A
import qualified Data.ByteString as B
import qualified Data.Attoparsec.Internal.Types as AT
breakCap
:: Parser a
-> B.ByteString
-> Maybe (B.ByteString, a, B.ByteString)
breakCap :: Parser a -> ByteString -> Maybe (ByteString, a, ByteString)
breakCap Parser a
sep ByteString
input =
case Parser (ByteString, a, ByteString)
-> ByteString -> Either String (ByteString, a, ByteString)
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser (ByteString, a, ByteString)
pser ByteString
input of
(Left String
_) -> Maybe (ByteString, a, ByteString)
forall a. Maybe a
Nothing
(Right (ByteString, a, ByteString)
x) -> (ByteString, a, ByteString) -> Maybe (ByteString, a, ByteString)
forall a. a -> Maybe a
Just (ByteString, a, ByteString)
x
where
pser :: Parser (ByteString, a, ByteString)
pser = do
(ByteString
prefix, a
cap) <- Parser a -> Parser (ByteString, a)
forall a. Parser a -> Parser (ByteString, a)
anyTill Parser a
sep
ByteString
suffix <- Parser ByteString
A.takeByteString
(ByteString, a, ByteString) -> Parser (ByteString, a, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
prefix, a
cap, ByteString
suffix)
{-# INLINABLE breakCap #-}
splitCap
:: Parser a
-> B.ByteString
-> [Either B.ByteString a]
splitCap :: Parser a -> ByteString -> [Either ByteString a]
splitCap Parser a
sep ByteString
input = do
case Parser [Either ByteString a]
-> ByteString -> Either String [Either ByteString a]
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser a -> Parser [Either ByteString a]
forall a. Parser a -> Parser [Either ByteString a]
sepCap Parser a
sep) ByteString
input of
(Left String
_) -> [Either ByteString a]
forall a. HasCallStack => a
undefined
(Right [Either ByteString a]
r) -> [Either ByteString a]
r
{-# INLINABLE splitCap #-}
streamEdit
:: Parser a
-> (a -> B.ByteString)
-> B.ByteString
-> B.ByteString
streamEdit :: Parser a -> (a -> ByteString) -> ByteString -> ByteString
streamEdit Parser a
sep a -> ByteString
editor = Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (ByteString -> Identity ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a
-> (a -> Identity ByteString) -> ByteString -> Identity ByteString
forall (m :: * -> *) a.
Monad m =>
Parser a -> (a -> m ByteString) -> ByteString -> m ByteString
streamEditT Parser a
sep (ByteString -> Identity ByteString
forall a. a -> Identity a
Identity (ByteString -> Identity ByteString)
-> (a -> ByteString) -> a -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
editor)
{-# INLINABLE streamEdit #-}
streamEditT
:: (Monad m)
=> Parser a
-> (a -> m B.ByteString)
-> B.ByteString
-> m B.ByteString
streamEditT :: Parser a -> (a -> m ByteString) -> ByteString -> m ByteString
streamEditT Parser a
sep a -> m ByteString
editor ByteString
input = do
case Parser [Either ByteString a]
-> ByteString -> Either String [Either ByteString a]
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser a -> Parser [Either ByteString a]
forall a. Parser a -> Parser [Either ByteString a]
sepCap Parser a
sep) ByteString
input of
(Left String
err) -> String -> m ByteString
forall a. HasCallStack => String -> a
error String
err
(Right [Either ByteString a]
r) -> [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> m [ByteString] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either ByteString a -> m ByteString)
-> [Either ByteString a] -> m [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ByteString -> m ByteString)
-> (a -> m ByteString) -> Either ByteString a -> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return a -> m ByteString
editor) [Either ByteString a]
r
{-# INLINABLE streamEditT #-}
anyTill
:: Parser a
-> Parser (B.ByteString, a)
anyTill :: Parser a -> Parser (ByteString, a)
anyTill Parser a
sep = do
Int
begin <- Parser Int
getOffset
(Int
end, a
x) <- Parser ByteString (Int, a)
go
ByteString
prefix <- Int -> Int -> Parser ByteString
substring Int
begin Int
end
(ByteString, a) -> Parser (ByteString, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
prefix, a
x)
where
go :: Parser ByteString (Int, a)
go = do
Int
end <- Parser Int
getOffset
Maybe a
r <- Parser a -> Parser ByteString (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser a -> Parser ByteString (Maybe a))
-> Parser a -> Parser ByteString (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 ByteString Bool
forall t. Chunk t => Parser t Bool
atEnd Parser ByteString Bool
-> (Bool -> Parser ByteString (Int, a))
-> Parser ByteString (Int, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Parser ByteString (Int, a)
forall (f :: * -> *) a. Alternative f => f a
empty
Bool
False -> Parser ()
advance Parser ()
-> Parser ByteString (Int, a) -> Parser ByteString (Int, a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString (Int, a)
go
Just a
x -> (Int, a) -> Parser ByteString (Int, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
end, a
x)
sepCap
:: Parser a
-> Parser [Either B.ByteString a]
sepCap :: Parser a -> Parser [Either ByteString a]
sepCap Parser a
sep = Parser Int
getOffset Parser Int
-> (Int -> Parser [Either ByteString a])
-> Parser [Either ByteString a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Parser [Either ByteString a]
go
where
go :: Int -> Parser [Either ByteString a]
go !Int
offsetBegin = do
!Int
offsetThis <- Parser Int
getOffset
Parser [Either ByteString a]
-> Parser [Either ByteString a] -> Parser [Either ByteString a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
( do
()
_ <- Parser ()
forall t. Chunk t => Parser t ()
endOfInput
if Int
offsetThis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
offsetBegin
then
Int -> Int -> Parser ByteString
substring Int
offsetBegin Int
offsetThis Parser ByteString
-> (ByteString -> Parser [Either ByteString a])
-> Parser [Either ByteString a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
s -> [Either ByteString a] -> Parser [Either ByteString a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString -> Either ByteString a
forall a b. a -> Either a b
Left ByteString
s]
else [Either ByteString a] -> Parser [Either ByteString a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
)
( do
Maybe (a, Int)
thisiter <- Parser ByteString (Maybe (a, Int))
-> Parser ByteString (Maybe (a, Int))
-> Parser ByteString (Maybe (a, Int))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
( do
a
x <- Parser a -> Parser a
forall i a. Parser i a -> Parser i a
try Parser a
sep
!Int
offsetAfter <- Parser Int
getOffset
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offsetAfter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
offsetThis) Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
Maybe (a, Int) -> Parser ByteString (Maybe (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, Int) -> Parser ByteString (Maybe (a, Int)))
-> Maybe (a, Int) -> Parser ByteString (Maybe (a, Int))
forall a b. (a -> b) -> a -> b
$ (a, Int) -> Maybe (a, Int)
forall a. a -> Maybe a
Just (a
x, Int
offsetAfter)
)
(Parser ()
advance Parser ()
-> Parser ByteString (Maybe (a, Int))
-> Parser ByteString (Maybe (a, Int))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (a, Int) -> Parser ByteString (Maybe (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Int)
forall a. Maybe a
Nothing)
case Maybe (a, Int)
thisiter of
(Just (a
x, !Int
offsetAfter)) | Int
offsetThis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
offsetBegin -> do
ByteString
unmatched <- Int -> Int -> Parser ByteString
substring Int
offsetBegin Int
offsetThis
(ByteString -> Either ByteString a
forall a b. a -> Either a b
Left ByteString
unmatchedEither ByteString a
-> [Either ByteString a] -> [Either ByteString a]
forall a. a -> [a] -> [a]
:) ([Either ByteString a] -> [Either ByteString a])
-> ([Either ByteString a] -> [Either ByteString a])
-> [Either ByteString a]
-> [Either ByteString a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Either ByteString a
forall a b. b -> Either a b
Right a
xEither ByteString a
-> [Either ByteString a] -> [Either ByteString a]
forall a. a -> [a] -> [a]
:) ([Either ByteString a] -> [Either ByteString a])
-> Parser [Either ByteString a] -> Parser [Either ByteString a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser [Either ByteString a]
go Int
offsetAfter
(Just (a
x, !Int
offsetAfter)) -> do
(a -> Either ByteString a
forall a b. b -> Either a b
Right a
xEither ByteString a
-> [Either ByteString a] -> [Either ByteString a]
forall a. a -> [a] -> [a]
:) ([Either ByteString a] -> [Either ByteString a])
-> Parser [Either ByteString a] -> Parser [Either ByteString a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser [Either ByteString a]
go Int
offsetAfter
Maybe (a, Int)
Nothing -> Int -> Parser [Either ByteString a]
go Int
offsetBegin
)
{-# INLINABLE sepCap #-}
findAllCap
:: Parser a
-> Parser [Either B.ByteString (B.ByteString, a)]
findAllCap :: Parser a -> Parser [Either ByteString (ByteString, a)]
findAllCap Parser a
sep = Parser (ByteString, a)
-> Parser [Either ByteString (ByteString, a)]
forall a. Parser a -> Parser [Either ByteString a]
sepCap (Parser a -> Parser (ByteString, a)
forall a. Parser a -> Parser (ByteString, a)
match Parser a
sep)
{-# INLINABLE findAllCap #-}
{-# DEPRECATED findAllCap "replace with `findAllCap sep = sepCap (match sep)`" #-}
findAll
:: Parser a
-> Parser [Either B.ByteString B.ByteString]
findAll :: Parser a -> Parser [Either ByteString ByteString]
findAll Parser a
sep = (([Either ByteString (ByteString, a)]
-> [Either ByteString ByteString])
-> Parser ByteString [Either ByteString (ByteString, a)]
-> Parser [Either ByteString ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([Either ByteString (ByteString, a)]
-> [Either ByteString ByteString])
-> Parser ByteString [Either ByteString (ByteString, a)]
-> Parser [Either ByteString ByteString])
-> ((Either ByteString (ByteString, a)
-> Either ByteString ByteString)
-> [Either ByteString (ByteString, a)]
-> [Either ByteString ByteString])
-> (Either ByteString (ByteString, a)
-> Either ByteString ByteString)
-> Parser ByteString [Either ByteString (ByteString, a)]
-> Parser [Either ByteString ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Either ByteString (ByteString, a) -> Either ByteString ByteString)
-> [Either ByteString (ByteString, a)]
-> [Either ByteString ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (((ByteString, a) -> ByteString)
-> Either ByteString (ByteString, a)
-> Either ByteString ByteString
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst) (Parser ByteString [Either ByteString (ByteString, a)]
-> Parser [Either ByteString ByteString])
-> Parser ByteString [Either ByteString (ByteString, a)]
-> Parser [Either ByteString ByteString]
forall a b. (a -> b) -> a -> b
$ Parser (ByteString, a)
-> Parser ByteString [Either ByteString (ByteString, a)]
forall a. Parser a -> Parser [Either ByteString a]
sepCap (Parser a -> Parser (ByteString, a)
forall a. Parser a -> Parser (ByteString, a)
match Parser a
sep)
{-# INLINABLE findAll #-}
{-# DEPRECATED findAll "replace with `findAll sep = (fmap.fmap) (second fst) $ sepCap (match sep)`" #-}
getOffset :: Parser Int
getOffset :: Parser Int
getOffset = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Int r
-> IResult ByteString 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 ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Int r
-> IResult ByteString r)
-> Parser Int)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) Int r
-> IResult ByteString r)
-> Parser Int
forall a b. (a -> b) -> a -> b
$ \State ByteString
t Pos
pos More
more Failure ByteString (State ByteString) r
_ Success ByteString (State ByteString) Int r
succ' -> Success ByteString (State ByteString) Int r
succ' State ByteString
t Pos
pos More
more (Pos -> Int
AT.fromPos Pos
pos)
advance :: Parser ()
advance :: Parser ()
advance = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) () r
-> IResult ByteString 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
AT.Parser ((forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) () r
-> IResult ByteString r)
-> Parser ())
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) () r
-> IResult ByteString r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \State ByteString
t Pos
pos More
more Failure ByteString (State ByteString) r
_lose Success ByteString (State ByteString) () r
succes ->
Success ByteString (State ByteString) () r
succes State ByteString
t (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Int -> Pos
AT.Pos Int
1) More
more ()
{-# INLINABLE advance #-}
substring :: Int -> Int -> Parser B.ByteString
substring :: Int -> Int -> Parser ByteString
substring !Int
pos1 !Int
pos2 = (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString
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 ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString)
-> (forall r.
State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString r)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \State ByteString
t Pos
pos More
more Failure ByteString (State ByteString) r
lose Success ByteString (State ByteString) ByteString r
succes ->
let succes' :: p -> p -> p -> ByteString -> IResult ByteString r
succes' p
_t p
_pos p
_more ByteString
a = Success ByteString (State ByteString) ByteString r
succes State ByteString
t Pos
pos More
more ByteString
a
in Parser ByteString
-> State ByteString
-> Pos
-> More
-> Failure ByteString (State ByteString) r
-> Success ByteString (State ByteString) ByteString r
-> IResult ByteString 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 ByteString
A.take (Int
pos2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos1)) State ByteString
t (Int -> Pos
AT.Pos Int
pos1) More
more Failure ByteString (State ByteString) r
lose Success ByteString (State ByteString) ByteString r
forall p p p. p -> p -> p -> ByteString -> IResult ByteString r
succes'
{-# INLINABLE substring #-}