cloben 0.1.0.1 → 0.1.0.2
raw patch · 5 files changed
+487/−484 lines, 5 filessetup-changed
Files
- LICENSE +29/−29
- README.md +107/−107
- Setup.hs +2/−2
- cloben.cabal +45/−45
- cloben.hs +304/−301
LICENSE view
@@ -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.
README.md view
@@ -1,107 +1,107 @@-# `cloben` [](https://travis-ci.org/sgraf812/cloben) [](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 <repo> <commit>` 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` [](https://travis-ci.org/sgraf812/cloben) [](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 <repo> <commit>` 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.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
cloben.cabal view
@@ -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
cloben.hs view
@@ -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 <https://github.com/nomeata/gipeda gipeda>. - - 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 <repo> <dir>" - (clone, cloneOutput) <- procStrict "git" ["clone", "--quiet", repo, format fp dir] empty - reportError "git clone --quiet <repo> <dir>" clone cloneOutput - log "> Changing into the directory of the repository" - cd dir - log "> git reset --hard <commit>" - (reset, resetOutput) <- procStrict "git" ["reset", "--hard", commit] empty - reportError "git reset --hard <commit>" 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 <https://github.com/nomeata/gipeda gipeda>.++ 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 <repo> <dir>"+ (clone, cloneOutput) <- procStrict "git" ["clone", "--quiet", repo, format fp dir] empty+ reportError "git clone --quiet <repo> <dir>" clone cloneOutput+ log "> Changing into the directory of the repository"+ cd dir+ log "> git reset --hard <commit>"+ (reset, resetOutput) <- procStrict "git" ["reset", "--hard", commit] empty+ reportError "git reset --hard <commit>" 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) "")