-- | Utilities for invoking @grep@
{-# LANGUAGE Rank2Types #-}
module Vgrep.System.Grep
    ( grep
    , grepForApp
    , recursiveGrep
    , grepVersion
    ) where

import           Control.Concurrent
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Maybe
import           Data.Text              (Text)
import qualified Data.Text              as T
import           Pipes                  as P
import qualified Pipes.Prelude          as P
import           System.Environment     (getArgs)
import           System.Exit
import           System.Process

import Vgrep.Parser

import System.IO

-- | Like 'grep', but if the input is not prefixed with a file and line
-- number, i. e. is not valid @grep -nH@ output, then adds @-nH@ (@-n@:
-- with line number, @-H@: with file name) to the @grep@ command line
-- arguments.
grepForApp :: Producer Text IO () -> Producer Text IO ()
grepForApp :: Producer Text IO () -> Producer Text IO ()
grepForApp Producer Text IO ()
input = do
    (Maybe Text
firstInputLine, Producer Text IO ()
input') <- Producer Text IO ()
-> Producer Text IO (Maybe Text, Producer Text IO ())
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> Producer a m (Maybe a, Producer a m r)
peek Producer Text IO ()
input
    Bool -> Producer Text IO () -> Producer Text IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
firstInputLine) (IO () -> Producer Text IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
forall a. IO a
exitFailure)
    case Maybe Text
firstInputLine Maybe Text
-> (Text -> Maybe FileLineReference) -> Maybe FileLineReference
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe FileLineReference
parseLine of
        Just FileLineReference
_line -> Producer Text IO () -> Producer Text IO ()
grep Producer Text IO ()
input'
        Maybe FileLineReference
Nothing    -> Producer Text IO () -> Producer Text IO ()
grepWithFileAndLineNumber Producer Text IO ()
input'

grepWithFileAndLineNumber :: Producer Text IO () -> Producer Text IO ()
grepWithFileAndLineNumber :: Producer Text IO () -> Producer Text IO ()
grepWithFileAndLineNumber Producer Text IO ()
input = do
    [String]
args <- IO [String] -> Proxy X () () Text IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getArgs
    [String] -> Producer Text IO () -> Producer Text IO ()
grepPipe (String
withFileName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
withLineNumber String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args) Producer Text IO ()
input

-- | Takes a 'Text' stream and runs it through a @grep@ process, returning
-- a stream of results. The original command line arguments are passed to
-- the process.
grep :: Producer Text IO () -> Producer Text IO ()
grep :: Producer Text IO () -> Producer Text IO ()
grep Producer Text IO ()
input = do
    [String]
args <- IO [String] -> Proxy X () () Text IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getArgs
    [String] -> Producer Text IO () -> Producer Text IO ()
grepPipe [String]
args Producer Text IO ()
input

grepPipe :: [String] -> Producer Text IO () -> Producer Text IO ()
grepPipe :: [String] -> Producer Text IO () -> Producer Text IO ()
grepPipe [String]
args Producer Text IO ()
input = do
    (Handle
hIn, Handle
hOut) <- [String] -> Proxy X () () Text IO (Handle, Handle)
forall (io :: * -> *).
MonadIO io =>
[String] -> io (Handle, Handle)
createGrepProcess (String
lineBuffered String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
colorized String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)
    ThreadId
_threadId <- IO ThreadId -> Proxy X () () Text IO ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Proxy X () () Text IO ThreadId)
-> (Effect IO () -> IO ThreadId)
-> Effect IO ()
-> Proxy X () () Text IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> (Effect IO () -> IO ()) -> Effect IO () -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect IO () -> IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect IO () -> Proxy X () () Text IO ThreadId)
-> Effect IO () -> Proxy X () () Text IO ThreadId
forall a b. (a -> b) -> a -> b
$ Producer Text IO ()
input Producer Text IO () -> Proxy () Text () X IO () -> Effect IO ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Handle -> Consumer' Text IO ()
forall (m :: * -> *). MonadIO m => Handle -> Consumer' Text m ()
textToHandle Handle
hIn
    Handle -> Producer Text IO ()
streamResultsFrom Handle
hOut

-- | Invokes @grep -nH -rI@ (@-n@: with line number, @-H@: with file name,
-- @-r@: recursive, @-I@: ignore binary files) and returns the results as a
-- stream. More arguments (e. g. pattern and directory) are taken from the
-- command line.
recursiveGrep :: Producer Text IO ()
recursiveGrep :: Producer Text IO ()
recursiveGrep = do
    [String]
args <- IO [String] -> Proxy X () () Text IO [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO [String]
getArgs
    let grepArgs :: [String]
grepArgs = String
recursive
                 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
withFileName
                 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
withLineNumber
                 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
skipBinaryFiles
                 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
lineBuffered
                 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
colorized
                 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
    (Handle
_hIn, Handle
hOut) <- [String] -> Proxy X () () Text IO (Handle, Handle)
forall (io :: * -> *).
MonadIO io =>
[String] -> io (Handle, Handle)
createGrepProcess [String]
grepArgs
    Handle -> Producer Text IO ()
streamResultsFrom Handle
hOut

grepVersion :: Producer Text IO ()
grepVersion :: Producer Text IO ()
grepVersion = do
    (Handle
_, Handle
hOut) <- [String] -> Proxy X () () Text IO (Handle, Handle)
forall (io :: * -> *).
MonadIO io =>
[String] -> io (Handle, Handle)
createGrepProcess [String
version]
    Handle -> Producer Text IO ()
streamResultsFrom Handle
hOut

recursive, withFileName, withLineNumber, skipBinaryFiles, lineBuffered, colorized, version :: String
recursive :: String
recursive       = String
"-r"
withFileName :: String
withFileName    = String
"-H"
withLineNumber :: String
withLineNumber  = String
"-n"
skipBinaryFiles :: String
skipBinaryFiles = String
"-I"
lineBuffered :: String
lineBuffered    = String
"--line-buffered"
colorized :: String
colorized       = String
"--color=always"
version :: String
version         = String
"--version"


createGrepProcess :: MonadIO io => [String] -> io (Handle, Handle)
createGrepProcess :: [String] -> io (Handle, Handle)
createGrepProcess [String]
args = IO (Handle, Handle) -> io (Handle, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle, Handle) -> io (Handle, Handle))
-> IO (Handle, Handle) -> io (Handle, Handle)
forall a b. (a -> b) -> a -> b
$ do
    (Just Handle
hIn, Just Handle
hOut, Maybe Handle
_hErr, ProcessHandle
_processHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
        (String -> [String] -> CreateProcess
proc String
"grep" [String]
args) { std_in :: StdStream
std_in  = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe }
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
hIn  BufferMode
LineBuffering
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
hOut BufferMode
LineBuffering
    (Handle, Handle) -> IO (Handle, Handle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle
hIn, Handle
hOut)

streamResultsFrom :: Handle -> Producer Text IO ()
streamResultsFrom :: Handle -> Producer Text IO ()
streamResultsFrom Handle
handle = do
    (Maybe Text
maybeFirstLine, Producer Text IO ()
grepOutput) <- Producer Text IO ()
-> Producer Text IO (Maybe Text, Producer Text IO ())
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> Producer a m (Maybe a, Producer a m r)
peek (Handle -> Producer' Text IO ()
forall (m :: * -> *). MonadIO m => Handle -> Producer' Text m ()
textFromHandle Handle
handle)
    Bool -> Producer Text IO () -> Producer Text IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
maybeFirstLine) (IO () -> Producer Text IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
forall a. IO a
exitFailure)
    Producer Text IO ()
grepOutput


textFromHandle :: MonadIO m => Handle -> Producer' Text m ()
textFromHandle :: Handle -> Producer' Text m ()
textFromHandle Handle
h = Handle -> Producer' String m ()
forall (m :: * -> *). MonadIO m => Handle -> Producer' String m ()
P.fromHandle Handle
h Proxy x' x () String m ()
-> Proxy () String () Text m () -> Proxy x' x () Text m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (String -> Text) -> Proxy () String () Text m ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map String -> Text
T.pack

textToHandle :: MonadIO m => Handle -> Consumer' Text m ()
textToHandle :: Handle -> Consumer' Text m ()
textToHandle Handle
h = (Text -> String) -> Pipe Text String m ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map Text -> String
T.unpack Pipe Text String m ()
-> Proxy () String y' y m () -> Proxy () Text y' y m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Handle -> Consumer' String m ()
forall (m :: * -> *) r. MonadIO m => Handle -> Consumer' String m r
P.toHandle Handle
h

peek :: Monad m => Producer a m r -> Producer a m (Maybe a, Producer a m r)
peek :: Producer a m r -> Producer a m (Maybe a, Producer a m r)
peek Producer a m r
producer = do
    Either r (a, Producer a m r)
eitherNext <- m (Either r (a, Producer a m r))
-> Proxy X () () a m (Either r (a, Producer a m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Producer a m r -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r
producer)
    (Maybe a, Producer a m r) -> Producer a m (Maybe a, Producer a m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe a, Producer a m r)
 -> Producer a m (Maybe a, Producer a m r))
-> (Maybe a, Producer a m r)
-> Producer a m (Maybe a, Producer a m r)
forall a b. (a -> b) -> a -> b
$ case Either r (a, Producer a m r)
eitherNext of
        Left r
r               -> (Maybe a
forall a. Maybe a
Nothing, r -> Producer a m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r)
        Right (a
a, Producer a m r
producer') -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a,  a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
P.yield a
a Proxy X () () a m () -> Producer a m r -> Producer a m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m r
producer')