\begin{code}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE CPP                        #-}

module Text.RE.Tools.Grep
  (
  -- Grep
  -- $tutorial
    grep
  , Verbosity(..)
  , Line(..)
  , grepLines
  , grepFilter
  , GrepScript
  , grepWithScript
  , report
  , linesMatched
  -- * 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.Printf
import           Text.RE.Replace
import           Text.RE.Tools.IsRegex
import           Text.RE.ZeInternals.Types.LineNo
\end{code}


\begin{code}
-- | operates a bit like classic @grep@ printing out the lines matched
grep :: IsRegex re LBS.ByteString => Verbosity -> re -> FilePath -> IO ()
grep :: Verbosity -> re -> FilePath -> IO ()
grep Verbosity
v re
rex FilePath
fp = re -> FilePath -> IO [Line ByteString]
forall re.
IsRegex re ByteString =>
re -> FilePath -> IO [Line ByteString]
grepLines re
rex FilePath
fp IO [Line ByteString] -> ([Line ByteString] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO ()
putStr (FilePath -> IO ())
-> ([Line ByteString] -> FilePath) -> [Line ByteString] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> [Line ByteString] -> FilePath
report Verbosity
v
\end{code}

\begin{code}
-- | specifies whether to return the lines matched or missed
data Verbosity
  = LinesMatched
  | LinesNotMatched
  deriving (Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> FilePath
(Int -> Verbosity -> ShowS)
-> (Verbosity -> FilePath)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> FilePath
$cshow :: Verbosity -> FilePath
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show,Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq,Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord)
\end{code}

\begin{code}
-- | 'grepLines' returns a 'Line' for each line in the file, listing all
-- of the 'Matches' for that line
data Line s =
  Line
    { Line s -> LineNo
getLineNumber  :: LineNo    -- ^ the 'LineNo' for this line
    , Line s -> Matches s
getLineMatches :: Matches s -- ^ all the 'Matches' of the RE on this line
    }
  deriving (Int -> Line s -> ShowS
[Line s] -> ShowS
Line s -> FilePath
(Int -> Line s -> ShowS)
-> (Line s -> FilePath) -> ([Line s] -> ShowS) -> Show (Line s)
forall s. Show s => Int -> Line s -> ShowS
forall s. Show s => [Line s] -> ShowS
forall s. Show s => Line s -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Line s] -> ShowS
$cshowList :: forall s. Show s => [Line s] -> ShowS
show :: Line s -> FilePath
$cshow :: forall s. Show s => Line s -> FilePath
showsPrec :: Int -> Line s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> Line s -> ShowS
Show)
\end{code}

\begin{code}
-- | returns a 'Line' for each line in the file, enumerating all of the
-- matches for that line
grepLines :: IsRegex re LBS.ByteString
          => re
          -> FilePath
          -> IO [Line LBS.ByteString]
grepLines :: re -> FilePath -> IO [Line ByteString]
grepLines re
rex FilePath
fp = re -> ByteString -> [Line ByteString]
forall re s. IsRegex re s => re -> s -> [Line s]
grepFilter re
rex (ByteString -> [Line ByteString])
-> IO ByteString -> IO [Line ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
LBS.readFile FilePath
fp
\end{code}

\begin{code}
-- | returns a 'Line' for each line in the argument text, enumerating
-- all of the matches for that line
grepFilter :: IsRegex re s => re -> s -> [Line s]
grepFilter :: re -> s -> [Line s]
grepFilter re
rex = GrepScript re s (Line s) -> [s] -> [Line s]
forall re s t. IsRegex re s => GrepScript re s t -> [s] -> [t]
grepWithScript [(re
rex,LineNo -> Matches s -> Maybe (Line s)
forall s. LineNo -> Matches s -> Maybe (Line s)
mk)] ([s] -> [Line s]) -> (s -> [s]) -> s -> [Line s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [s]
forall a. Replace a => a -> [a]
linesR
  where
    mk :: LineNo -> Matches s -> Maybe (Line s)
mk LineNo
i Matches s
mtchs = Line s -> Maybe (Line s)
forall a. a -> Maybe a
Just (Line s -> Maybe (Line s)) -> Line s -> Maybe (Line s)
forall a b. (a -> b) -> a -> b
$ LineNo -> Matches s -> Line s
forall s. LineNo -> Matches s -> Line s
Line LineNo
i Matches s
mtchs
\end{code}

\begin{code}
-- | a GrepScript lists RE-action associations, with the first RE to match
-- a line selecting the action to be executed on each line in the file
type GrepScript re s t = [(re,LineNo -> Matches s -> Maybe t)]

-- | given a list of lines, apply the 'GrepScript' to each line of the file
grepWithScript :: IsRegex re s => GrepScript re s t -> [s] -> [t]
grepWithScript :: GrepScript re s t -> [s] -> [t]
grepWithScript GrepScript re s t
scr = LineNo -> [s] -> [t]
loop LineNo
firstLine
  where
    loop :: LineNo -> [s] -> [t]
loop LineNo
_ []       = []
    loop LineNo
i (s
ln:[s]
lns) = LineNo -> [t] -> [t]
seq LineNo
i ([t] -> [t]) -> [t] -> [t]
forall a b. (a -> b) -> a -> b
$ LineNo -> s -> [s] -> GrepScript re s t -> [t]
choose LineNo
i s
ln [s]
lns GrepScript re s t
scr

    choose :: LineNo -> s -> [s] -> GrepScript re s t -> [t]
choose LineNo
i s
_  [s]
lns []             = LineNo -> [s] -> [t]
loop (LineNo -> LineNo
forall a. Enum a => a -> a
succ LineNo
i) [s]
lns
    choose LineNo
i s
ln [s]
lns ((re
rex,LineNo -> Matches s -> Maybe t
f):GrepScript re s t
scr') = case LineNo -> Matches s -> Maybe t
f LineNo
i (Matches s -> Maybe t) -> Matches s -> Maybe t
forall a b. (a -> b) -> a -> b
$ re -> s -> Matches s
forall re s. IsRegex re s => re -> s -> Matches s
matchMany re
rex s
ln of
      Maybe t
Nothing -> LineNo -> s -> [s] -> GrepScript re s t -> [t]
choose LineNo
i s
ln [s]
lns GrepScript re s t
scr'
      Just t
t  -> t
t t -> [t] -> [t]
forall a. a -> [a] -> [a]
: LineNo -> [s] -> [t]
loop (LineNo -> LineNo
forall a. Enum a => a -> a
succ LineNo
i) [s]
lns

-- | generate a grep report from a list of 'Line'
report :: Verbosity -> [Line LBS.ByteString] -> String
report :: Verbosity -> [Line ByteString] -> FilePath
report Verbosity
v = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ([Line ByteString] -> [FilePath])
-> [Line ByteString]
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line ByteString -> FilePath) -> [Line ByteString] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Line ByteString -> FilePath
forall t. PrintfType t => Line ByteString -> t
fmt ([Line ByteString] -> [FilePath])
-> ([Line ByteString] -> [Line ByteString])
-> [Line ByteString]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> [Line ByteString] -> [Line ByteString]
forall s. Verbosity -> [Line s] -> [Line s]
linesMatched Verbosity
v
  where
    fmt :: Line ByteString -> t
fmt Line{LineNo
Matches ByteString
getLineMatches :: Matches ByteString
getLineNumber :: LineNo
getLineMatches :: forall s. Line s -> Matches s
getLineNumber :: forall s. Line s -> LineNo
..} =
      FilePath -> Int -> FilePath -> t
forall r. PrintfType r => FilePath -> r
printf FilePath
"%05d %s" (LineNo -> Int
getLineNo LineNo
getLineNumber) (FilePath -> t) -> FilePath -> t
forall a b. (a -> b) -> a -> b
$
          ByteString -> FilePath
LBS.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ Matches ByteString -> ByteString
forall a. Matches a -> a
matchesSource Matches ByteString
getLineMatches

-- | given a 'velocity' flag filter out either the lines matched or not
-- matched
linesMatched :: Verbosity -> [Line s] -> [Line s]
linesMatched :: Verbosity -> [Line s] -> [Line s]
linesMatched Verbosity
v = (Line s -> Bool) -> [Line s] -> [Line s]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Line s -> Bool) -> [Line s] -> [Line s])
-> (Line s -> Bool) -> [Line s] -> [Line s]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
f (Bool -> Bool) -> (Line s -> Bool) -> Line s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matches s -> Bool
forall a. Matches a -> Bool
anyMatches (Matches s -> Bool) -> (Line s -> Matches s) -> Line s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line s -> Matches s
forall s. Line s -> Matches s
getLineMatches
  where
    f :: Bool -> Bool
f = case Verbosity
v of
      Verbosity
LinesMatched    -> Bool -> Bool
forall a. a -> a
id
      Verbosity
LinesNotMatched -> Bool -> Bool
not
\end{code}

\begin{code}
-- $tutorial
-- The Grep toolkit matches REs against each line of a text.
--
-- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
\end{code}