Grep.hs

{-# LANGUAGE CPP #-}
{-
	Copyright (C) 2010 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 <http://www.gnu.org/licenses/>.
-}
{- |
 [@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.Applicative((<$>))
import			Control.Arrow((&&&))
import qualified	Control.Arrow
import qualified	Control.Monad
import qualified	Data.List
import qualified	Grecce.CommandOptions		as CommandOptions
import qualified	RegExChar.ExtendedRegExChar	as ExtendedRegExChar
import			RegExChar.ExtendedRegExChar	as ExtendedRegExChar((+~), (=~))
import qualified	RegExDot.RegEx			as RegEx
import qualified	RegExDot.RegExOpts		as RegExOpts
import qualified	RegExDot.Result			as Result
import qualified	System
import qualified	System.IO

#if MIN_VERSION_parallel(3,0,0)
import qualified	Control.Parallel.Strategies
#endif

type LineNumber	= Int
type Matches	= Int

-- | Creates a '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.ExitCode
		matchFilterStdIn lineNumber matches	= {-#SCC "matchFilterStdIn" #-} do
			isEOF	<- System.IO.isEOF

			if isEOF
				then if listFilesWithMatches
					then return {-to IO-monad-} $ System.ExitFailure 1	--No match has been found, otherwise we'd have exited earlier.
					else if listFilesWithoutMatch
						then putStrLn dummyFileName	>> return {-to IO-monad-} System.ExitSuccess
						else do
							Control.Monad.when countMatches $ print matches

							return {-to IO-monad-} $ if matches == 0
								then System.ExitFailure 1
								else System.ExitSuccess
				else {-not EOF-} do
					line	<- getLine	--Process line-at-a-time, to provide instant feedback.

					let
						lineNumber' :: LineNumber
						lineNumber'	= lineNumber + 1

						onSuccess :: String -> IO System.ExitCode
						onSuccess line'
							| listFilesWithMatches	= putStrLn dummyFileName	>> return {-to IO-monad-} System.ExitSuccess
							| listFilesWithoutMatch	= return {-to IO-monad-} $ System.ExitFailure 1
							| otherwise		= do
								Control.Monad.unless countMatches . putStrLn $ (
									if prependLineNumbers
										then showLineNumber lineNumber'
										else id
								 ) line'

								matchFilterStdIn lineNumber' $ matches + 1	--Recurse.

						onFailure, onMismatch :: IO System.ExitCode
						onFailure	= matchFilterStdIn lineNumber' matches	--Recurse
						onMismatch
							| invertMatch	= onSuccess line
							| otherwise	= onFailure

					if verbose
						then let
							result :: RegEx.Result Char
							result	= line +~ regExOpts
						in if 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	= "<standard input>"
	in matchFilterStdIn 0 0 >>= System.exitWith
	| otherwise {-file-names provided-}	= let
		findMatch :: String -> 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 (
							Result.isMatch . snd
						) . map (
							Control.Arrow.second findMatch
						)
						else {-terse-} filter (isMatch . snd)
				) . zip [1 :: LineNumber ..]
				else {-unnumbered-} if verbose
					then map show . filter 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
#if MIN_VERSION_parallel(3,0,0)
			<- concat . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq
#else
			<- concatMap
#endif
			(
				uncurry identifySource . Control.Arrow.second (matchFilter . {-#SCC "lines" #-} lines {-chops '\n'-})
			) . zip fileNames <$> mapM readFile fileNames

		mapM_ putStrLn results

		System.exitWith $ if null results
			then System.ExitFailure 1
			else System.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 :: RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar
		regExOpts	= RegExOpts.MkRegExOpts {
			RegExOpts.compilationOptions	= CommandOptions.compilationOptions commandOptions,
			RegExOpts.executionOptions	= CommandOptions.executionOptions commandOptions,
			RegExOpts.regEx			= extendedRegExChar
		}

--Define functions used to format the output.
		separate :: ShowS
		separate	= showChar ':'

		showLineNumber :: LineNumber -> ShowS
		showLineNumber n	= shows n . separate