{-
Copyright (C) 2010-2015 Dr. Alistair Ward
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
-}
{- |
[@AUTHOR@] Dr. Alistair Ward
[@DESCRIPTION@] Performs the match-operation on the specified file-list, using the user's command-line options.
-}
module Grecce.Grep(
-- * Types
-- LineNumber,
-- Matches,
-- ** Type-synonyms
-- * Functions
grep
) where
import Control.Arrow((&&&))
import qualified Control.Arrow
import qualified Control.Monad
import qualified Control.Parallel.Strategies
import qualified Data.List
import qualified Grecce.CommandOptions as CommandOptions
import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar
import RegExChar.ExtendedRegExChar((+~), (=~))
import qualified RegExDot.RegEx
import qualified RegExDot.RegExOpts
import qualified RegExDot.Result
import qualified System.Exit
import qualified System.IO
type LineNumber = Int
type Matches = Int
-- | Creates a 'RegExDot.RegExOpts.RegExOpts' record from 'CommandOptions.CommandOptions', and uses it to filter the lines read from the list of input-data files, the result of which is then printed.
grep
:: CommandOptions.CommandOptions -- ^ The match-criteria, which may include the name of the file on which to operate.
-> [String] -- ^ A supplementary list of files on which to operate
-> IO () -- ^ Nothing is returned, since the result is printed.
grep commandOptions nonOptions
{-
The algorithm depends fundamentally on whether the data comes from 'stdin' or from file.
This is because of the requirement, in the former case, to deliver instantaneous feedback.
This forces us to print matches as they're found, rather than batching them for return to the caller to print.
If we COULD return 'IO [String]', then 'matchFilterStdIn' could be called instead of 'grep' when (fileName == "-"); annoyingly, it just doesn't work.
-}
| any ($ fileNames) [null, all (== "-")] = let
matchFilterStdIn :: LineNumber -> Matches -> IO System.Exit.ExitCode
matchFilterStdIn lineNumber matches = {-#SCC "matchFilterStdIn" #-} do
isEOF <- System.IO.isEOF
if isEOF
then if listFilesWithMatches
then return {-to IO-monad-} $ System.Exit.ExitFailure 1 -- No match has been found, otherwise we'd have exited earlier.
else if listFilesWithoutMatch
then putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess
else do
Control.Monad.when countMatches $ print matches
return {-to IO-monad-} $ if matches == 0
then System.Exit.ExitFailure 1
else System.Exit.ExitSuccess
else {-not EOF-} do
line <- getLine -- Process line-at-a-time, to provide instant feedback.
let
lineNumber' :: LineNumber
lineNumber' = succ lineNumber
onSuccess :: String -> IO System.Exit.ExitCode
onSuccess line'
| listFilesWithMatches = putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess
| listFilesWithoutMatch = return {-to IO-monad-} $ System.Exit.ExitFailure 1
| otherwise = do
Control.Monad.unless countMatches . putStrLn $ (
if prependLineNumbers
then showLineNumber lineNumber'
else id
) line'
matchFilterStdIn lineNumber' $ succ matches -- Recurse.
onFailure, onMismatch :: IO System.Exit.ExitCode
onFailure = matchFilterStdIn lineNumber' matches -- Recurse
onMismatch
| invertMatch = onSuccess line
| otherwise = onFailure
if verbose
then let
result :: RegExDot.RegEx.Result Char
result = line +~ regExOpts
in if RegExDot.Result.isMatch result
then if invertMatch
then onFailure
else onSuccess $ show result
else onMismatch
else {-terse-} if line =~ regExOpts
then if invertMatch
then onFailure
else onSuccess line
else onMismatch
where
dummyFileName :: String
dummyFileName = ""
in matchFilterStdIn 0 0 >>= System.Exit.exitWith
| otherwise {-file-names provided-} = let
findMatch :: String -> RegExDot.RegEx.Result Char
findMatch = (+~ regExOpts)
matchFilter :: [String] -> [String]
matchFilter = {-#SCC "matchFilter" #-} (
if countMatches
then return {-to List-monad-} . show . length -- Substitute the list of matches, with its length.
else id
) . (
let
isMatch :: String -> Bool
isMatch = {-#SCC "isMatch" #-} (if invertMatch then not else id) . (=~ regExOpts)
in if prependLineNumbers
then map (uncurry showLineNumber) . (
if verbose
then map (
Control.Arrow.second show
) . filter (
RegExDot.Result.isMatch . snd
) . map (
Control.Arrow.second findMatch
)
else {-terse-} filter (isMatch . snd)
) . zip [1 :: LineNumber ..]
else {-unnumbered-} if verbose
then map show . filter RegExDot.Result.isMatch . map findMatch
else {-terse-} filter isMatch
)
identifySource :: String -> [String] -> [String]
identifySource fileName results
| listFilesWithMatches = [fileName | not isEmpty] {-list-comprehension-}
| listFilesWithoutMatch = [fileName | isEmpty] {-list-comprehension-}
| length (Data.List.nub fileNames) > 1 = (showString fileName . separate) `map` results
| otherwise = results
where
isEmpty :: Bool
isEmpty = null results
in do
results <- (
concat . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq (
uncurry identifySource . Control.Arrow.second (matchFilter . {-#SCC "lines" #-} lines {-chops '\n'-})
) . zip fileNames
) `fmap` mapM readFile fileNames
mapM_ putStrLn results
System.Exit.exitWith $ if null results
then System.Exit.ExitFailure 1
else System.Exit.ExitSuccess
where
countMatches, invertMatch, prependLineNumbers, listFilesWithMatches, listFilesWithoutMatch, verbose :: Bool
[countMatches, invertMatch, prependLineNumbers, listFilesWithMatches, listFilesWithoutMatch, verbose] = ($ commandOptions) `map` [
CommandOptions.countMatches,
CommandOptions.invertMatch,
CommandOptions.prependLineNumbers,
CommandOptions.listFilesWithMatches,
CommandOptions.listFilesWithoutMatch,
CommandOptions.verbose
] -- Divvy-up.
-- Separate the regEx & the names of the input-data files to feed it.
extendedRegExChar :: ExtendedRegExChar.ExtendedRegExChar
fileNames :: [String]
(extendedRegExChar, fileNames) = case CommandOptions.extendedRegExChar commandOptions of
Just c -> (c, nonOptions)
_
| null nonOptions -> error "Undefined regex."
| otherwise -> read . head &&& tail $ nonOptions
-- Combine the regex & options, to create a complete task-description.
regExOpts :: RegExDot.RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar
regExOpts = RegExDot.RegExOpts.MkRegExOpts {
RegExDot.RegExOpts.compilationOptions = CommandOptions.compilationOptions commandOptions,
RegExDot.RegExOpts.executionOptions = CommandOptions.executionOptions commandOptions,
RegExDot.RegExOpts.regEx = extendedRegExChar
}
-- Define functions used to format the output.
separate :: ShowS
separate = showChar ':'
showLineNumber :: LineNumber -> ShowS
showLineNumber n = shows n . separate