squeeze-1.0.2.2: src/Main.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@]

	* Contains the entry-point of the application.

	* Processes the command-line arguments.
-}

module Main(
-- * Types
-- ** Type-synonyms
--	CommandOptions',
--	CommandLineAction,
-- * Functions
	main
) where

import			Control.Applicative((<*>), (<$>))
import qualified	Data.List
import qualified	Data.Ratio
import qualified	Data.Version
import qualified	Distribution.Package
import qualified	Distribution.Text
import qualified	Distribution.Version
import qualified	Factory.Math.Probability
import qualified	Paths_squeeze			as Paths	--Either local stub, or package-instance autogenerated by 'Setup.hs build'.
import qualified	Squeeze.Data.CommandOptions	as Data.CommandOptions
import qualified	Squeeze.Data.File		as Data.File
import qualified	Squeeze.Squeeze			as Squeeze
import qualified	Squeeze.Test.Performance	as Test.Performance
import qualified	Squeeze.Test.QC			as Test.QC
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	Test.QuickCheck
import qualified	ToolShed.Defaultable
import qualified	ToolShed.SelfValidate
import qualified	ToolShed.System.TimeAction

-- | Coerce the polymorphic data-type to concrete instance, in order that it's fields may be read from the command-line.
type CommandOptions'	= Data.CommandOptions.CommandOptions Data.Ratio.Rational	--'Double' would also be a suitable type-parameter.

-- | 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'.

{- |
	* Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', some of which may over-ride the 'ToolShed.Defaultable.defaultValue'.

	* Any arguments which follow known 'Data.CommandOptions.CommandOptions',
	are interpreted as file-names to consider when attempting to find a suitable fit for the specified space-constraints.

	* If the specified file-name is /-/, then 'System.IO.stdin' is read, to augment other non-options specified.

	* Delegates the donkey-work to 'Squeeze.squeeze'.
	Because this may take an inordinately long time,
	it prints the results in real time, rather than batching until the optimum has been determined.

	* If /verbose/ has been specified, prints the CPU-time used,
-}
main :: IO ()
main	= do
	progName	<- System.Environment.getProgName
	args		<- System.Environment.getArgs

	let
		usage :: String
		usage	= "Usage:\t" ++ G.usageInfo progName optDescrList ++ "  [<file/directory-name>, ...]\n\nExamples:\n\t" ++ progName ++ " -M 700000000 *.ogg\t\t#Find the best-fit for the globbed file-names, into the space available on a CD."

		defaultValue :: CommandOptions'
		defaultValue	= 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 "v"	["verbose"]		(G.NoArg $ return . Data.CommandOptions.setVerbose)	"Produce additional explanatory output where appropriate. CAVEAT: to be effective, it should precede other options.",
			G.Option ""	["version"]		(G.NoArg $ const printVersion)				"Print version-information, & then exit.",
			G.Option "b"	["bisectionRatio"]	(setBisectionRatio `G.ReqArg` "<Ratio>")		("The list of file-paths is bisected at LHS/Total, & combinations from the LHS, concatenated with each of those from the RHS; default '" ++ show (Data.CommandOptions.bisectionRatio defaultValue) ++ "'."),
			G.Option "M"	["maximumBytes"]	(setMaximumBytes `G.ReqArg` "<Integer>")		("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.maximumBytes defaultValue) ++ "'."),
			G.Option "m"	["minimumUsageRatio"]	(setMinimumUsageRatio `G.ReqArg` "<Ratio>")		("The minimum acceptable space usage-ratio; default '" ++ show (Data.CommandOptions.minimumUsageRatio defaultValue) ++ "'."),
			G.Option "q"	["runQuickChecks"]	(G.NoArg runQuickChecks)				"Run Quick-checks using arbitrary data & then exit.",
			G.Option ""	["testPerformance"]	(
				testPerformance `G.ReqArg` "(<Int>, <Factory.Math.Probability.DiscreteDistribution>)"
			)												"Test the performance, using the specified number of randomly generated virtual files, the size of which conform to the specified probability-distribution; then exit.",
			G.Option ""	["graphPerformance"]	(
				graphPerformance `G.ReqArg` "<Factory.Math.Probability.DiscreteDistribution>"
			)												"Graph the performance, against a linearly increasing number of randomly generated virtual files, the size of which conform to the specified probability-distribution. Doesn't normally terminate."
		 ] where
			setBisectionRatio, setMaximumBytes, setMinimumUsageRatio, testPerformance, graphPerformance :: String -> CommandLineAction
			setBisectionRatio arg commandOptions	= return {-to IO-monad-} commandOptions {Data.CommandOptions.bisectionRatio = read arg}
			setMaximumBytes arg commandOptions	= return {-to IO-monad-} commandOptions {Data.CommandOptions.maximumBytes = read arg}
			setMinimumUsageRatio arg commandOptions	= return {-to IO-monad-} commandOptions {Data.CommandOptions.minimumUsageRatio = read arg}

			testPerformance arg commandOptions	= if not $ ToolShed.SelfValidate.isValid commandOptions
				then error $ ToolShed.SelfValidate.getFirstError commandOptions
				else do
					ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print

					System.Exit.exitWith System.Exit.ExitSuccess
				where
					fileCount		:: Int
					probabilityDistribution	:: Factory.Math.Probability.DiscreteDistribution Double
					(fileCount, probabilityDistribution)	= read arg

			graphPerformance arg commandOptions	= if not $ ToolShed.SelfValidate.isValid commandOptions
				then error $ ToolShed.SelfValidate.getFirstError commandOptions
				else do
					mapM_ (\fileCount -> ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print) [1 ..]

					System.Exit.exitWith $ System.Exit.ExitFailure 1
				where
					probabilityDistribution	:: Factory.Math.Probability.DiscreteDistribution Double
					probabilityDistribution	= read arg

			runQuickChecks :: (Num f, Ord f) => Data.CommandOptions.CommandOptions f -> IO (Data.CommandOptions.CommandOptions f)
			runQuickChecks commandOptions	= if not $ ToolShed.SelfValidate.isValid commandOptions
				then error $ ToolShed.SelfValidate.getFirstError commandOptions
				else do
					Test.QC.quickChecks $ if Data.CommandOptions.verbose commandOptions
						then
#if MIN_VERSION_QuickCheck(2,4,0)
							Test.QuickCheck.verboseCheck
#else
							error "'Test.QuickCheck.verboseCheck' is only available as of 'QuickCheck-2.4'."
#endif
						else Test.QuickCheck.quickCheck

					System.Exit.exitWith System.Exit.ExitSuccess

			printVersion, printUsage :: IO (Data.CommandOptions.CommandOptions f)
			printVersion	= System.IO.hPutStrLn System.IO.stderr (Distribution.Text.display packageIdentifier ++ "\n\nCopyright (C) 2010 Dr. Alistair Ward.\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by Dr. Alistair Ward.") >> System.Exit.exitWith System.Exit.ExitSuccess	where
				packageIdentifier :: Distribution.Package.PackageIdentifier
				packageIdentifier	= Distribution.Package.PackageIdentifier {
					Distribution.Package.pkgName	= Distribution.Package.PackageName "squeeze",
					Distribution.Package.pkgVersion	= Distribution.Version.Version (Data.Version.versionBranch Paths.version) []
				}

			printUsage	= System.IO.hPutStrLn System.IO.stderr usage >> System.Exit.exitWith System.Exit.ExitSuccess

--	G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr CommandLineAction] -> [String] -> ([CommandLineAction], [String], [String])
	case G.getOpt G.RequireOrder optDescrList args of
		(commandLineActions, nonOptions, [{-errors-}])	-> do
			commandOptions	<- Data.List.foldl' (>>=) (
				return {-to IO-monad-} ToolShed.Defaultable.defaultValue
			 ) {-transform using CommandLineAction-mutators-} commandLineActions	--ie: do o1 <- CommandLineAction[0] commandOptions[0]; o2 <- CommandLineAction[1] o1; ...

			if not $ ToolShed.SelfValidate.isValid commandOptions
				then error $ ToolShed.SelfValidate.getFirstError commandOptions
				else (
					if Data.CommandOptions.verbose commandOptions
						then ToolShed.System.TimeAction.printCPUSeconds
						else id
				 ) $ mapM_ print {-print immediately rather than batching-} =<< Squeeze.squeeze commandOptions =<< if null nonOptions
					then error "No file-paths specified."
					else if "-" `elem` nonOptions
						then let
							getFilePaths :: IO Data.File.FilePathList
							getFilePaths	= do
								eof	<- System.IO.isEOF

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

							if null filePaths
								then error "No file-paths."
								else return filePaths
						else {-real fileNames-} return {-to IO-monad-} nonOptions
		(_, _, errors)	-> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors