fishfood-0.0.0.1: 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.
-}

module Main(main) where

import			Control.Applicative((<$>),(<*>))
import			Control.Arrow((&&&))
import qualified	Control.Monad
import qualified	Data.List
import qualified	Data.Map
import qualified	Data.Maybe
import qualified	Data.Version
import qualified	Distribution.Package
import qualified	Distribution.Text
import qualified	Distribution.Verbosity
import qualified	Distribution.Version
import qualified	FishFood.Data.CommandOptions	as Data.CommandOptions
import qualified	FishFood.Data.File		as Data.File
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

-- | Used to thread user-defined command-line options, though the list of functions which implement them.
type CommandLineAction	= Data.CommandOptions.CommandOptions -> IO Data.CommandOptions.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 :: Data.CommandOptions.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 [minBound :: Distribution.Verbosity.Verbosity .. maxBound]
			)										("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 "b"	["binSize"]		(setBinSize `G.ReqArg` "<Int>")		"The range in bytes, accepted by any one of the bins into which file-sizes are categorised; defaulting to one standard-deviation.",
			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 "z"	["includeEmpty"]	(setIncludeEmpty `G.OptArg` "<Bool>")	("Whether to display empty bins; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'.")
		 ] where
			setBinSize, setNDecimalDigits, setVerbosity :: String -> CommandLineAction
			setBinSize arg commandOptions		= return {-to IO-monad-} commandOptions { Data.CommandOptions.getBinSize = Just $ 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 }

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

			printVersion, printUsage :: IO Data.CommandOptions.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

	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

						let (nDecimalDigits, verbosity) = Data.CommandOptions.getNDecimalDigits &&& Data.CommandOptions.getVerbosity $ commandOptions	--Deconstruct.

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

						fileSizes	<- mapM Data.File.findSize $ Data.List.nub filePaths	--De-duplicate the file-paths, & find the corresponding file-sizes.

						let
							mean, standardDeviation :: Double
							(nFiles, mean, standardDeviation)	= Data.File.getFileSizeStatistics fileSizes

							columnHeaders :: [String]
							columnHeaders	= ["Bin", "Frequency"]

							columnWidths :: [Int]
							columnWidths	= map length columnHeaders

							formatLine :: Data.File.FileSize -> Int -> IO ()
							formatLine bin	=  Text.Printf.printf "%*d\t%*d\n" (head columnWidths) bin (last columnWidths)

						Control.Monad.when (verbosity >= Distribution.Verbosity.verbose) $ do
							Control.Monad.void $ Text.Printf.hPrintf System.IO.stderr "Files=%d, mean=%.*f, standard-deviation=%.*f\n" nFiles nDecimalDigits mean nDecimalDigits standardDeviation	--Print statistics.

							let tabulate	= Data.List.intercalate "\t"

							Text.Printf.hPrintf System.IO.stderr "%s\n%s\n" (tabulate columnHeaders) (tabulate $ map (`replicate` '=') columnWidths)	--Print column-headers.

						if standardDeviation == 0
							then formatLine 0 nFiles
							else let
								bins	= map (`div` Data.Maybe.fromMaybe (round standardDeviation) (Data.CommandOptions.getBinSize commandOptions)) fileSizes

								frequencyDistribution
									| Data.CommandOptions.getIncludeEmpty commandOptions	= Data.Map.fromList $ [0 .. maximum bins] `zip` repeat 0
									| otherwise						= Data.Map.empty
							in mapM_ (uncurry formatLine) . Data.Map.toList $ foldr (
								uncurry (Data.Map.insertWith (+))
							) frequencyDistribution $ bins `zip` repeat 1

		(_, _, errors)	-> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors