-- |
-- Module    : Replace.Attoparsec.Text.Lazy
-- Copyright : ©2019 James Brock
-- License   : BSD2
-- Maintainer: James Brock <jamesbrock@gmail.com>
--
-- __Replace.Attoparsec__ is for finding text patterns, and also
-- replacing or splitting on the found patterns.
-- This activity is traditionally done with regular expressions,
-- but __Replace.Attoparsec__ uses "Data.Attoparsec" parsers instead for
-- the pattern matching.
--
-- __Replace.Attoparsec__ can be used in the same sort of “pattern capture”
-- or “find all” situations in which one would use Python
-- <https://docs.python.org/3/library/re.html#re.findall re.findall>,
-- or Perl
-- <https://perldoc.perl.org/functions/m.html m//>,
-- or Unix
-- <https://www.gnu.org/software/grep/ grep>.
--
-- __Replace.Attoparsec__ can be used in the same sort of “stream editing”
-- or “search-and-replace” situations in which one would use Python
-- <https://docs.python.org/3/library/re.html#re.sub re.sub>,
-- or Perl
-- <https://perldoc.perl.org/functions/s.html s///>,
-- or Unix
-- <https://www.gnu.org/software/sed/manual/html_node/The-_0022s_0022-Command.html sed>,
-- or
-- <https://www.gnu.org/software/gawk/manual/gawk.html awk>.
--
-- __Replace.Attoparsec__ can be used in the same sort of “string splitting”
-- situations in which one would use Python
-- <https://docs.python.org/3/library/re.html#re.split re.split>
-- or Perl
-- <https://perldoc.perl.org/functions/split.html split>.
--
-- See the __[replace-attoparsec](https://hackage.haskell.org/package/replace-attoparsec)__ package README for usage examples.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Replace.Attoparsec.Text.Lazy
  (
    -- * Running parser
    --
    -- | Functions in this section are /ways to run parsers/
    -- (like 'Data.Attoparsec.Text.Lazy.parse'). They take
    -- as arguments a @sep@ parser and some input, run the parser on the input,
    -- and return a result.
    streamEdit
  , streamEditT
    -- * Parser combinator
    --
    -- | Functions in this section are /parser combinators/. They take
    -- a @sep@ parser for an argument, combine @sep@ with another parser,
    -- and return a new parser.
  , 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

-- |
-- === Stream editor
--
-- Also known as “find-and-replace”, or “match-and-substitute”. Finds all
-- of the sections of the stream which match the pattern @sep@, and replaces
-- them with the result of the @editor@ function.
--
-- ==== Access the matched section of text in the @editor@
--
-- If you want access to the matched string in the @editor@ function,
-- then combine the pattern parser @sep@
-- with 'Data.Attoparsec.Text.match'. This will effectively change
-- the type of the @editor@ function to @(Text,a) -> Text@.
--
-- This allows us to write an @editor@ function which can choose to not
-- edit the match and just leave it as it is. If the @editor@ function
-- returns the first item in the tuple, then @streamEdit@ will not change
-- the matched string.
--
-- So, for all @sep@:
--
-- @
-- streamEdit ('Data.Attoparsec.Text.match' sep) 'Data.Tuple.fst' ≡ 'Data.Function.id'
-- @
--
-- ==== Laziness
--
-- This is lazy in the input text chunks and should release processed chunks to
-- the garbage collector promptly.
--
-- The output is constructed by a 'TB.Builder' and is subject to the chunk size
-- used there.
streamEdit
    :: forall a. Parser a
        -- ^ The pattern matching parser @sep@
    -> (a -> TS.Text)
        -- ^ The @editor@ function. Takes a parsed result of @sep@
        -- and returns a new stream section for the replacement.
    -> T.Text
        -- ^ The input stream of text to be edited
    -> T.Text
        -- ^ The edited input stream
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 #-}


-- |
-- === Stream editor
--
-- Monad transformer version of 'streamEdit'.
--
-- The @editor@ function will run in the underlying monad context.
--
-- If you want to do 'IO' operations in the @editor@ function then
-- run this in 'IO'.
--
-- If you want the @editor@ function to remember some state,
-- then run this in a stateful monad.
--
-- ==== Laziness
--
-- This is lazy in the input text chunks and should release processed chunks to
-- the garbage collector promptly, i.e. as soon as the presence of a @sep@ has
-- been ruled out.
--
-- Note that this is as only as lazy in the chunks as the selected monad allows
-- it to be, i.e. if your monad requires running the entire computation before
-- getting the result then this is effectively strict in the input stream.
--
-- The output is constructed by a 'TB.Builder' and is subject to the chunk size
-- used there.
streamEditT
    :: (Applicative m)
    => Parser a
        -- ^ The pattern matching parser @sep@
    -> (a -> m TS.Text)
        -- ^ The @editor@ function. Takes a parsed result of @sep@
        -- and returns a new stream section for the replacement.
    -> T.Text
        -- ^ The input stream of text to be edited
    -> m T.Text
        -- ^ The edited input stream
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
    -- Our starting parser
    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
      -- We didn't find anything by the end of the stream, return the accumulated
      -- failure text
      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
        -- We didn't find sep or the beginning of sep in this chunk, return the
        -- accumulated failure text as well as this chunk, followed by the
        -- continued edited stream
        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
        -- We found the beginning of sep, add to the failure text in case this
        -- isn't really sep and recurse on the remainder of the stream
        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
        -- We found sep, return the concatenation of the text until sep, the
        -- edited sep and the edited rest of the stream.
        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 #-}


-- |
-- === Specialized <http://hackage.haskell.org/package/parser-combinators/docs/Control-Monad-Combinators.html#v:manyTill_ manyTill_>
--
-- Parser combinator to consume and capture input until the @sep@ pattern
-- matches, equivalent to
-- @'Control.Monad.Combinators.manyTill_' 'Data.Attoparsec.Text.anyChar' sep@.
-- On success, returns the prefix before the pattern match and the parsed match.
--
-- @sep@ may be a zero-width parser, it may succeed without consuming any
-- input.
--
-- This combinator will produce a parser which acts
-- like 'Data.Attoparsec.Text.takeTill' but is predicated beyond more than
-- just the next one token. It is also like
-- 'Data.Attoparsec.Text.takeTill' in that it is a “high performance” parser.
--
-- ==== Laziness
--
-- When the 'anyTill' parser reaches the end of the current input chunk
-- before finding the beginning of @sep@ then the parser will fail.
--
-- When the 'anyTill' parser reaches the end of the current input chunk
-- while it is successfully parsing @sep@ then it will lazily fetch more
-- input and continue parsing.
anyTill
    :: Parser a -- ^ The pattern matching parser @sep@
    -> Parser (T.Text, a) -- ^ parser
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)

-- | Always succeeds, returns 'True' if the parser is at the end of the current
-- buffer and any additional input would require a 'TI.Partial' result.
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)

-- Get the 'Data.Attoparsec.Internal.Types.Parser' current offset
-- 'Data.Attoparsec.Internal.Types.Pos' in the stream.
--
-- Note that this is not the number of 'Data.Char's which have been consumed,
-- rather it is an offset into the underlying 'Data.Text.Internal.Text'
-- array buffer, so you cannot use it as an argument to 'Data.Text.index'.
-- But you /can/ use it as an argument to 'Data.Text.Internal.text'.
--
-- [“… you know you're in an uncomfortable state of sin :-)” — bos](https://github.com/bos/attoparsec/issues/101)
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 #-}


-- Extract a substring from part of the buffer that we've already visited.
--
-- The idea here is that we go back and run the parser 'take' at the Pos
-- which we saved from before, and then we continue from the current Pos,
-- hopefully without messing up the internal parser state.
-- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.Text.Internal.html#take
--
-- Should be equivalent to the unexported function
-- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.Text.Internal.html#substring
--
-- This is a performance optimization for gathering the unmatched
-- sections of the input. The alternative is to accumulate unmatched
-- characters one anyChar at a time in a list of [Char] and then pack
-- them into a Text.
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
    -- Dear reader, you deserve an explanation for 'takeCheat'. The
    -- alternative to running 'takeCheat' here would be the following line:
    --
    -- AT.runParser (A.take (end - bgn)) t (AT.Pos bgn) more lose succes'
    --
    -- But 'Attoparsec.take' is not correct, and 'takeCheat' is correct.
    -- It is correct because the Pos which we got from 'getOffset' is an
    -- index into the underlying Data.Text.Array, so (end - bgn) is
    -- in units of the length of the Data.Text.Array, not in units of the
    -- number of Chars.
    --
    -- Furthermore 'takeCheat' is a lot faster because 'A.take' takes a
    -- number of Chars and then iterates over the Text by the number
    -- of Chars, advancing by 4 bytes when it encounters a wide Char.
    -- So, O(N). takeCheat is O(1).
    --
    -- This will be fine as long as we always call 'takeCheat' on the
    -- immutable, already-visited part of the Attoparsec.Text.Buffer's
    -- Data.Text.Array. Which we do.
    --
    -- It's named 'takeCheat' because we're getting access to
    -- the Attoparsec.Text.Buffer through the Data.Text.Internal
    -- interface, even though Attoparsec is extremely vigilant about
    -- not exposing its buffers.
    --
    -- http://hackage.haskell.org/package/text-1.2.3.1/docs/Data-Text-Internal.html
    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)


--
-- These are from the latest version of attoparsec, remove them when bumping it
-- to 0.14.0 or later and use A.parseOnly instead
--

-- | Convert a 'Result' value to an 'Either' value.
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)

-- | Run a parser and convert its 'Result' to an 'Either' value.
--
-- This function does not force a parser to consume all of its input.
-- Instead, any residual input will be discarded.  To force a parser
-- to consume all of its input, use something like this:
--
-- @
--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
-- @
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 #-}