\begin{code}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE CPP                        #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif

module Text.RE.Tools.Edit
  (
  -- * Editing
  -- $tutorial
    Edits(..)
  , Edit(..)
  , LineEdit(..)
  , applyEdits
  , applyEdit
  , applyLineEdit
  -- * IsRegex
  , IsRegex(..)
  , SearchReplace(..)
  , searchReplaceAll
  , searchReplaceFirst
  -- * LineNo
  , LineNo(..)
  , firstLine
  , getLineNo
  , lineNo
  -- * Replace
  , module Text.RE.Replace
  ) where

import           Data.Maybe
import           Prelude.Compat
import           Text.RE.Replace
import           Text.RE.Tools.IsRegex
import           Text.RE.ZeInternals.Types.LineNo
\end{code}


\begin{code}
-- | an 'Edits' script will, for each line in the file, either perform
-- the action selected by the first RE in the list, or perform all of the
-- actions on line, arranged as a pipeline
data Edits m re s
  = Select ![Edit m re s]   -- ^ for each line select the first @Edit@ to match each line and edit the line with it
  | Pipe   ![Edit m re s]   -- ^ for each line apply every edit that matches in turn to the line

-- | each Edit action specifies how the match should be processed
data Edit m re s
  = Template !(SearchReplace re s)
        -- ^ replace the match with this template text, substituting ${capture} as apropriate
  | Function !re REContext !(LineNo->Match s->RELocation->Capture s->m (Maybe s))
        -- ^ use this function to replace the 'REContext' specified captures in each line matched
  | LineEdit !re           !(LineNo->Matches s->m (LineEdit s))
        -- ^ use this function to edit each line matched

-- | a LineEdit is the most general action thar can be performed on a line
-- and is the only means of deleting a line
data LineEdit s
  = NoEdit                  -- ^ do not edit this line but leave as is
  | ReplaceWith !s          -- ^ replace the line with this text (terminating newline should not be included)
  | Delete                  -- ^ delete the this line altogether
  deriving (a -> LineEdit b -> LineEdit a
(a -> b) -> LineEdit a -> LineEdit b
(forall a b. (a -> b) -> LineEdit a -> LineEdit b)
-> (forall a b. a -> LineEdit b -> LineEdit a) -> Functor LineEdit
forall a b. a -> LineEdit b -> LineEdit a
forall a b. (a -> b) -> LineEdit a -> LineEdit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LineEdit b -> LineEdit a
$c<$ :: forall a b. a -> LineEdit b -> LineEdit a
fmap :: (a -> b) -> LineEdit a -> LineEdit b
$cfmap :: forall a b. (a -> b) -> LineEdit a -> LineEdit b
Functor,Int -> LineEdit s -> ShowS
[LineEdit s] -> ShowS
LineEdit s -> String
(Int -> LineEdit s -> ShowS)
-> (LineEdit s -> String)
-> ([LineEdit s] -> ShowS)
-> Show (LineEdit s)
forall s. Show s => Int -> LineEdit s -> ShowS
forall s. Show s => [LineEdit s] -> ShowS
forall s. Show s => LineEdit s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineEdit s] -> ShowS
$cshowList :: forall s. Show s => [LineEdit s] -> ShowS
show :: LineEdit s -> String
$cshow :: forall s. Show s => LineEdit s -> String
showsPrec :: Int -> LineEdit s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> LineEdit s -> ShowS
Show)
\end{code}


\begin{code}
-- | apply an 'Edit' script to a single line
applyEdits :: (IsRegex re s,Monad m,Functor m)
           => LineNo
           -> Edits m re s
           -> s
           -> m s
applyEdits :: LineNo -> Edits m re s -> s -> m s
applyEdits LineNo
lno Edits m re s
ez0 s
s0 = case Edits m re s
ez0 of
  Select [Edit m re s]
ez -> LineNo -> [Edit m re s] -> s -> m s
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
LineNo -> [Edit m re s] -> s -> m s
select_edit_scripts LineNo
lno [Edit m re s]
ez s
s0
  Pipe   [Edit m re s]
ez -> LineNo -> [Edit m re s] -> s -> m s
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
LineNo -> [Edit m re s] -> s -> m s
pipe_edit_scripts   LineNo
lno [Edit m re s]
ez s
s0

-- | apply a single edit action to a line, the function in the first argument
-- being used to add a new line onto the end of the line where appropriate;
-- the function returns @Nothing@ if no edit is to be performed on the line,
-- @Just mempty@ to delete the line
applyEdit :: (IsRegex re s,Monad m,Functor m)
          => (s->s)
          -> LineNo
          -> Edit m re s
          -> s
          -> m (Maybe s)
applyEdit :: (s -> s) -> LineNo -> Edit m re s -> s -> m (Maybe s)
applyEdit s -> s
anl LineNo
lno Edit m re s
edit s
s =
  case Matches s -> [Match s]
forall a. Matches a -> [Match a]
allMatches Matches s
acs of
    [] -> Maybe s -> m (Maybe s)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe s
forall a. Maybe a
Nothing
    [Match s]
_  -> (s -> Maybe s) -> m s -> m (Maybe s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Maybe s
forall a. a -> Maybe a
Just (m s -> m (Maybe s)) -> m s -> m (Maybe s)
forall a b. (a -> b) -> a -> b
$ case Edit m re s
edit of
      Template SearchReplace re s
srch_rpl -> s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ s -> s
anl (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s -> Matches s -> s
forall a. Replace a => a -> Matches a -> a
replaceAll (SearchReplace re s -> s
forall re s. SearchReplace re s -> s
getTemplate SearchReplace re s
srch_rpl)       Matches s
acs
      Function re
_ REContext
ctx LineNo -> Match s -> RELocation -> Capture s -> m (Maybe s)
f  -> s -> s
anl (s -> s) -> m s -> m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReplaceMethods s
-> REContext
-> (Match s -> RELocation -> Capture s -> m (Maybe s))
-> Matches s
-> m s
forall a (m :: * -> *).
(Extract a, Monad m) =>
ReplaceMethods a
-> REContext
-> (Match a -> RELocation -> Capture a -> m (Maybe a))
-> Matches a
-> m a
replaceAllCapturesM ReplaceMethods s
forall a. Replace a => ReplaceMethods a
replaceMethods REContext
ctx (LineNo -> Match s -> RELocation -> Capture s -> m (Maybe s)
f LineNo
lno) Matches s
acs
      LineEdit re
_     LineNo -> Matches s -> m (LineEdit s)
g  -> s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe (s -> s
anl s
s) (Maybe s -> s) -> (LineEdit s -> Maybe s) -> LineEdit s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> s) -> LineEdit s -> Maybe s
forall s. Monoid s => (s -> s) -> LineEdit s -> Maybe s
applyLineEdit s -> s
anl (LineEdit s -> s) -> m (LineEdit s) -> m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LineNo -> Matches s -> m (LineEdit s)
g LineNo
lno        Matches s
acs
  where
    acs :: Matches s
acs = re -> s -> Matches s
forall re s. IsRegex re s => re -> s -> Matches s
matchMany re
rex s
s
    rex :: re
rex = case Edit m re s
edit of
      Template SearchReplace re s
srch_rpl -> SearchReplace re s -> re
forall re s. SearchReplace re s -> re
getSearch SearchReplace re s
srch_rpl
      Function re
rex_ REContext
_ LineNo -> Match s -> RELocation -> Capture s -> m (Maybe s)
_ -> re
rex_
      LineEdit re
rex_   LineNo -> Matches s -> m (LineEdit s)
_ -> re
rex_


-- | apply a 'LineEdit' to a line, using the function in the first
-- argument to append a new line to the result; Nothing should be
-- returned if no edit is to be performed,  @Just mempty@ to
-- delete the line
applyLineEdit :: Monoid s => (s->s) -> LineEdit s -> Maybe s
applyLineEdit :: (s -> s) -> LineEdit s -> Maybe s
applyLineEdit s -> s
_    LineEdit s
NoEdit         = Maybe s
forall a. Maybe a
Nothing
applyLineEdit s -> s
anl (ReplaceWith s
s) = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ s -> s
anl s
s
applyLineEdit s -> s
_    LineEdit s
Delete         = s -> Maybe s
forall a. a -> Maybe a
Just   s
forall a. Monoid a => a
mempty

select_edit_scripts :: (IsRegex re s,Monad m,Functor m)
                    => LineNo
                    -> [Edit m re s]
                    -> s
                    -> m s
select_edit_scripts :: LineNo -> [Edit m re s] -> s -> m s
select_edit_scripts LineNo
lno [Edit m re s]
ps0 s
s = [Edit m re s] -> m s
forall (m :: * -> *) re.
(Monad m, IsRegex re s) =>
[Edit m re s] -> m s
select [Edit m re s]
ps0
  where
    select :: [Edit m re s] -> m s
select []           = s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ s -> s
forall a. Replace a => a -> a
appendNewlineR s
s
    select (Edit m re s
edit:[Edit m re s]
edits) =
      (s -> s) -> LineNo -> Edit m re s -> s -> m (Maybe s)
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
(s -> s) -> LineNo -> Edit m re s -> s -> m (Maybe s)
applyEdit s -> s
forall a. Replace a => a -> a
appendNewlineR LineNo
lno Edit m re s
edit s
s m (Maybe s) -> (Maybe s -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m s -> (s -> m s) -> Maybe s -> m s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Edit m re s] -> m s
select [Edit m re s]
edits) s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return

pipe_edit_scripts :: (IsRegex re s,Monad m,Functor m)
                  => LineNo
                  -> [Edit m re s]
                  -> s
                  -> m s
pipe_edit_scripts :: LineNo -> [Edit m re s] -> s -> m s
pipe_edit_scripts LineNo
lno [Edit m re s]
edits s
s0 =
    s -> s
forall a. Replace a => a -> a
appendNewlineR (s -> s) -> m s -> m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Edit m re s -> m s -> m s) -> m s -> [Edit m re s] -> m s
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Edit m re s -> m s -> m s
forall (m :: * -> *) re b.
(Monad m, IsRegex re b) =>
Edit m re b -> m b -> m b
f (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
s0) [Edit m re s]
edits
  where
    f :: Edit m re b -> m b -> m b
f Edit m re b
edit m b
act = do
      b
s <- m b
act
      b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
s (Maybe b -> b) -> m (Maybe b) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> b) -> LineNo -> Edit m re b -> b -> m (Maybe b)
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
(s -> s) -> LineNo -> Edit m re s -> s -> m (Maybe s)
applyEdit b -> b
forall a. a -> a
id LineNo
lno Edit m re b
edit b
s
\end{code}

\begin{code}
-- $tutorial
-- The Edit toolkit looks for REs that match a text and runs the
-- associated actions.
--
-- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
\end{code}