diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Sebastian Graf (c) 2015 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sebastian Graf nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,107 @@ +# `cloben` [![Build Status](https://travis-ci.org/sgraf812/cloben.svg?branch=master)](https://travis-ci.org/sgraf812/cloben) [![Hackage](https://img.shields.io/hackage/v/cloben.svg?flat=true)](https://hackage.haskell.org/package/cloben) + +`cloben` is a Haskell shell script transforms `cabal bench`/`stack bench` results into a CSV file readable by `gipeda` for visualization. +Prior to that, it optionally clones a specific commit of a given git repository into a temporary folder in which it then performs the benchmarking. + +It parses build warnings and timing data output in the standard `criterion` format. + +# Usage + +There are two modes of operation: + +`cloben` will benchmark the cabal project in the current working directory and output the CSV data on `stdout`. It will try to use `stack` as an optimization, but the fall back mechanism (cabal sandboxing) takes 10 minutes on my laptop for even the simplest dependency tree, so stay calm :). + +`cloben ` will also attempt to recursively clone a remote git `repo` at a specific `commit` into a temporary directory and `cd` into it prior to benchmarking. + +For usage with `gipeda`, `stdout` should be redirected into a csv file. + +See also `cloben --help`. + +# How to build + +Simplest way? Don't! Use [`stack`s excellent support for `runghc`](http://docs.haskellstack.org/en/stable/GUIDE.html#script-interpreter): +``` +$ stack cloben.hs +``` +Or on unixoid systems: +``` +$ chmod +x cloben.hs +$ ./cloben.hs +``` + +Of course, `cloben` can be built both in a `cabal` and in a `stack` environment. +``` +$ stack build && stack exec cloben +... +$ cabal install -j && cabal run +... +``` + +Or even just through hackage: + +``` +$ stack install cloben && cloben +... +$ cabal install cloben && cloben +... +``` + +# Example + +What running `cloben` on the `Pipes` library yielded: + +``` +$ ./cloben.hs https://github.com/Gabriel439/Haskell-Pipes-Library 930c834aacfa7bf8ec65d072e0d0a982aa7a2bc1 > logs/930c834aacfa7bf8ec65d072e0d0a982aa7a2bc1.csv +$ cat logs/930c834aacfa7bf8ec65d072e0d0a982aa7a2bc1.csv +build/warnings;81.0 +benchmark/prelude-benchmarks/Folds/all;152900.0 +benchmark/prelude-benchmarks/Folds/any;163700.0 +benchmark/prelude-benchmarks/Folds/find;170800.0 +benchmark/prelude-benchmarks/Folds/findIndex;164500.0 +benchmark/prelude-benchmarks/Folds/fold;68150.0 +benchmark/prelude-benchmarks/Folds/foldM;67690.0 +benchmark/prelude-benchmarks/Folds/head;10.84 +benchmark/prelude-benchmarks/Folds/index;117000.0 +benchmark/prelude-benchmarks/Folds/last;119600.0 +benchmark/prelude-benchmarks/Folds/length;53960.0 +benchmark/prelude-benchmarks/Folds/null;11.2 +benchmark/prelude-benchmarks/Folds/toList;138100.0 +benchmark/prelude-benchmarks/Pipes/chain;1351000.0 +benchmark/prelude-benchmarks/Pipes/drop;110400.0 +benchmark/prelude-benchmarks/Pipes/dropWhile;159000.0 +benchmark/prelude-benchmarks/Pipes/filter;585100.0 +benchmark/prelude-benchmarks/Pipes/findIndices;397900.0 +benchmark/prelude-benchmarks/Pipes/map;324600.0 +benchmark/prelude-benchmarks/Pipes/mapM;1276000.0 +benchmark/prelude-benchmarks/Pipes/take;346500.0 +benchmark/prelude-benchmarks/Pipes/takeWhile;332400.0 +benchmark/prelude-benchmarks/Pipes/scan;370900.0 +benchmark/prelude-benchmarks/Pipes/scanM;1177000.0 +benchmark/prelude-benchmarks/Pipes/concat;159600.0 +benchmark/prelude-benchmarks/Zips/zip;1218000.0 +benchmark/prelude-benchmarks/Zips/zipWith;1318000.0 +benchmark/prelude-benchmarks/enumFromTo.vs.each/enumFromTo;205700.0 +benchmark/prelude-benchmarks/enumFromTo.vs.each/each;209000.0 +benchmark/lift-benchmarks/ReaderT/runReaderP_B;4791000.0 +benchmark/lift-benchmarks/ReaderT/runReaderP_A;266600.0 +benchmark/lift-benchmarks/StateT/runStateP_B;4912000.0 +benchmark/lift-benchmarks/StateT/runStateP_A;344800.0 +benchmark/lift-benchmarks/StateT/evalStateP_B;5534000.0 +benchmark/lift-benchmarks/StateT/evalStateP_A;349400.0 +benchmark/lift-benchmarks/StateT/execStateP_B;5451000.0 +benchmark/lift-benchmarks/StateT/execStateP_A;324300.0 +``` + +# Which `cabal`, `stack` and `ghc` binaries are used? + +Short answer: That found on the path at the time of executing this script. + +If `cloben` is compiled to an executable which is then called from your shell, +it will use `cabal`, `stack` and `ghc` binaries found on your path. + +If however you prefer to run this as a script through `stack` (see above), +note that `stack` modifies the environment, so it will use a 'stack-local' version +of `cabal` when `stack install cabal-install` happened. + +Finally, note that the fallback mechanism (try `stack bench`, fall back to `cabal sandbox init && cabal bench`) +might fail if it can't find `ghc` on the path. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cloben.cabal b/cloben.cabal new file mode 100644 --- /dev/null +++ b/cloben.cabal @@ -0,0 +1,45 @@ +name: cloben +version: 0.1.0.0 +synopsis: Clone and benchmark Haskell cabal projects +description: + @cloben@ is a Haskell shell script transforms @cabal bench@/@stack bench@ + results into a CSV file readable by @gipeda@ for visualization. + Prior to that, it optionally clones a specific commit of a given + git repository into a temporary folder in which it then performs the benchmarking. + . + Example run of some default @fib@ benchmarks: + . + @ + $ cloben https:\/\/github.com\/sgraf812\/benchmark-test 9982583 + build\/warnings;1.0 + benchmarks\/fib\/10;487.7 + benchmarks\/fib\/35;81910000.0 + benchmarks\/fib\/37;215200000.0 + @ +homepage: http://github.com/sgraf812/cloben#readme +license: BSD3 +license-file: LICENSE +author: Sebastian Graf +maintainer: sgraf1337@gmail.com +copyright: 2015 Sebastian Graf +category: Benchmarking +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +executable cloben + hs-source-dirs: . + main-is: cloben.hs + default-language: Haskell2010 + build-depends: + base >= 4.7 && < 5, + turtle >= 1.2 && < 1.3, + foldl < 2.0, + system-filepath >= 0.3.1 && < 0.5, + text < 1.3, + temporary >= 1.1 && < 1.3, + process >= 1.1.0.0 && < 1.5 + +source-repository head + type: git + location: https://github.com/sgraf812/cloben.git diff --git a/cloben.hs b/cloben.hs new file mode 100644 --- /dev/null +++ b/cloben.hs @@ -0,0 +1,301 @@ +#!/usr/bin/env stack +-- stack --resolver lts-5.15 --install-ghc runghc --package turtle +{-# LANGUAGE OverloadedStrings #-} + +{-| This script will automatically clone a given git repository at a specific + commit into a temporary directory and parse the output of @cabal bench@ + into a CSV format readable by . + + Currently, only the number of build warnings and standard criterion timing + output are recognized. + + You can execute this script by running @stack cloben.hs@ in your project directory, + as @stack cloben.hs repo commit@ if you don't have a local clone of you project or + even as @./cloben.hs repo commit@ if marked as executable. +-} + +module Main where + +import Control.Arrow ((***)) +import Control.Exception (bracket) +import qualified Control.Foldl as Fold +import Data.Char (isSpace) +import Data.Either (lefts) +import Data.Text (Text, pack, unlines, unpack) +import Filesystem.Path.CurrentOS (FilePath) +import qualified Filesystem.Path.CurrentOS as Filesystem +import Numeric (fromRat, showFFloat) +import Prelude hiding (FilePath, unlines) +import System.IO.Temp (withSystemTempDirectory) +import System.Process (readProcessWithExitCode) +import Turtle + + +{-| A gipeda metric, later to be displayed in a graph. The `Text` will be used as + the name of the benchmark, the `Rational` is the actual metric which will be + graphed. this will be the timing nanoseconds for benchmarks, or the number + of build warnings. +-} +type Metric + = (Text, Rational) + + +{-| Parses the command line and optionally creates a temporary directory into which to clone + the passed repository (see @cloneRecursiveAndCheckout@). + After that, @compileAndBenchmark@ returns the parsed metrics which are then converted + into the gipeda CSV format. +-} +main :: IO () +main = sh $ do + (cloneOpts, verbose) <- options "cloben - optionally clone, benchmark and create gipeda logs" parser + dir <- case cloneOpts of + Just (repo, commit) -> do + dir <- using (mksystempdir "cloben") + cloneRecursiveAndCheckout repo commit dir verbose + return dir + Nothing -> pwd + metrics <- compileAndBenchmark dir verbose + echo (toCSV metrics) + + +parser :: Parser (Maybe (Text, Text), Bool) +parser = (,) <$> optional cloneOpts <*> verbose + where + cloneOpts = (,) + <$> argText "repo" "URL or file path of the repository to clone" + <*> argText "commit" "SHA prefix of the specific commit to benchmark" + verbose = + switch "verbose" 'v' "Output helpful debug messages as well as shell output" + + +-- | Like `Turtle.mktempdir`, but no need to specify a parent +mksystempdir :: Text -> Managed FilePath +mksystempdir prefix = do + let + prefix' = + unpack prefix + dir' <- managed (withSystemTempDirectory prefix') + -- We need to cd back into home before we delete dir' again, + -- otherwise we will quit with an error + managed (bracket (return ()) (const (home >>= cd))) + return (Filesystem.decodeString dir') + + +lefts' :: Fold (Either l r) [l] +lefts' = + Fold.Fold (\f -> either (\x -> f . (x:)) (const id)) id ($ []) + + +{-| @cloneRecursiveAndCheckout repo commit dir verbose@ effectively performs a + recursive @git clone@ on @repo@ and checks out the specified @commit@ into + the directory given by @dir@. + + If @verbose@ is @True@, useful debug output + is printed which normally interferes with the CSV output. +-} +cloneRecursiveAndCheckout :: Text -> Text -> FilePath -> Bool -> Shell () +cloneRecursiveAndCheckout repo commit dir verbose = do + let + log text = + when verbose (echo text) + + -- git seems to pipe to stderr mostly... So it won't pollute our audit + log "> git clone " + (clone, cloneOutput) <- procStrict "git" ["clone", "--quiet", repo, format fp dir] empty + reportError "git clone --quiet " clone cloneOutput + log "> Changing into the directory of the repository" + cd dir + log "> git reset --hard " + (reset, resetOutput) <- procStrict "git" ["reset", "--hard", commit] empty + reportError "git reset --hard " reset resetOutput + shellAndReportError "git submodule update --init --recursive --quiet" log + return () + + +{-| @compileAndBenchmark projectDir verbose@ builds the cabal project at @projectDir@ + with enabled benchmarks. It will try to utilize stack if at all possible + and will fall back to using cabal sandboxes. + + The number of warnings is extracted as a @Metric@ as @build/warnings;n@. + + After that, a @cabal bench@ is performed, of which the output is parsed for + standard criterion timing output, where the timings are in nanoseconds. + See `criterionBenchmarks`. + + If @verbose@ is @True@, useful debug output + is printed which normally interferes with the CSV output. + + Also @GHC_PACKAGE_PATH@ is set when executing this through @stack@, + which causes the build to error. That's why we unset. + Passing `--ghc-no-package-path` to `stack runghc` would help, but then we + can't specify the `turtle` package. So, unsetting is the only viable solution, + I think. + + When executing this script through @stack@, it will automatically find and use + the @cabal@ and @ghc@ binaries from the stack configuration. E.g., the result + of executing this script through @stack@ might have different results and + might even work when no @ghc@ or @cabal@ is on the path! + + For @cabal build@, we need to parse stderr for warnings. +-} +compileAndBenchmark :: FilePath -> Bool -> Shell [Metric] +compileAndBenchmark projectDir verbose = do + let + log text = + when verbose (echo text) + + cabalBench :: Shell (Text, Text) + cabalBench = do + log "> Unsetting GHC_PACKAGE_PATH" + unset "GHC_PACKAGE_PATH" + shellAndReportError "cabal sandbox init" log + shellAndReportError "cabal install -j --only-dependencies --enable-bench" log + shellAndReportError "cabal configure --enable-benchmark" log + log "> cabal bench" + -- cabal outputs warnings on stderr and benchmark statistics on stdout + stderr <- fold (inshellWithErr "cabal build" empty) (unlines <$> lefts') + stdout <- snd <$> shellAndReportError "cabal bench" log + return (stderr, stdout) + + stackInit :: Shell Bool + stackInit = do + exists <- testfile (projectDir "stack.yaml") + if not exists + then do + log "> No stack.yaml found" + code <- fst <$> shellAndReportError "stack init --solver" log + return (code == ExitSuccess) + else do + log "> Found stack.yaml" + return True + + tryStackAndFallBackToCabal :: Shell (Text, Text) + tryStackAndFallBackToCabal = do + log "> Changing in to the directory of the project" + cd projectDir + canUseStack <- stackInit + if canUseStack + then do + log "> stack bench" + -- stack outputs both warnings and benchmark statistics on stderr + export "STACK_LOCK" "true" + let + cmd :: IsString s => s + cmd = "stack bench --force-dirty" + (exitCode, stdout, stderr) <- liftIO $ + readProcessWithExitCode "stack" ["bench", "--force-dirty"] "" + reportError cmd exitCode (pack stderr) + return (pack stderr, pack stderr) + else do + log "Falling back to cabal" + cabalBench + + -- using head here is safe, since there is always a match + benchmarks :: Text -> [Metric] + benchmarks = + head . match criterionBenchmarks + + warnings :: Text -> Metric + warnings = + head . match buildWarnings + + (uncurry (:) . (warnings *** benchmarks)) <$> tryStackAndFallBackToCabal + + +shellAndReportError :: Text -> (Text -> Shell ()) -> Shell (ExitCode, Text) +shellAndReportError cmd log = do + log ("> " <> cmd) + (code, output) <- shellStrict cmd empty + reportError cmd code output + return (code, output) + + +reportError :: Text -> ExitCode -> Text -> Shell () +reportError cmd code output = + case code of + ExitSuccess -> return () + ExitFailure n -> die (cmd <> " failed with exit code " <> repr n <> + ". Output:\n" <> output) + + +buildWarnings :: Pattern Metric +buildWarnings = + nameAndLength <$> (selfless chars *> many (warning <* selfless chars)) + where + warning :: Pattern () + warning = + char ':' >> decimal >> char ':' >> decimal >> text ": Warning:" >> return () + + nameAndLength :: [a] -> (Text, Rational) + nameAndLength xs = + ("build/warnings", fromIntegral (length xs)) + + +criterionBenchmarks :: Pattern [Metric] +criterionBenchmarks = + selfless chars *> (mconcat <$> many benchmarkGroup) + where + benchmarkGroup :: Pattern [Metric] + benchmarkGroup = do + text "Benchmark " + group <- word + char ':' + selfless chars + benchmarks <- many (benchmark <* selfless chars1) + return (map (\(n, t) -> (group <> "/" <> n, t)) benchmarks) + + benchmark :: Pattern Metric + benchmark = do + text "benchmarking " + name <- word + newline + text "time" + spaces1 + time <- timing + spaces1 + siDivisor <- anySIDivisor + return (name, time / siDivisor * 10^^9) -- we want nanoseconds + + word :: Pattern Text + word = + plus (satisfy (not . isSpace)) + + decimalPlaces :: Rational -> Rational + decimalPlaces n = + if n < 1 + then n + else decimalPlaces (n / 10) + + timing :: Pattern Rational + timing = do + integral <- decimal + fraction <- (text "." *> decimal) <|> return 0 + return (integral + decimalPlaces (fromInteger fraction)) + + powerOf10 :: Text -> Int -> Pattern Rational + powerOf10 symbol e = + text symbol >> return (10^^e) + + anySIDivisor :: Pattern Rational + anySIDivisor = + choice + [ powerOf10 "s" 0 + , powerOf10 "ms" 3 + , powerOf10 "us" 6 + , powerOf10 "μs" 6 -- This is the unicode small greek letter mu + , powerOf10 "μs" 6 -- This is the unicode micro sign, actually not used by criterion + , powerOf10 "ns" 9 + , powerOf10 "ps" 12 + , powerOf10 "fs" 15 + , powerOf10 "as" 18 + ] + + +toCSV :: [Metric] -> Text +toCSV = + unlines . map (\(name, metric) -> name <> ";" <> showRat metric) + where + showRat :: Rational -> Text + showRat num = + -- The Nothing is for showing all digits. Terminates for our input + pack (showFFloat Nothing (fromRat num) "")