{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Replace.Megaparsec.Internal.ByteString
(
sepCapByteString
, anyTillByteString
)
where
import Control.Monad
import qualified Data.ByteString as B
import Text.Megaparsec
{-# INLINE [1] sepCapByteString #-}
sepCapByteString
:: forall e s m a. (MonadParsec e s m, s ~ B.ByteString)
=> m a
-> m [Either (Tokens s) a]
sepCapByteString :: forall e s (m :: * -> *) a.
(MonadParsec e s m, s ~ ByteString) =>
m a -> m [Either (Tokens s) a]
sepCapByteString m a
sep = m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput m ByteString
-> (ByteString -> m [Either ByteString a])
-> m [Either ByteString a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m [Either ByteString a]
go
where
go :: ByteString -> m [Either ByteString a]
go ByteString
restBegin = do
m [Either ByteString a]
-> m [Either ByteString a] -> m [Either ByteString a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
( do
restThis <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
thisiter <- (<|>)
( do
x <- try sep
restAfter <- getInput
when (B.length restAfter >= B.length restThis) empty
pure $ Just (x, restAfter)
)
(anySingle >> pure Nothing)
case thisiter of
(Just (a
x, ByteString
restAfter)) | ByteString -> Int
B.length ByteString
restThis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
B.length ByteString
restBegin -> do
let unmatched :: ByteString
unmatched = Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
restBegin Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
restThis) ByteString
restBegin
(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])
-> m [Either ByteString a] -> m [Either ByteString a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m [Either ByteString a]
go ByteString
restAfter
(Just (a
x, ByteString
restAfter)) -> 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])
-> m [Either ByteString a] -> m [Either ByteString a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m [Either ByteString a]
go ByteString
restAfter
Maybe (a, ByteString)
Nothing -> ByteString -> m [Either ByteString a]
go ByteString
restBegin
)
( do
if ByteString -> Int
B.length ByteString
restBegin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then
[Either ByteString a] -> m [Either ByteString a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString -> Either ByteString a
forall a b. a -> Either a b
Left ByteString
restBegin]
else [Either ByteString a] -> m [Either ByteString a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
)
{-# INLINE [1] anyTillByteString #-}
anyTillByteString
:: forall e s m a. (MonadParsec e s m, s ~ B.ByteString)
=> m a
-> m (Tokens s, a)
anyTillByteString :: forall e s (m :: * -> *) a.
(MonadParsec e s m, s ~ ByteString) =>
m a -> m (Tokens s, a)
anyTillByteString m a
sep = do
begin <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
(end, x) <- go
pure (B.take (B.length begin - B.length end) begin, x)
where
go :: m (ByteString, a)
go = do
end <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
r <- optional $ try sep
case r of
Maybe a
Nothing -> m (Token ByteString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m (Token ByteString) -> m (ByteString, a) -> m (ByteString, a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (ByteString, a)
go
Just a
x -> (ByteString, a) -> m (ByteString, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
end, a
x)