{- 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 . -} {- | [@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` "") "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` "") ("The precision to which fractional auxiliary data is displayed; default " ++ show (Data.CommandOptions.getNDecimalDigits defaultCommandOptions) ++ "."), G.Option "z" ["includeEmpty"] (setIncludeEmpty `G.OptArg` "") ("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 ++ " [ ...]") >> 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