{-# 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 .
-}
{- |
[@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
-- read',
-- readCommandArg,
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.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 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'.
-- | 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 "
{- |
* 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 the actual file-names are read from /standard input/, to augment any other non-options specified.
* Delegates the donkey-work to 'Squeeze.squeeze'.
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
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` "") ("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 "z" ["includeEmpty"] (setIncludeEmpty `G.ReqArg` "") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.includeEmpty defaultValue) ++ "'."),
G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "") ("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.maximumBytes defaultValue) ++ "'."),
G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("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` "(, )"
) "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` ""
) "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, setIncludeEmpty, setMaximumBytes, setMinimumUsageRatio, testPerformance, graphPerformance :: String -> CommandLineAction
setBisectionRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.bisectionRatio = readCommandArg arg}
setIncludeEmpty arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.includeEmpty = readCommandArg arg}
setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.maximumBytes = readCommandArg arg}
setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.minimumUsageRatio = readCommandArg arg}
testPerformance arg commandOptions
| not $ ToolShed.SelfValidate.isValid commandOptions = error $ 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 = error $ 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
runQuickChecks :: (Num f, Ord f, Show f) => Data.CommandOptions.CommandOptions f -> IO (Data.CommandOptions.CommandOptions f)
runQuickChecks commandOptions
| not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions
| otherwise = 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 = 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
) "[ ...]" "Bool" "\"True\" | \"False\"\t(* Case-sensitive *)" "Integer" "[0-9]+" "File-path" (
"File-name | File-name '" ++ [System.FilePath.pathSeparator] ++ "' File-path"
) "ProbabilityDistribution" "PoissonDistribution Integer\t(* Defines both mean & variance *)" "Rational" "Integer '%' Integer\t(* I.e. a fraction *)" (
progName ++ " -M 700000000 *.ogg\t#Find the best-fit for the globbed file-names, into the space available on a CD."
) (
progName ++ " -v --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 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