maybench 0.2.2 → 0.2.3

raw patch · 3 files changed

+43/−30 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Test/Maybench.hs +2/−4
• darcs-benchmark/DarcsBenchmark.hs +40/−25
• maybench.cabal +1/−1

@@ -2,10 +2,9 @@  import System.Time import System.Cmd (system) -- ideally this should use System.Process in the future, but for the sake of a first version this will do.-import Data.Maybe (maybe, isJust, fromJust)+import Data.Maybe (isJust, fromJust) import Control.Monad (when) import Control.Monad.State (MonadIO, liftIO)-import System.Directory (findExecutable) import System.IO (putStr,hPutStr,hClose,hGetContents) import System.Process (waitForProcess, runInteractiveProcess) @@ -18,8 +17,7 @@ run cmd = modifyCmd cmd >>= (\m -> runC $ m (Cmd "" [] ""))  runC :: MonadIO m => Command -> m (String, String)-runC (Cmd exe' args input) = liftIO $ do-  exe <- findExecutable exe' >>= maybe (fail $ "cannot find " ++ exe') return+runC (Cmd exe args input) = liftIO $ do   putStr "Running... "   let cmd_str = unwords $ map showSh (exe:args)   putStrLn cmd_str

@@ -5,12 +5,12 @@ import Control.Monad.Reader import Control.Monad.State import Control.Applicative-import Data.List (isInfixOf,find)-import Data.Maybe (fromMaybe, listToMaybe)+import Data.List (isInfixOf)+import Data.Maybe (listToMaybe) import Data.Time.Clock (getCurrentTime,diffUTCTime)-import System.FilePath ((</>))+import System.FilePath ((</>),isAbsolute) import System.Directory (createDirectory, setCurrentDirectory, removeDirectoryRecursive,-                         doesFileExist, doesDirectoryExist,+                         doesFileExist, doesDirectoryExist, findExecutable,                          getTemporaryDirectory, getCurrentDirectory ) import System.IO (hPutStrLn,stderr) import System.Environment (getArgs)@@ -127,9 +127,11 @@     getCurrentTime   (out, err) <- f   stop <- liftIO getCurrentTime+  exe  <- asks darcsExecutable   let diff = diffUTCTime stop start       (avgmem, maxmem) = grabMemStats err-      results = [ BR "time" (show diff)+      results = [ BR "exe"  exe+                , BR "time" (show diff)                 , BR "avgmem" avgmem                 , BR "maxmem" maxmem ]   liftIO $ do putStr "bench stats "@@ -253,17 +255,21 @@    filter ("Num Patches:" `isInfixOf`) . lines . fst)    <$> (run $ darcs_show_repo <@> RepoDir repo) -data Flag = DarcsFlag { darcsFlag :: String }+data Flag = DarcsFlag [String]           | RepoFlag String           | InteractiveFlag | HelpFlag   deriving (Eq) +-- | comma-separated list of paths to darcs, e.g. darcs-1.0.9, darcs-2.0.0, etc+darcsList :: String -> Flag+darcsList = DarcsFlag . sepBy ','+ options :: [OptDescr Flag] options =    [Option ['h','?'] ["help"]        (NoArg  HelpFlag)            "show this help message",     Option ['i']     ["interactive"] (NoArg  InteractiveFlag)     "use the interactive mode of darcs",     Option ['r']     ["repo"]        (ReqArg RepoFlag "URL")      "run on a specific repository",-    Option []        ["darcs"]       (ReqArg DarcsFlag "COMMAND") "set the darcs command to use"]+    Option []        ["darcs"]       (ReqArg darcsList "CMD1,CMD2,...") "set the darcs commands to use"]  usage :: [String] -> IO a usage errs = do hPutStrLn stderr $ usageInfo header options@@ -319,21 +325,30 @@       (_,_,errs) -> usage errs   when (HelpFlag `elem` opts) $ usage []   ---  let is_darcs_flag (DarcsFlag _) = True-      is_darcs_flag _             = False-  cwd <- getCurrentDirectory-  let mkAbsolute ('.':'/':xs) = cwd ++ "/" ++ xs-      mkAbsolute p = p-  let initBenchConf = BenchConf { benchUrlRepo    = undefined-                                , benchCounts     = undefined-                                , interactive     = InteractiveFlag `elem` opts-                                , darcsExecutable = fromMaybe "darcs" $-                                                      (mkAbsolute . darcsFlag) <$> find is_darcs_flag opts-                                }-      mUrl = listToMaybe [ f | RepoFlag f <- opts ]-  ---  case d_args of-   []      -> ourBench mUrl initBenchConf-   (c:das) -> runBenchM initBenchConf (BenchState "") $ do-                 bench "arbitrary_command" $ run $ darcs c [] <@> Arbitrary das-                 return ()+  let mUrl  = listToMaybe [ f | RepoFlag f <- opts ]+      dCmds = replaceNil "darcs" $ concat [ f | DarcsFlag f <- opts ]+      conf dcmd = BenchConf { benchUrlRepo    = undefined+                            , benchCounts     = undefined+                            , interactive     = InteractiveFlag `elem` opts+                            , darcsExecutable = dcmd+                            }+  forM_ dCmds $ \dcmd' -> do+    dcmd <- if isAbsolute dcmd'+               then return dcmd'+               else findExecutable dcmd' >>= maybe (fail $ "cannot find " ++ dcmd') return+    case d_args of+      []      -> ourBench mUrl (conf dcmd)+      (c:das) -> runBenchM (conf dcmd) (BenchState "") $ do+                   bench "arbitrary_command" $ run $ darcs c [] <@> Arbitrary das+                   return ()++replaceNil :: a -> [a] -> [a]+replaceNil a [] = [a]+replaceNil _ as = as++sepBy :: Char -> String -> [String]+sepBy x s =+ case dropWhile (== x) s of+ "" -> []+ s' -> w : sepBy x s''+   where (w, s'') = break (== x) s'

@@ -1,5 +1,5 @@ Name:                maybench-Version:             0.2.2+Version:             0.2.3 License:             BSD3 License-file:        LICENSE Author:              Maybench developers