-- |
-- Module    : Replace.Megaparsec.Internal.ByteString
-- Copyright : ©2019 James Brock
-- License   : BSD2
-- Maintainer: James Brock <jamesbrock@gmail.com>
--
-- This internal module is for 'Data.ByteString.ByteString' specializations.
--
-- The functions in this module are intended to be chosen automatically
-- by rewrite rules in the "Replace.Megaparsec" module, so you should never
-- need to import this module.
--
-- Names in this module may change without a major version increment.

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module Replace.Megaparsec.Internal.ByteString
  (
    -- * Parser combinator
    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 -- ^ The pattern matching parser @sep@
    -> m [Either (Tokens s) a]
sepCapByteString :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m [Either ByteString a]
go
  where
    -- the go function will search for the first pattern match,
    -- and then capture the pattern match along with the preceding
    -- unmatched string, and then recurse.
    -- restBegin is the rest of the buffer after the last pattern
    -- match.
    go :: ByteString -> m [Either ByteString a]
go ByteString
restBegin = do
        m [Either ByteString a]
-> m [Either ByteString a] -> m [Either ByteString a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
            ( do
                ByteString
restThis <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
                -- About 'thisiter':
                -- It looks stupid and introduces a completely unnecessary
                -- Maybe, but when I refactor to eliminate 'thisiter' and
                -- the Maybe then the benchmarks get dramatically worse.
                Maybe (a, ByteString)
thisiter <- m (Maybe (a, ByteString))
-> m (Maybe (a, ByteString)) -> m (Maybe (a, ByteString))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
                    ( do
                        a
x <- m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m a
sep
                        ByteString
restAfter <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
                        -- Don't allow a match of a zero-width pattern
                        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
restAfter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
B.length ByteString
restThis) m ()
forall (f :: * -> *) a. Alternative f => f a
empty
                        Maybe (a, ByteString) -> m (Maybe (a, ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, ByteString) -> m (Maybe (a, ByteString)))
-> Maybe (a, ByteString) -> m (Maybe (a, ByteString))
forall a b. (a -> b) -> a -> b
$ (a, ByteString) -> Maybe (a, ByteString)
forall a. a -> Maybe a
Just (a
x, ByteString
restAfter)
                    )
                    (m Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m Word8 -> m (Maybe (a, ByteString)) -> m (Maybe (a, ByteString))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (a, ByteString) -> m (Maybe (a, ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, ByteString)
forall a. Maybe a
Nothing)
                case Maybe (a, ByteString)
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
                        -- we've got a match with some preceding unmatched string
                        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
                        -- we're got a match with no preceding unmatched string
                        (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 -- no match, try again
            )
            ( do
                -- We're at the end of the input, so return
                -- whatever unmatched string we've got since offsetBegin
                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 (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 (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 -- ^ The pattern matching parser @sep@
    -> m (Tokens s, a)
anyTillByteString :: m a -> m (Tokens s, a)
anyTillByteString m a
sep = do
    ByteString
begin <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
    (ByteString
end, a
x) <- m (ByteString, a)
go
    (ByteString, a) -> m (ByteString, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
begin Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
end) ByteString
begin, a
x)
  where
    go :: m (ByteString, a)
go = do
      ByteString
end <- m ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
      Maybe a
r <- m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m a -> m (Maybe a)) -> m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m a
sep
      case Maybe a
r of
        Maybe a
Nothing -> m Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m Word8 -> m (ByteString, a) -> m (ByteString, a)
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 (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
end, a
x)