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

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

import qualified Data.ByteString.Lazy.Char8               as LBS
import           Prelude.Compat
import           Text.RE.Replace
import           Text.RE.Tools.Edit
\end{code}


\begin{code}
-- | read a file, apply an 'Edits' script to each line it and
-- write the file out again; "-" is used to indicate standard input
-- standard output as appropriate
sed :: IsRegex re LBS.ByteString
    => Edits IO re LBS.ByteString
    -> FilePath
    -> FilePath
    -> IO ()
sed :: Edits IO re ByteString -> FilePath -> FilePath -> IO ()
sed Edits IO re ByteString
escr FilePath
i_fp FilePath
o_fp = do
  [ByteString]
lns  <- ByteString -> [ByteString]
LBS.lines (ByteString -> [ByteString]) -> IO ByteString -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
read_file FilePath
i_fp
  [ByteString]
lns' <- [IO ByteString] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
    [ LineNo -> Edits IO re ByteString -> ByteString -> IO ByteString
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
LineNo -> Edits m re s -> s -> m s
applyEdits LineNo
lno Edits IO re ByteString
escr ByteString
s
        | (LineNo
lno,ByteString
s)<-[LineNo] -> [ByteString] -> [(LineNo, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LineNo
firstLine..] [ByteString]
lns
        ]
  FilePath -> ByteString -> IO ()
write_file FilePath
o_fp (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
LBS.concat [ByteString]
lns'
\end{code}


\begin{code}
-- | apply an 'Edits' script to each line of the argument text
sed' :: (IsRegex re a,Monad m,Functor m)
     => Edits m re a
     -> a
     -> m a
sed' :: Edits m re a -> a -> m a
sed' Edits m re a
escr a
t = do
  [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> m [a] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
    [ LineNo -> Edits m re a -> a -> m a
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
LineNo -> Edits m re s -> s -> m s
applyEdits LineNo
lno Edits m re a
escr a
s
        | (LineNo
lno,a
s)<-[LineNo] -> [a] -> [(LineNo, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LineNo
firstLine..] ([a] -> [(LineNo, a)]) -> [a] -> [(LineNo, a)]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. Replace a => a -> [a]
linesR a
t
        ]
\end{code}


\begin{code}
read_file :: FilePath -> IO LBS.ByteString
read_file :: FilePath -> IO ByteString
read_file FilePath
"-" = IO ByteString
LBS.getContents
read_file FilePath
fp  = FilePath -> IO ByteString
LBS.readFile FilePath
fp

write_file :: FilePath -> LBS.ByteString ->IO ()
write_file :: FilePath -> ByteString -> IO ()
write_file FilePath
"-" = ByteString -> IO ()
LBS.putStr
write_file FilePath
fp  = FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
fp
\end{code}


\begin{code}
-- $tutorial
-- The Sed toolkit applyies @Edits@ scripts to each line
-- of a text, running the actions and adjusting each line
-- accordingly.
--
-- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
\end{code}