bench 1.0.9 → 1.0.10

raw patch · 3 files changed

+67/−34 lines, 3 filesdep ~criteriondep ~optparse-applicative

Dependency ranges changed: criterion, optparse-applicative

Files

• README.md +1/−1
• bench.cabal +9/−9
• src/Main.hs +57/−24

@@ -1,4 +1,4 @@-# Bench v1.0.9+# Bench v1.0.10  This project provides the `bench` command-line tool, which is a more powerful alternative to the `time` command.  Use `bench` to benchmark a command using

@@ -1,10 +1,10 @@ name:                bench-version:             1.0.9+version:             1.0.10 synopsis:            Command-line benchmark tool description:         Think of this as a more powerful alternative to the @time@                      command.  Use this command-line tool to benchmark a command                      using Haskell's @criterion@ library.-homepage:            http://github.com/Gabriel439/bench+homepage:            https://github.com/Gabriel439/bench bug-reports:         https://github.com/Gabriel439/bench/issues license:             BSD3 license-file:        LICENSE@@ -25,12 +25,12 @@   hs-source-dirs:      src   main-is:             Main.hs   default-language:    Haskell2010-  build-depends:       base                 >= 4.5     && < 5-                     , criterion            >= 1.1.1.0 && < 1.5-                     , optparse-applicative >= 0.2.0   && < 0.15-                     , process              >= 1.3     && < 1.7-                     , silently             >= 1.1.1   && < 1.3-                     , text                               < 1.3-                     , turtle               >= 1.2.5   && < 1.6+  build-depends:       base                 >= 4.5      && < 5+                     , criterion            >= 1.4      && < 1.5+                     , optparse-applicative >= 0.14.0.0 && < 0.15+                     , process              >= 1.3      && < 1.7+                     , silently             >= 1.1.1    && < 1.3+                     , text                                < 1.3+                     , turtle               >= 1.2.5    && < 1.6   ghc-options:         -Wall -O2 -threaded   other-modules:       Paths_bench

@@ -24,8 +24,26 @@ version :: Text version = Text.pack (Data.Version.showVersion Paths_bench.version) -data Options = Options [Text] Criterion.Mode | Version deriving (Show)+data Options+    = Options (Maybe Text) (Maybe Text) [Text] Criterion.Mode+    | Version deriving (Show) +before :: Parser Text+before =+    Options.Applicative.strOption+        (   Options.Applicative.long "before"+        <>  Options.Applicative.help "Specify a command to run before each run of the benchmark"+        <>  Options.Applicative.metavar "command"+        )++after :: Parser Text+after =+    Options.Applicative.strOption+        (   Options.Applicative.long "after"+        <>  Options.Applicative.help "Specify a command to run after each run of the benchmark"+        <>  Options.Applicative.metavar "command"+        )+ parser :: Parser Options parser =             Version@@ -36,7 +54,9 @@                 <>  Options.Applicative.help "Version number"                 )     <|>     Options-        <$> some+        <$> optional before+        <*> optional after+        <*> some                 (Turtle.argText "command(s)" "The command line(s) to benchmark")         <*> Criterion.parseWith Criterion.defaultConfig @@ -44,36 +64,49 @@ main = do     x <- Turtle.options "Command-line tool to benchmark other programs" parser     case x of-        Options [command] mode -> benchCommand  command mode-        Options  commands mode -> benchCommands commands mode-        Version -> do-            Turtle.printf ("bench version "%s%"\n") version+        Options maybeBefore maybeAfter commands mode -> do+            let benches = map (buildBench maybeBefore maybeAfter) commands -benchCommands :: [Text] -> Criterion.Mode -> IO ()-benchCommands commands mode = do-    let benches = map buildBench commands-    Criterion.runMode mode [Criterion.bgroup "bench" benches]+            let benches' = case commands of+                    [_] -> benches+                    _   -> [ Criterion.bgroup "bench" benches ] -benchCommand :: Text -> Criterion.Mode -> IO ()-benchCommand command mode = do-    let bench = buildBench command-    Criterion.runMode mode [ bench ]+            Criterion.runMode mode benches'+        Version -> do+            Turtle.printf ("bench version "%s%"\n") version -buildBench :: Text -> Criterion.Benchmark-buildBench command = do-    let createProcess =-            (System.Process.shell (Text.unpack command))-                { System.Process.std_in  = System.Process.NoStream-                }+buildBench :: Maybe Text -> Maybe Text -> Text -> Criterion.Benchmark+buildBench maybeBefore maybeAfter command = do+    let io cmd = Silently.hSilence [IO.stdout, IO.stderr] $ do+            let createProcess =+                    (System.Process.shell (Text.unpack cmd))+                        { System.Process.std_in  = System.Process.NoStream+                        } -    let io = do             exitCode <- Turtle.system createProcess empty             case exitCode of                 ExitFailure _ -> do-                    Control.Exception.throwIO (ShellFailed command exitCode)+                    Control.Exception.throwIO (ShellFailed cmd exitCode)                 _  -> do                     return () -    let benchmark = Criterion.nfIO (Silently.hSilence [IO.stdout, IO.stderr] io)+    let benchmarkable = case (maybeBefore, maybeAfter) of+            (Just before_, Just after_) ->+                Criterion.perRunEnvWithCleanup+                    (io before_)+                    (\_ -> io after_)+                    (\_ -> io command)+            (Just before_, Nothing) ->+                Criterion.perRunEnvWithCleanup+                    (io before_)+                    (\_ -> return ())+                    (\_ -> io command)+            (Nothing, Just after_) ->+                Criterion.perRunEnvWithCleanup+                    (return ())+                    (\_ -> io after_)+                    (\_ -> io command)+            (Nothing, Nothing) ->+                Criterion.nfIO (io command) -    Criterion.bench (Text.unpack command) benchmark+    Criterion.bench (Text.unpack command) benchmarkable