module Progression.Config (RunSettings(..), GraphSettings(..), Mode(..), Config(..), processArgs)
where
import Control.Monad ((>=>))
import Data.List (intercalate)
import Data.Monoid (Monoid(..))
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt, usageInfo)
import System.Environment (getProgName)
import System.Exit (ExitCode(..), exitWith)
import System.IO (hPutStrLn, stderr)
data RunSettings = RunSettings { runPrefixes :: [String], runStoreAs :: Maybe String }
data GraphSettings = GraphSettings { graphCompareTo :: [String]
, graphFilename :: Maybe String
}
data Mode = JustRun | RunAndGraph | JustGraph
deriving Eq
data Config = Config {cfgMode :: Maybe Mode, cfgRun :: RunSettings, cfgGraph :: GraphSettings }
instance Monoid Config where
mempty = Config Nothing mempty mempty
mappend (Config m r g) (Config m' r' g') = Config (m||*m') (mappend r r') (mappend g g')
instance Monoid RunSettings where
mempty = RunSettings mempty mempty
mappend (RunSettings p s) (RunSettings p' s') = RunSettings (p++p') (s||*s')
instance Monoid GraphSettings where
mempty = GraphSettings mempty mempty
mappend (GraphSettings c f) (GraphSettings c' f')
= GraphSettings (c++c') (f ||* f')
(||*) :: Maybe a -> Maybe a -> Maybe a
x ||* Nothing = x
_ ||* y = y
data OptM a = ShowHelp | Error String | Result a
instance Monad OptM where
fail = Error
return = Result
ShowHelp >>= _ = ShowHelp
(Error e) >>= _ = Error e
(Result x) >>= f = f x
options :: [OptDescr (Config -> OptM Config)]
options = [Option "p" ["prefixes"] (ReqArg prefix "PREFIX")
"Run the specified comma-separated list of prefixes (can be given multiple times)"
,Option "n" ["name"] (ReqArg name "NAME")
"Store the results with the specified name"
,Option "c" ["compare"] (ReqArg compareTo "COMPARISON")
"Compare the given comma-separated list of previous recordings (can be given multiple times). Automatically includes the current recording, if any"
,Option [] ["plot"] (ReqArg plot "FILENAME")
"Store the plot as the given filename. The extension, if any, is used to set the gnuplot terminal type"
,Option "m" ["mode"] (ReqArg mode "MODE")
"Specify \"graph\" to just draw a graph, \"run\" to just run the benchmark, or \"normal\" (the default) to do both"
,Option "h" ["help"] (NoArg help)
"Display this help message"
]
where
add :: (Monoid monoid, Monad monad) => monoid -> monoid -> monad monoid
add x c = return $ c `mappend` x
prefix p = add $ mempty {cfgRun = mempty {runPrefixes = [p]} }
name n = add $ mempty {cfgRun = mempty { runStoreAs = Just n} }
compareTo c = add $ mempty {cfgGraph = mempty {graphCompareTo = [c]} }
plot c = add $ mempty {cfgGraph = mempty {graphFilename = Just c} }
mode "graph" = add $ mempty {cfgMode = Just JustGraph}
mode "run" = add $ mempty {cfgMode = Just JustRun}
mode "normal" = add $ mempty {cfgMode = Just RunAndGraph}
mode m = const $ Error $ "Invalid mode setting: \"" ++ m ++ "\""
help = const ShowHelp
processArgs :: Config -> [String] -> IO Config
processArgs defaultConfig ourArgs
= let (cfgFuncs, nonOpt, otherErr) = getOpt Permute options ourArgs
cfgResult = foldl (>=>) return cfgFuncs $ defaultConfig
in case (cfgResult, not $ null $ nonOpt, not $ null $ otherErr) of
(Error err, _, _) -> exitErr $ err ++ intercalate "," otherErr
(_, _, True) -> exitErr $ intercalate "," otherErr
(_, True, _) -> exitErr $ "Unrecognised options: " ++ intercalate "," nonOpt
(ShowHelp, _, _) -> do progName <- getProgName
putStrLn $ usageInfo (progName ++ " [PROGRESSION-ARGS [-- CRITERION-ARGS]]") options
exitWith ExitSuccess
(Result cfg, False, False) -> return cfg
where
exitErr e = hPutStrLn stderr e >> exitWith (ExitFailure 1)