{-# 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
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
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
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')