Merge options for space and time

Author: nobrakal

bench/Command.hs

@@ -3,13 +3,11 @@ module Command
   (
   Option (..),
   Output (..),
-  CommandTime (..),
+  Command (..),
   ListOption (..),
-  CommandSpace (..),
   StaOut (..),
   CommandDataSize (..),
-  commandTime,
-  commandSpace,
+  commandP,
   commandDataSize
   )
 
@@ -46,11 +44,9 @@ type Graph = String
 data ListOption = Benchs | Libs
   deriving (Show, Eq)
 
-data CommandTime = List ListOption | Run (Maybe Option) (Maybe [String]) Output (Maybe [Lib]) Bool Bool [(Graph,Int)]
+data Command = List ListOption | Run (Maybe Option) (Maybe [String]) Output (Maybe [Lib]) Bool Bool [(Graph,Int)]
   deriving (Show, Eq)
 
-data CommandSpace = ListS ListOption | RunS (Maybe [String]) (Maybe [String]) Output (Maybe [Lib])
-
 newtype CommandDataSize = RunD [(Graph,Int)]
 
 partOpt :: Parser Option
@@ -69,7 +65,7 @@ libOpt :: Parser Lib
 libOpt = strOption (long "lib" <> short 'l' <> metavar "LIBNAME" <> help "Benchmark only the library with LIBNAME. Can be used multiple times")
 
 graphOpt :: Parser (Graph,Int)
-graphOpt = option auto (long "graph" <> short 'g' <> metavar "GRAPH" <> help "graph to be tested")
+graphOpt = option auto (long "graph" <> short 'g' <> metavar "GRAPH" <> help "graph to be tested (IGNORED FOR SPACE BENCHMARKS)")
 
 graphsOpt :: Parser [(Graph,Int)]
 graphsOpt = many graphOpt
@@ -94,27 +90,27 @@ figFlag = pure Nothing
 #endif
 
 benchWithCreation :: Parser Bool
-benchWithCreation = flag False True $ long "bench-with-creation" <> short 'b' <> help "When set, will benchmark also the graph-creation function. See README"
+benchWithCreation = flag False True $ long "bench-with-creation" <> short 'b' <> help "When set, will benchmark also the graph-creation function. See README (IGNORED FOR SPACE BENCHMARKS)"
 
 benchLittleOne :: Parser Bool
-benchLittleOne = flag False True $ long "dont-bench-little-ones" <> short 'i' <> help "When set, will only benchmark the largest graphs"
+benchLittleOne = flag False True $ long "dont-bench-little-ones" <> short 'i' <> help "When set, will only benchmark the largest graphs (IGNORED FOR SPACE BENCHMARKS)"
 
 staFlag :: Parser StaOut
 staFlag = option auto $ long "standardOutput" <> short 'd' <> value Ascii <> help ("The standard output, can be: " ++ intercalate ", " staOutCons) <> completeWith staOutCons
 
 output :: Parser Output
 output = Output <$> sumFlag <*> optional saveOpt <*> staFlag <*> figFlag
 
-runCom :: Parser CommandTime
+runCom :: Parser Command
 runCom = Run <$> optional options <*> optional notOnlyOpt <*> output <*> optional (some libOpt) <*> benchWithCreation <*> benchLittleOne <*> graphsOpt
 
 listOpt :: Parser ListOption
 listOpt = flag' Benchs (long "benchs") <|> flag' Libs (long "libs")
 
-listCom :: Parser CommandTime
+listCom :: Parser Command
 listCom = List <$> listOpt
 
-command' :: Parser CommandTime
+command' :: Parser Command
 command' = subparser
   ( command "list" list
     <> command "run" run
@@ -129,34 +125,13 @@ command' = subparser
      <> progDesc "List benchmarks"
      <> header "Help" )
 
-commandTime :: ParserInfo CommandTime
-commandTime = info (command' <**> helper)
-      ( fullDesc
-     <> progDesc "Benchmark time of functions on different graphs libraries"
-     <> header "Help" )
-
-space' :: Parser CommandSpace
-space' = subparser
-  ( command "list" list
-    <> command "run" run
-  )
-  where
-    list = info (ListS <$> listOpt <**> helper)
-      ( fullDesc
-      <> progDesc "Compare benchmarks of graphs libraries"
-      <> header "Help" )
-    run = info ( (RunS <$> optional onlyOpt <*> optional notOnlyOpt <*> output <*> optional (some libOpt)) <**> helper)
+commandP :: ParserInfo Command
+commandP = info (semiOptional <**> helper)
       ( fullDesc
-     <> progDesc "list benchmarks"
+     <> progDesc "Benchmark different graphs libraries"
      <> header "Help" )
-
-commandSpace :: ParserInfo CommandSpace
-commandSpace = info ( semiOptional <**> helper)
-      ( fullDesc
-     <> progDesc "Benchmark size of functions on different graphs libraries"
-     <> header "Help")
   where
-    semiOptional = pure (fromMaybe (RunS Nothing Nothing (Output True Nothing Ascii Nothing) Nothing)) <*> optional space'
+    semiOptional = pure (fromMaybe (Run Nothing Nothing (Output True Nothing Ascii Nothing) Nothing False False [])) <*> optional command'
 
 commandDataSize :: ParserInfo CommandDataSize
 commandDataSize = info ((RunD <$> graphsOpt) <**> helper)

bench/Space.hs

@@ -163,13 +163,13 @@ tkChilds :: Grouped WeighResult -> Maybe [Grouped WeighResult]
 tkChilds = groupedToNamed >=> Just . snd
 
 main :: IO ()
-main = execParser commandSpace >>= main'
+main = execParser commandP >>= main'
 
-main' :: CommandSpace -> IO ()
-main' (ListS opt) = case opt of
+main' :: Command -> IO ()
+main' (List opt) = case opt of
                     Benchs -> putStr $ unlines $ benchsNames Nothing Nothing
                     Libs -> putStr $ unlines $ nub $ map fst listOfSuites
-main' (RunS only notonly flg libs) = do
+main' (Run only notonly flg libs _ _ _) = do
   printHeader defaultGr bN
   mainWeigh benchs (useResults flg (mapMaybe (\(n,Shadow s) -> either (\x -> Just (n,x)) (const Nothing) s ) filteredArr))
   where
@@ -179,12 +179,21 @@ main' (RunS only notonly flg libs) = do
     addCrea = if "creation" `elem` bN then (++ listOfCreation) else id
     filteredArr = filter (`isNameIn` bN) listOfSuites
 
-benchsNames :: Maybe [String] -> Maybe [String] -> [String]
-benchsNames only notonly = nub (map (\(_,Shadow s) -> either fst name s) (maybe id (\e -> filter (\s -> not $ s `isNameIn` e)) notonly $ maybe id (\e -> filter (`isNameIn` e)) only listOfSuites)) ++ listOfCreation'
+benchsNames :: Maybe Option -> Maybe [String] -> [String]
+benchsNames only notonly = useNotOnly $ useOnly extractedNames
   where
-    listOfCreation' = case only of
-                        Nothing -> ["creation"]
-                        Just e -> [ "creation" | "creation" `elem` e]
+    extractedNames = "creation" : map (\(_,Shadow s) -> either fst name s) listOfSuites
+    useOnly = case only of
+      Nothing -> id
+      (Just (Only lst)) -> filter (`elem` lst)
+      (Just (Part one' two)) -> \as ->
+          let one = one' + 1
+              per = length as `div` two
+              f   = if one' + 1 == two then id else take (one*per)
+           in drop ((one-1)*per) $ f as
+    useNotOnly = case notonly of
+                   Nothing -> id
+                   (Just lst) -> filter (`notElem` lst)
 
 isNameIn :: (a,ShadowedS) -> [String] -> Bool
 isNameIn (_,Shadow s) e = either fst name s `elem` e

bench/Time.hs

@@ -194,9 +194,9 @@ benchmarkWithoutOutput bm = do
     defaultConfig' = defaultConfig {verbosity = Quiet, timeLimit = 10}
 
 main :: IO ()
-main = execParser commandTime >>= main'
+main = execParser commandP >>= main'
 
-main' :: CommandTime -> IO ()
+main' :: Command -> IO ()
 main' opts
   = case opts of
       List listOpt -> case listOpt of