fishfood-0.0.1.0: src/Main.hs

{-
	Copyright (C) 2013 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@]

	* Contains the entry-point of the application.

	* Processes the command-line arguments.

	* Delegates the task to "Profiler".
-}

module Main(main) where

import			Control.Applicative((<$>),(<*>))
import qualified	Control.Monad
import qualified	Control.Monad.Writer
import qualified	Data.List
import qualified	Data.Maybe
import qualified	Data.Version
import qualified	Distribution.Package
import qualified	Distribution.Text
import qualified	Distribution.Version
import qualified	FishFood.Data.CommandOptions	as Data.CommandOptions
import qualified	FishFood.Data.File		as Data.File
import qualified	FishFood.Data.Verbosity		as Data.Verbosity
import qualified	FishFood.Profiler		as Profiler
import qualified	FishFood.Test.QuickChecks	as Test.QuickChecks
import qualified	Paths_fishfood			as Paths	--Either local stub, or package-instance autogenerated by 'Setup.hs build'.
import qualified	System.Console.GetOpt		as G
import qualified	System.Environment
import qualified	System.Exit
import qualified	System.IO
import qualified	System.IO.Error
import qualified	Text.Printf
import qualified	ToolShed.Defaultable
import qualified	ToolShed.SelfValidate

-- | Define the concrete type of command-options.
type CommandOptions	= Data.CommandOptions.CommandOptions Double

-- | Used to thread user-defined command-line options, though the list of functions which implement them.
type CommandLineAction	= CommandOptions -> IO CommandOptions	--Supplied as the type-argument to 'G.OptDescr'.

-- | On failure to parse the specified string, returns an explanatory error.
read' :: Read a => String -> String -> a
read' errorMessage s	= case reads s of
	[(x, "")]	-> x
	_		-> error $ errorMessage ++ show s

-- | On failure to parse a command-line argument, returns an explanatory error.
readCommandArg :: Read a => String -> a
readCommandArg	= read' "failed to parse command-line argument "

-- | Reads a bounded integral from the command-line, guarding against overflow.
readBoundedIntegral :: Integral i => String -> i
readBoundedIntegral s
	| fromIntegral bounded /= unbounded	= error $ "integral value exceeds permissible bounds; " ++ show unbounded ++ "."
	| otherwise				= bounded
	where
		unbounded	= readCommandArg s
		bounded		= fromInteger unbounded

{- |
	* Parses the command-line options, which over-ride default values.

	* Any arguments which follow known options, are interpreted as file-names.

	* If the specified file-name is /-/, then the actual file-names are read from /standard-input/, to augment any other non-options specified.
-}
main :: IO ()
main	= do
	progName	<- System.Environment.getProgName

	let
		defaultCommandOptions :: CommandOptions
		defaultCommandOptions	= ToolShed.Defaultable.defaultValue

		optDescrList :: [G.OptDescr CommandLineAction]
		optDescrList	= [
--				 String	[String]				(G.ArgDescr CommandLineAction)				String
			G.Option "?"	["help"]				(G.NoArg $ const printUsage)				"Display this help, & then exit.",
			G.Option ""	["verbosity"]				(
				setVerbosity `G.ReqArg` show Data.Verbosity.range
			)														("Define the log-level; default '" ++ show (Data.CommandOptions.getVerbosity defaultCommandOptions) ++ "'."
			),
			G.Option "v"	["version"]				(G.NoArg $ const printVersion)				"Print version-information, & then exit.",
			G.Option "s"	["binSizeIncrement"]			(setBinSizeIncrement `G.ReqArg` "<Int>")		"The constant size-increase in the arithmetic sequence of bins into which the byte-sizes of files are categorised; defaulting to one standard-deviation.",
			G.Option "r"	["binSizeRatio"]			(setBinSizeRatio `G.ReqArg` "<Float>")			"The constant size-ratio in the geometric sequence of bins into which the byte-sizes of files are categorised; an alternative to 'binSizeIncrement'.",
			G.Option "p"	["deriveProbabilityMassFunction"]	(setDeriveProbabilityMassFunction `G.OptArg` "<Bool>")	("Whether to derive the \"Probability mass function\" rather than the \"Frequency-distribution\"; default '" ++ show (Data.CommandOptions.getDeriveProbabilityMassFunction defaultCommandOptions) ++ "'."),
			G.Option "d"	["nDecimalDigits"]			(setNDecimalDigits `G.ReqArg` "<Int>")			("The precision to which fractional auxiliary data is displayed; default " ++ show (Data.CommandOptions.getNDecimalDigits defaultCommandOptions) ++ "."),
			G.Option "q"	["runQuickChecks"]			(G.NoArg runQuickChecks)				"Run Quick-checks using arbitrary data, & then exit."
		 ] where
			setBinSizeIncrement, setBinSizeRatio, setNDecimalDigits, setVerbosity :: String -> CommandLineAction
			setBinSizeIncrement arg			= return {-to IO-monad-} . Data.CommandOptions.setBinSizeIncrement (readCommandArg arg)
			setBinSizeRatio arg			= return {-to IO-monad-} . Data.CommandOptions.setBinSizeRatio (readCommandArg arg)
			setNDecimalDigits arg commandOptions	= return {-to IO-monad-} commandOptions { Data.CommandOptions.getNDecimalDigits = readBoundedIntegral arg }
			setVerbosity arg commandOptions		= return {-to IO-monad-} commandOptions { Data.CommandOptions.getVerbosity = readCommandArg arg }

			setDeriveProbabilityMassFunction :: Maybe String -> CommandLineAction
			setDeriveProbabilityMassFunction arg commandOptions	= return {-to IO-monad-} commandOptions { Data.CommandOptions.getDeriveProbabilityMassFunction = Data.Maybe.maybe True readCommandArg arg }

			printVersion, printUsage :: IO CommandOptions
			printVersion	= Text.Printf.printf "%s\n\n%s %s.\n%s.\n%s.\n%s %s.\n" packageName "Copyright (C) 2013" author "This program comes with ABSOLUTELY NO WARRANTY" "This is free software, & you are welcome to redistribute it under certain conditions" "Written by" author >> System.Exit.exitWith System.Exit.ExitSuccess	where
				packageIdentifier :: Distribution.Package.PackageIdentifier
				packageIdentifier	= Distribution.Package.PackageIdentifier {
					Distribution.Package.pkgName	= Distribution.Package.PackageName progName,	--CAVEAT: coincidentally.
					Distribution.Package.pkgVersion	= Distribution.Version.Version (Data.Version.versionBranch Paths.version) []
				}

				packageName, author :: String
				packageName	= Distribution.Text.display packageIdentifier
				author		= "Dr. Alistair Ward"

			printUsage	= System.IO.hPutStrLn System.IO.stderr ("Usage:\t" ++ G.usageInfo progName optDescrList ++ "  [<File-path> ...]") >> System.Exit.exitWith System.Exit.ExitSuccess

			runQuickChecks :: CommandOptions -> IO CommandOptions
			runQuickChecks _	= Test.QuickChecks.run >> System.Exit.exitWith System.Exit.ExitSuccess

	args	<- System.Environment.getArgs

	case G.getOpt G.RequireOrder optDescrList args of
		(commandLineActions, nonOptions, [{-errors-}])	-> do
			commandOptions	<- Data.List.foldl' (>>=) (return {-to IO-monad-} ToolShed.Defaultable.defaultValue) commandLineActions

			if not $ ToolShed.SelfValidate.isValid commandOptions
				then fail $ ToolShed.SelfValidate.getFirstError commandOptions
				else if null nonOptions
					then fail "zero file-paths specified"
					else let
						standardInputProxy	= "-"
					in do
						filePaths	<- if standardInputProxy `elem` nonOptions
							then let
								getFilePaths :: IO [String]
								getFilePaths	= do
									eof	<- System.IO.isEOF

									if eof
										then return {-to IO-monad-} []
										else {-more to read-} (:) <$> getLine <*> getFilePaths {-recurse-}
							in do
								filePaths	<- (filter (/= standardInputProxy) nonOptions ++) <$> getFilePaths

								if null filePaths
									then fail "zero file-paths"
									else return filePaths
							else {-real fileNames-} return {-to IO-monad-} nonOptions

						Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) $ System.IO.hPrint System.IO.stderr filePaths	--CAVEAT: potentially very long.

						(fileSizeDistribution, statistics)	<- Control.Monad.Writer.runWriter . Profiler.calculateFileSizeDistribution commandOptions <$> mapM Data.File.findSize (Data.List.nub filePaths)

						Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions > ToolShed.Defaultable.defaultValue) $ mapM_ (System.IO.hPutStrLn System.IO.stderr) statistics

						System.IO.putStrLn $ Profiler.formatFileSizeDistribution commandOptions fileSizeDistribution
		(_, _, errors)	-> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors