squeeze-1.0.3.0: 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.

	* Delegates the task to 'Squeeze.findBestFit', potentially on multiple threads.
-}

module Main(main) where

import			Control.Applicative((<*>), (<$>))
import			Control.Arrow((&&&))
import qualified	Control.Concurrent
import qualified	Control.Monad
import qualified	Control.Monad.Writer
import qualified	Data.List
import qualified	Data.Maybe
import qualified	Data.Ord
import qualified	Data.Version
import qualified	Distribution.Package
import qualified	Distribution.Text
import qualified	Distribution.Verbosity
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.Control.Concurrent.DivideAndConquer	as Control.Concurrent.DivideAndConquer
import qualified	Squeeze.Data.CommandOptions			as Data.CommandOptions
import qualified	Squeeze.Data.File				as Data.File
import qualified	Squeeze.Data.FileCombination			as Data.FileCombination
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.FilePath
import qualified	System.IO
import qualified	System.IO.Error
import qualified	Test.QuickCheck
import qualified	Text.Printf
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 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'.

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

{- |
	* Recursively bisects the task, distributing the parts to 'Squeeze.findBestFit', to utilise the available CPU-cores.

	* Recombines the part solutions to finds the single monotonically increasing list of file-combinations matching the specified criteria.
-}
distribute
	:: RealFrac ratio
	=> Int				-- ^ The number of CPU-cores available.
	-> Data.CommandOptions.CommandOptions ratio
	-> [Data.File.FileSizeAndPath]	-- ^ The unordered list of files & sizes.
	-> IO [Data.FileCombination.FileCombination]
distribute _ _ []	= return []

distribute 1 commandOptions fileSizeAndPathList	= let
	solutionSizeBounds	= Data.CommandOptions.solutionSizeBounds commandOptions
 in do
	Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "Solution-size bounds " ++ show solutionSizeBounds

	return $ Squeeze.findBestFit solutionSizeBounds fileSizeAndPathList	--Single-threaded.

distribute numCapabilities commandOptions fileSizeAndPathList	= let
	distribute'						= distribute $ numCapabilities `div` 2	--Partially apply.
	(selectedFileSizeAndPath, remainingFileSizeAndPaths)	= Data.List.minimumBy (Data.Ord.comparing Data.File.getSize) &&& filter (/= selectedFileSizeAndPath) $ fileSizeAndPathList	--Balance the load on the two threads, by selecting the smallest file rather than the largest; this makes a big difference.
 in do
	Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "Splitting task into those including & those excluding, " ++ show selectedFileSizeAndPath

	fileCombinationsExcludingSelected	<- distribute' commandOptions remainingFileSizeAndPaths	--Recurse.
	fileCombinationsIncludingSelected	<- map (
		Data.FileCombination.prepend selectedFileSizeAndPath	--Prepend to all file-combinations, the file we previously removed.
	 ) <$> distribute' (
		commandOptions {
			Data.CommandOptions.getMaximumBytes	= Data.CommandOptions.getMaximumBytes commandOptions - Data.File.getSize selectedFileSizeAndPath
		} --Reduce the maximum size; there's no need to account for the minimum, since this s defined as a ratio of the maximum.
	 ) remainingFileSizeAndPaths	--Recurse.

	Control.Concurrent.DivideAndConquer.divideAndConquer (
		Data.FileCombination.risingMerge $ Data.Ord.comparing Data.FileCombination.getAggregateFileSize
	 ) fileCombinationsExcludingSelected fileCombinationsIncludingSelected	--Merge the part-solutions.

{- |
	* Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', which over-ride the default value.

	* 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 the actual file-names are read from /standard input/, to augment any other non-options specified.

	* Delegates the donkey-work to 'distribute'.
	Because this may take a 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

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

		defaultRandomSeed :: Int
		defaultRandomSeed	= 0

		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) ++ "'. CAVEAT: to be effective, it must precede other options."
			),
			G.Option "v"	["version"]		(G.NoArg $ const printVersion)				"Print version-information, & then exit.",
			G.Option "z"	["includeEmpty"]	(setIncludeEmpty `G.OptArg` "<Bool>")			("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."),
			G.Option "M"	["maximumBytes"]	(setMaximumBytes `G.ReqArg` "<Int>")			("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.getMaximumBytes defaultCommandOptions) ++ "'."),
			G.Option "m"	["minimumUsageRatio"]	(setMinimumUsageRatio `G.ReqArg` "<Float>")		("The minimum acceptable space usage-ratio; default '" ++ show (realToFrac $ Data.CommandOptions.getMinimumUsageRatio defaultCommandOptions :: Double) ++ "'."),
			G.Option "q"	["runQuickChecks"]	(G.NoArg runQuickChecks)				"Run Quick-checks using arbitrary data, & then exit.",
			G.Option "r"	["randomSeed"]		(G.OptArg setRandomSeed "<Int>")			("Seed the random number-generator with the specified integer, to produce a repeatable pseudo-random sequence as required for performance-testing. If this option is unspecified then the seed is unpredictable, but if only its argument is unspecified then the seed defaults to '" ++ show defaultRandomSeed ++ "'. CAVEAT: to be effective, it must precede either 'testPerformance' or 'graphPerformance'."),
			G.Option ""	["testPerformance"]	(
				testPerformance `G.ReqArg` "(<Int>, <Probability-distribution>)"
			)												"Test the single-threaded 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` "<Probability-distribution>"
			)												"Graph the single-threaded 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
			setMaximumBytes, setMinimumUsageRatio, setVerbosity, testPerformance, graphPerformance :: String -> CommandLineAction
			setMaximumBytes arg commandOptions	= return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaximumBytes = readCommandArg arg }
			setMinimumUsageRatio arg commandOptions	= return {-to IO-monad-} commandOptions { Data.CommandOptions.getMinimumUsageRatio = realToFrac (readCommandArg arg :: Double) }
			setVerbosity arg commandOptions		= return {-to IO-monad-} commandOptions { Data.CommandOptions.getVerbosity = readCommandArg arg }

			testPerformance arg commandOptions
				| not $ ToolShed.SelfValidate.isValid commandOptions	= fail $ ToolShed.SelfValidate.getFirstError commandOptions
				| otherwise						= 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)	= readCommandArg arg

			graphPerformance arg commandOptions
				| not $ ToolShed.SelfValidate.isValid commandOptions	= fail $ ToolShed.SelfValidate.getFirstError commandOptions
				| otherwise						= 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	= readCommandArg arg

			setIncludeEmpty, setRandomSeed :: Maybe String -> CommandLineAction
			setIncludeEmpty arg commandOptions	= return {-to IO-monad-} commandOptions { Data.CommandOptions.getIncludeEmpty = Data.Maybe.maybe True readCommandArg arg }
			setRandomSeed arg commandOptions	= return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaybeRandomSeed = Just $ Data.Maybe.maybe defaultRandomSeed readBoundedIntegral arg }

			runQuickChecks :: (Num f, Ord f, Show f) => Data.CommandOptions.CommandOptions f -> IO (Data.CommandOptions.CommandOptions f)
			runQuickChecks commandOptions
				| not $ ToolShed.SelfValidate.isValid commandOptions	= fail $ ToolShed.SelfValidate.getFirstError commandOptions
				| otherwise						= do
					Test.QC.quickChecks $ if Data.CommandOptions.getVerbosity commandOptions > Distribution.Verbosity.normal
						then
#if MIN_VERSION_QuickCheck(2,4,0)
							Test.QuickCheck.verboseCheck
#else
							fail "'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	= Text.Printf.printf "%s\n\n%s %s.\n%s.\n%s.\n%s %s.\n" packageName "Copyright (C) 2010" 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	= Text.Printf.hPrintf System.IO.stderr "Usage:\t%s %s\n\nEBNF argument-format:\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\nE.g.\n\t%s\n\t%s\n" (
				G.usageInfo progName optDescrList
			 ) "[<File-path> ...]" "Bool" "\"True\" | \"False\"\t(* Case-sensitive *)" "Int" "[0-9]+" "File-path" (
				"File-name ('" ++ [System.FilePath.pathSeparator] ++ "' File-name)*"
			 ) "ProbabilityDistribution" "PoissonDistribution Int\t(* Defines both mean & variance *)" "Float" "Int ('.' Int)?" (
				progName ++ " -M 700000000 *.ogg +RTS -N\t#Find the best-fit for the globbed file-names, into the space available on a CD, using multiple CPU-cores where available."
			 ) (
				progName ++ " --verbosity=Verbose -r --testPerformance='(100, PoissonDistribution 1000000000)'\t#Test performance."
			 ) >> System.Exit.exitWith System.Exit.ExitSuccess

	args	<- System.Environment.getArgs

--	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 fail $ ToolShed.SelfValidate.getFirstError commandOptions
				else if null nonOptions
					then fail "No file-paths specified"
					else (
						if Data.CommandOptions.getVerbosity commandOptions > Distribution.Verbosity.normal
							then ToolShed.System.TimeAction.printCPUSeconds
							else id
					 ) $ do
						filePaths	<- 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 fail "No file-paths"
									else return filePaths
							else {-real fileNames-} return {-to IO-monad-} nonOptions


						(acceptedFileSizeAndPathList, logFile)	<- Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (Data.CommandOptions.isWithinSizeBounds commandOptions) <$> Data.File.findSizes (Data.List.nub filePaths)

						Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions > minBound) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile

						if null acceptedFileSizeAndPathList
							then fail "There are zero suitable files"
							else let
								aggregateSize	= Data.File.aggregateSize acceptedFileSizeAndPathList
								minimumBytes	= Data.CommandOptions.deriveMinimumBytes commandOptions
							in if aggregateSize < minimumBytes
								then fail $ "The aggregate size of all suitable files, is insufficient; " ++ show (aggregateSize, minimumBytes)
								else do
									numCapabilities	<- Control.Concurrent.getNumCapabilities	--Find how many CPU-cores are available.

									Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) . System.IO.hPutStrLn System.IO.stderr $ show numCapabilities ++ " available CPU-cores"

									mapM_ print {-lazy evaluation-} =<< distribute numCapabilities commandOptions acceptedFileSizeAndPathList
		(_, _, errors)	-> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors