{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Replace.Megaparsec.Internal.Text
(
sepCapText
, anyTillText
)
where
import Control.Monad
import qualified Data.Text as T
import Data.Text.Internal (Text(..))
import Text.Megaparsec
{-# INLINE [1] sepCapText #-}
sepCapText
:: forall e s m a. (MonadParsec e s m, s ~ T.Text)
=> m a
-> m [Either (Tokens s) a]
sepCapText :: forall e s (m :: * -> *) a.
(MonadParsec e s m, s ~ Text) =>
m a -> m [Either (Tokens s) a]
sepCapText m a
sep = m Text
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput m Text -> (Text -> m [Either Text a]) -> m [Either Text a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> m [Either Text a]
go
where
go :: Text -> m [Either Text a]
go restBegin :: Text
restBegin@(Text Array
tarray Int
beginIndx Int
beginLen) = do
m [Either Text a] -> m [Either Text a] -> m [Either Text a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
( do
(Text _ _ thisLen) <- m Text
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
thisiter <- (<|>)
( do
x <- try sep
restAfter@(Text _ _ afterLen) <- getInput
when (afterLen >= thisLen) empty
pure $ Just (x, restAfter)
)
(anySingle >> pure Nothing)
case thisiter of
(Just (a
x, Text
restAfter)) | Int
thisLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
beginLen -> do
let unmatched :: Text
unmatched = Array -> Int -> Int -> Text
Text Array
tarray Int
beginIndx (Int
beginLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
thisLen)
(Text -> Either Text a
forall a b. a -> Either a b
Left Text
unmatchedEither Text a -> [Either Text a] -> [Either Text a]
forall a. a -> [a] -> [a]
:) ([Either Text a] -> [Either Text a])
-> ([Either Text a] -> [Either Text a])
-> [Either Text a]
-> [Either Text a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Either Text a
forall a b. b -> Either a b
Right a
xEither Text a -> [Either Text a] -> [Either Text a]
forall a. a -> [a] -> [a]
:) ([Either Text a] -> [Either Text a])
-> m [Either Text a] -> m [Either Text a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m [Either Text a]
go Text
restAfter
(Just (a
x, Text
restAfter)) -> do
(a -> Either Text a
forall a b. b -> Either a b
Right a
xEither Text a -> [Either Text a] -> [Either Text a]
forall a. a -> [a] -> [a]
:) ([Either Text a] -> [Either Text a])
-> m [Either Text a] -> m [Either Text a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m [Either Text a]
go Text
restAfter
Maybe (a, Text)
Nothing -> Text -> m [Either Text a]
go Text
restBegin
)
( do
if Int
beginLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then
[Either Text a] -> m [Either Text a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Either Text a
forall a b. a -> Either a b
Left Text
restBegin]
else [Either Text a] -> m [Either Text a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
)
{-# INLINE [1] anyTillText #-}
anyTillText
:: forall e s m a. (MonadParsec e s m, s ~ T.Text)
=> m a
-> m (Tokens s, a)
anyTillText :: forall e s (m :: * -> *) a.
(MonadParsec e s m, s ~ Text) =>
m a -> m (Tokens s, a)
anyTillText m a
sep = do
(Text tarray beginIndx beginLen) <- m Text
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
(thisLen, x) <- go
pure (Text tarray beginIndx (beginLen - thisLen), x)
where
go :: m (Int, a)
go = do
(Text _ _ thisLen) <- m Text
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
r <- optional $ try sep
case r of
Maybe a
Nothing -> m (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m (Token Text) -> m (Int, a) -> m (Int, a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Int, a)
go
Just a
x -> (Int, a) -> m (Int, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
thisLen, a
x)