diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +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 +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 --- a/README.md +++ b/README.md @@ -1,107 +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. +# `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 --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/cloben.cabal b/cloben.cabal --- a/cloben.cabal +++ b/cloben.cabal @@ -1,45 +1,45 @@ -name: cloben -version: 0.1.0.1 -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 +name: cloben +version: 0.1.0.2 +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 --- a/cloben.hs +++ b/cloben.hs @@ -1,301 +1,304 @@ -#!/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 --install-ghc" - (exitCode, stdout, stderr) <- liftIO $ - readProcessWithExitCode "stack" ["bench", "--force-dirty", "--install-ghc"] "" - 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) "") +#!/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" + log "> stack init --solver" + (code, stdout, stderr) <- liftIO $ + readCreateProcessWithExitCode (Proc.shell "stack init --solver") "" + log (pack stderr) + 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 --install-ghc" + (exitCode, stdout, stderr) <- liftIO $ + readProcessWithExitCode "stack" ["bench", "--force-dirty", "--install-ghc"] "" + 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) "")