Permalink
Browse files

Added command line option parsing

  • Loading branch information...
1 parent 4e31cb7 commit bbb1c8e7fd1ef4336806061ace3c5ec7cc1d6311 @dmpots committed Aug 30, 2010
View
@@ -101,21 +101,21 @@ importAs :: String -> String -> String
importAs _grp modu = modu ++ "_bm"
groupName :: String -> String
-groupName g = g ++ "Group"
+groupName g = g
benchDataDecl :: [String] -> String
benchDataDecl [] = ""
benchDataDecl bms =
"data FibonBenchmark =\n " ++
(join ("\n | ") bms) ++
- "\n deriving(Show, Eq, Ord, Enum)"
+ "\n deriving(Read, Show, Eq, Ord, Enum)"
groupDataDecl :: [String] -> String
groupDataDecl [] = ""
groupDataDecl grps =
"data FibonGroup =\n " ++
(join ("\n | ") (map groupName grps)) ++
- "\n deriving(Show, Eq, Ord, Enum)"
+ "\n deriving(Read, Show, Eq, Ord, Enum)"
allBenchmarksDecl :: [String] -> String
allBenchmarksDecl bms =
View
@@ -6,5 +6,5 @@ where
data InputSize =
Test
| Ref
- deriving(Eq, Show, Ord, Enum)
+ deriving(Eq, Read, Show, Ord, Enum)
@@ -0,0 +1,124 @@
+module Fibon.Run.CommandLine (
+ Opt(..)
+ , UsageError
+ , parseCommandLine
+)
+where
+
+import Data.Maybe
+import Fibon.Run.Config
+import System.Console.GetOpt
+
+type UsageError = String
+data Opt = Opt {
+ optConfig :: ConfigId
+ , optHelpMsg :: Maybe String
+ , optBenchmarks :: Maybe [BenchmarkRunSelection]
+ , optTuneSetting :: Maybe TuneSetting
+ , optSizeSetting :: Maybe InputSize
+ , optIterations :: Maybe Int
+ }
+
+defaultOpts :: Opt
+defaultOpts = Opt {
+ optConfig = "default"
+ , optBenchmarks = Nothing
+ , optHelpMsg = Nothing
+ , optTuneSetting = Nothing
+ , optSizeSetting = Nothing
+ , optIterations = Nothing
+ }
+
+
+parseCommandLine :: [String] -> Either UsageError Opt
+parseCommandLine args =
+ case getOpt Permute options args of
+ (o, bms, []) ->
+ let (oErrs, opts) = parseOpts o
+ (bErrs, bs) = parseBenchs bms
+ in
+ case (oErrs, bErrs) of
+ (Just oe, Just be) -> Left $ oe ++ be
+ (Just oe, Nothing) -> Left $ oe
+ (Nothing, Just be) -> Left $ be
+ (Nothing, Nothing) -> Right $ opts {optBenchmarks = bs}
+ (_,_,errs) -> Left (concat errs ++ usage)
+
+
+parseOpts :: [OptionParser] -> (Maybe UsageError, Opt)
+parseOpts = foldl (flip id) (Nothing, defaultOpts)
+
+parseBenchs :: [String] -> (Maybe UsageError, Maybe [BenchmarkRunSelection])
+parseBenchs bms = (errors, benchs)
+ where
+ bmParses = map mbParse bms :: [Maybe FibonBenchmark]
+ grParses = map mbParse bms :: [Maybe FibonGroup]
+ parses = zipWith oneOrTheOther bmParses grParses
+ errors = foldl collectErrors Nothing (zip bms parses)
+ benchs = case catMaybes parses of [] -> Nothing; bs -> Just bs
+
+ oneOrTheOther (Just b) _ = Just $ RunSingle b
+ oneOrTheOther _ (Just g) = Just $ RunGroup g
+ oneOrTheOther _ _ = Nothing
+
+ collectErrors errs (bm, parse) =
+ mbAddError errs parse ("Unknown benchmark: "++bm)
+
+
+type OptionParser = ((Maybe UsageError, Opt) -> (Maybe UsageError, Opt))
+options :: [OptDescr OptionParser]
+options = [
+ Option ['h'] ["help"]
+ (NoArg (\(e, opt) -> (e, opt {optHelpMsg = Just usage})))
+ "print a help message"
+ ,
+ Option ['c'] ["config"]
+ (ReqArg (\c (e, opt) -> (e, opt {optConfig = c})) "ConfigId")
+ "default config settings"
+ ,
+ Option ['t'] ["tune"]
+ (ReqArg (\t (e, opt) ->
+ let tune = mbParse t
+ errs = mbAddError e tune ("Unknown tune setting: "++t)
+ in
+ (errs, opt {optTuneSetting = tune})) "TuneSetting"
+ )
+ "override tune setting"
+ ,
+ Option ['s'] ["size"]
+ (ReqArg (\s (e, opt) ->
+ let size = mbParse s
+ errs = mbAddError e size ("Unknown size setting: "++s)
+ in
+ (errs, opt {optSizeSetting = size})) "InputSize"
+ )
+ "override size setting"
+ ,
+ Option ['i'] ["iters"]
+ (ReqArg (\i (e, opt) ->
+ let iter = mbParse i
+ errs = mbAddError e iter ("Invalid iter setting: "++i)
+ in
+ (errs, opt {optIterations = iter})) "Int"
+ )
+ "override number of iterations"
+ ]
+ where
+
+usage :: String
+usage = usageInfo header options
+ where header = "Usage: fibon-run [OPTION...] [BENCHMARKS...]"
+
+mbAddError :: Maybe UsageError -> Maybe a -> UsageError -> Maybe UsageError
+mbAddError e p msg =
+ case p of
+ Just _success -> e
+ Nothing -> case e of
+ Just errs -> Just (errs ++ "\n" ++ msg)
+ Nothing -> Just msg
+
+mbParse :: (Read a) => String -> Maybe a
+mbParse s =
+ case reads s of
+ [(a, "")] -> Just a
+ _ -> Nothing
@@ -36,7 +36,7 @@ type FlagBuilder = TuneSelection -> BenchmarkConfigSelection -> ConfigMonad
data TuneSetting =
Base
| Peak
- deriving(Eq, Show, Ord, Enum)
+ deriving(Eq, Read, Show, Ord, Enum)
data TuneSelection =
ConfigTune TuneSetting
@@ -6,30 +6,34 @@ import Control.Monad
import Control.Exception
import Data.Char
import Data.List
+import Data.Time.Clock
+import Data.Time.Format
+import Data.Time.LocalTime
import qualified Data.Map as Map
import Fibon.Benchmarks
-import Fibon.Run.Config.Default as DefaultConfig
+import Fibon.Run.Actions
+import Fibon.Run.CommandLine
import Fibon.Run.Config
+import Fibon.Run.Config.Default as Default
import Fibon.Run.Config.Local as Local
-import Fibon.Run.Actions
import Fibon.Run.BenchmarkBundle
import qualified Fibon.Run.Log as Log
import System.Directory
import System.Exit
+import System.Environment
import System.FilePath
import System.Locale
-import Data.Time.Clock
-import Data.Time.Format
-import Data.Time.LocalTime
--import Text.Show.Pretty
import Text.Printf
main :: IO ()
main = do
+ opts <- parseArgsOrDie
currentDir <- getCurrentDirectory
- runConfig <- selectConfig "foo" -- for now
- let workingDir = currentDir </> "run"
+ initConfig <- selectConfig (optConfig opts)
+ let runConfig = mergeConfigOpts initConfig opts
+ workingDir = currentDir </> "run"
benchRoot = currentDir </> "benchmarks/Fibon/Benchmarks"
logPath = currentDir </> "log"
uniq <- chooseUniqueName workingDir (configId runConfig)
@@ -44,6 +48,16 @@ main = do
Log.notice ("Logged output to " ++ logFile)
Log.notice ("Logged result to " ++ outFile)
+parseArgsOrDie :: IO Opt
+parseArgsOrDie = do
+ args <- getArgs
+ case parseCommandLine args of
+ Left msg -> putStrLn msg >> exitFailure
+ Right opts -> do
+ case optHelpMsg opts of
+ Just msg -> putStrLn msg >> exitSuccess
+ Nothing -> return opts
+
runAndReport :: Action -> BenchmarkBundle -> IO ()
runAndReport action bundle = do
Log.notice $ "Benchmark: "++ (bundleName bundle)++ " action="++(show action)
@@ -93,7 +107,7 @@ selectConfig configName =
availableConfigs :: Map.Map ConfigId RunConfig
availableConfigs = Map.fromList $ (configId def, def) : Local.configs
where
- def = DefaultConfig.config
+ def = Default.config
makeBundles :: RunConfig
-> FilePath -- ^ Working directory
@@ -135,6 +149,14 @@ timeStamp = do
t <- getCurrentTime
return $ formatTime defaultTimeLocale "%F %T" (utcToLocalTime tz t)
+mergeConfigOpts :: RunConfig -> Opt -> RunConfig
+mergeConfigOpts rc opt = rc {
+ tuneList = maybe (tuneList rc) (:[]) (optTuneSetting opt)
+ , sizeList = maybe (sizeList rc) (:[]) (optSizeSetting opt)
+ , runList = maybe (runList rc) id (optBenchmarks opt)
+ , iterations = maybe (iterations rc) id (optIterations opt)
+ }
+
{-
dumpConfig :: RunConfig -> IO ()
dumpConfig rc = do

0 comments on commit bbb1c8e

Please sign in to comment.