shake-bench (empty) → 0.1.0.0

raw patch · 3 files changed

+944/−0 lines, 3 filesdep +Chartdep +Chart-diagramsdep +aeson

Dependencies added: Chart, Chart-diagrams, aeson, base, diagrams, diagrams-svg, directory, extra, filepath, shake, text

Files

• LICENSE +201/−0
• shake-bench.cabal +44/−0
• src/Development/Benchmark/Rules.hs +699/−0

@@ -0,0 +1,201 @@+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright 2020-2021 Jose Iborra Lopez++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.

@@ -0,0 +1,44 @@+cabal-version: 2.2+name:          shake-bench+version:       0.1.0.0+synopsis:      Build rules for historical benchmarking+license:       Apache-2.0+license-file:  LICENSE+author:        Pepe Iborra+maintainer:    pepeiborra@gmail.com+category:      Development+build-type:    Simple+description:+  A library Shake rules to build and run benchmarks for multiple revisions of a project.+  An example of usage can be found in the ghcide benchmark suite++library+  exposed-modules:  Development.Benchmark.Rules+  hs-source-dirs:   src+  build-depends:+        aeson,+        base == 4.*,+        Chart,+        Chart-diagrams,+        diagrams,+        diagrams-svg,+        directory,+        extra >= 1.7.2,+        filepath,+        shake,+        text+  default-language: Haskell2010+  default-extensions:+        BangPatterns+        DeriveFunctor+        DeriveGeneric+        FlexibleContexts+        GeneralizedNewtypeDeriving+        LambdaCase+        NamedFieldPuns+        RecordWildCards+        ScopedTypeVariables+        StandaloneDeriving+        TupleSections+        TypeApplications+        ViewPatterns

@@ -0,0 +1,699 @@+{-# LANGUAGE AllowAmbiguousTypes       #-}+{-# LANGUAGE ApplicativeDo             #-}+{-# LANGUAGE ConstraintKinds           #-}+{-# LANGUAGE DeriveAnyClass            #-}+{-# LANGUAGE DerivingStrategies        #-}+{-# LANGUAGE DuplicateRecordFields     #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE TypeFamilies              #-}++{- |+    This module provides a bunch of Shake rules to build multiple revisions of a+    project and analyse their performance.++    It assumes a project bench suite composed of examples that runs a fixed set+    of experiments on every example++    Your code must implement all of the GetFoo oracles and the IsExample class,+    instantiate the Shake rules, and probably 'want' a set of targets.++    The results of the benchmarks and the analysis are recorded in the file+    system, using the following structure:++    <build-folder>+    ├── binaries+    │   └── <git-reference>+    │        ├── ghc.path                         - path to ghc used to build the executable+    │        └── <executable>                     - binary for this version+    │        └── commitid                         - Git commit id for this reference+    ├─ <example>+    │   ├── results.csv                           - aggregated results for all the versions+    │   └── <git-reference>+    │       ├── <experiment>.gcStats.log          - RTS -s output+    │       ├── <experiment>.csv                  - stats for the experiment+    │       ├── <experiment>.svg                  - Graph of bytes over elapsed time+    │       ├── <experiment>.diff.svg             - idem, including the previous version+    │       ├── <experiment>.heap.svg             - Heap profile+    │       ├── <experiment>.log                  - bench stdout+    │       └── results.csv                       - results of all the experiments for the example+    ├── results.csv        - aggregated results of all the experiments and versions+    └── <experiment>.svg   - graph of bytes over elapsed time, for all the included versions++   For diff graphs, the "previous version" is the preceding entry in the list of versions+   in the config file. A possible improvement is to obtain this info via `git rev-list`.+ -}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+module Development.Benchmark.Rules+  (+      buildRules, MkBuildRules(..),+      benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..),+      csvRules,+      svgRules,+      heapProfileRules,+      phonyRules,+      allTargetsForExample,+      GetExample(..), GetExamples(..),+      IsExample(..), RuleResultForExample,+      GetExperiments(..),+      GetVersions(..),+      GetCommitId(..),+      GetBuildSystem(..),+      BuildSystem(..), findGhcForBuildSystem,+      Escaped(..), Unescaped(..), escapeExperiment, unescapeExperiment,+      GitCommit++  ) where++import           Control.Applicative+import           Control.Monad+import           Data.Aeson                                (FromJSON (..),+                                                            ToJSON (..),+                                                            Value (..), (.!=),+                                                            (.:?))+import           Data.Char                                 (isDigit)+import           Data.List                                 (find, isInfixOf,+                                                            stripPrefix,+                                                            transpose)+import           Data.List.Extra                           (lower)+import           Data.Maybe                                (fromMaybe)+import           Data.Text                                 (Text)+import qualified Data.Text                                 as T+import           Development.Shake+import           Development.Shake.Classes                 (Binary, Hashable,+                                                            NFData, Typeable)+import           GHC.Exts                                  (IsList (toList),+                                                            fromList)+import           GHC.Generics                              (Generic)+import           GHC.Stack                                 (HasCallStack)+import qualified Graphics.Rendering.Chart.Backend.Diagrams as E+import           Graphics.Rendering.Chart.Easy             ((.=))+import qualified Graphics.Rendering.Chart.Easy             as E+import           System.Directory                          (createDirectoryIfMissing,+                                                            findExecutable,+                                                            renameFile)+import           System.FilePath+import           System.Time.Extra                         (Seconds)+import qualified Text.ParserCombinators.ReadP              as P+import           Text.Printf+import           Text.Read                                 (Read (..), get,+                                                            readMaybe,+                                                            readP_to_Prec)++newtype GetExperiments = GetExperiments () deriving newtype (Binary, Eq, Hashable, NFData, Show)+newtype GetVersions = GetVersions () deriving newtype (Binary, Eq, Hashable, NFData, Show)+newtype GetParent = GetParent Text deriving newtype (Binary, Eq, Hashable, NFData, Show)+newtype GetCommitId = GetCommitId String deriving newtype (Binary, Eq, Hashable, NFData, Show)+newtype GetBuildSystem = GetBuildSystem () deriving newtype (Binary, Eq, Hashable, NFData, Show)+newtype GetExample = GetExample String deriving newtype (Binary, Eq, Hashable, NFData, Show)+newtype GetExamples = GetExamples () deriving newtype (Binary, Eq, Hashable, NFData, Show)++type instance RuleResult GetExperiments = [Unescaped String]+type instance RuleResult GetVersions = [GitCommit]+type instance RuleResult GetParent = Text+type instance RuleResult GetCommitId = String+type instance RuleResult GetBuildSystem = BuildSystem++type RuleResultForExample e =+    ( RuleResult GetExample ~ Maybe e+    , RuleResult GetExamples ~ [e]+    , IsExample e)++-- | Knowledge needed to run an example+class (Binary e, Eq e, Hashable e, NFData e, Show e, Typeable e) => IsExample e where+    getExampleName :: e -> String++--------------------------------------------------------------------------------++allTargetsForExample :: IsExample e => ProfilingMode -> FilePath -> e -> Action [FilePath]+allTargetsForExample prof baseFolder ex = do+    experiments <- askOracle $ GetExperiments ()+    versions    <- askOracle $ GetVersions ()+    let buildFolder = baseFolder </> profilingPath prof+    return $+        [buildFolder </> getExampleName ex </> "results.csv"]+        ++ [ buildFolder </> getExampleName ex </> escaped (escapeExperiment e) <.> "svg"+             | e <- experiments+           ]+        ++ [ buildFolder </>+             getExampleName ex </>+             T.unpack (humanName ver) </>+             escaped (escapeExperiment e) <.> mode+             | e <- experiments,+               ver <- versions,+               mode <- ["svg", "diff.svg"] ++ ["heap.svg" | prof /= NoProfiling]+           ]++allBinaries :: FilePath -> String -> Action [FilePath]+allBinaries buildFolder executableName = do+    versions <- askOracle $ GetVersions ()+    return $+        [ buildFolder </> "binaries" </> T.unpack (humanName ver) </> executableName+        | ver <- versions]++-- | Generate a set of phony rules:+--     * <prefix>all+--     * <prefix><example>  for each example+phonyRules+    :: (Traversable t, IsExample e)+    => String         -- ^ prefix+    -> String         -- ^ Executable name+    -> ProfilingMode+    -> FilePath+    -> t e+    -> Rules ()+phonyRules prefix executableName prof buildFolder examples = do+    forM_ examples $ \ex ->+        phony (prefix <> getExampleName ex) $ need =<<+            allTargetsForExample prof buildFolder ex+    phony (prefix <> "all") $ do+        exampleTargets <- forM examples $ \ex ->+            allTargetsForExample prof buildFolder ex+        need $ [ buildFolder </> profilingPath prof </> "results.csv" ]+             ++ concat exampleTargets+    phony (prefix <> "all-binaries") $ need =<< allBinaries buildFolder executableName+--------------------------------------------------------------------------------+type OutputFolder = FilePath++data MkBuildRules buildSystem = MkBuildRules+  { -- | Return the path to the GHC executable to use for the project found in the cwd+    findGhc            :: buildSystem -> FilePath -> IO FilePath+    -- | Name of the binary produced by 'buildProject'+  , executableName     :: String+    -- | An action that captures the source dependencies, used for the HEAD build+  , projectDepends     :: Action ()+    -- | Build the project found in the cwd and save the build artifacts in the output folder+  , buildProject       :: buildSystem+                       -> [CmdOption]+                       -> OutputFolder+                       -> Action ()+  }++-- | Rules that drive a build system to build various revisions of a project+buildRules :: FilePattern -> MkBuildRules BuildSystem -> Rules ()+-- TODO generalize BuildSystem+buildRules build MkBuildRules{..} = do+  -- query git for the commitid for a version+  build -/- "binaries/*/commitid" %> \out -> do+      alwaysRerun++      let [_,_,ver,_] = splitDirectories out+      mbEntry <- find ((== T.pack ver) . humanName) <$> askOracle (GetVersions ())+      let gitThing :: String+          gitThing = maybe ver (T.unpack . gitName) mbEntry+      Stdout commitid <- command [] "git" ["rev-list", "-n", "1", gitThing]+      writeFileChanged out $ init commitid++  -- build rules for HEAD+  priority 10 $ [ build -/- "binaries/HEAD/" <> executableName+                , build -/- "binaries/HEAD/ghc.path"+                ]+    &%> \[out, ghcpath] -> do+      projectDepends+      liftIO $ createDirectoryIfMissing True $ dropFileName out+      buildSystem <- askOracle $ GetBuildSystem ()+      buildProject buildSystem [Cwd "."] (takeDirectory out)+      ghcLoc <- liftIO $ findGhc buildSystem "."+      writeFile' ghcpath ghcLoc++  -- build rules for non HEAD revisions+  [build -/- "binaries/*/" <> executableName+   ,build -/- "binaries/*/ghc.path"+   ] &%> \[out, ghcPath] -> do+      let [_, _binaries, ver, _] = splitDirectories out+      liftIO $ createDirectoryIfMissing True $ dropFileName out+      commitid <- readFile' $ takeDirectory out </> "commitid"+      cmd_ $ "git worktree add bench-temp-" ++ ver ++ " " ++ commitid+      buildSystem <- askOracle $ GetBuildSystem ()+      flip actionFinally (cmd_ ("git worktree remove bench-temp-" <> ver <> " --force" :: String)) $ do+        ghcLoc <- liftIO $ findGhc buildSystem ver+        buildProject buildSystem [Cwd $ "bench-temp-" <> ver] (".." </> takeDirectory out)+        writeFile' ghcPath ghcLoc++--------------------------------------------------------------------------------+data MkBenchRules buildSystem example =  forall setup. MkBenchRules+  {+  -- | Workaround for Shake not allowing to call 'askOracle' from 'benchProject+    setupProject :: Action setup+  -- | An action that invokes the executable to run the benchmark+  , benchProject :: setup -> buildSystem -> [CmdOption] -> BenchProject example -> Action ()+  -- | An action that performs any necessary warmup. Will only be invoked once+  , warmupProject :: buildSystem -> FilePath -> [CmdOption] -> example -> Action ()+  -- | Name of the executable to benchmark. Should match the one used to 'MkBuildRules'+  , executableName :: String+  }++data BenchProject example = BenchProject+    { outcsv       :: FilePath         -- ^ where to save the CSV output+    , exePath      :: FilePath         -- ^ where to find the executable for benchmarking+    , exeExtraArgs :: [String]         -- ^ extra args for the executable+    , example      :: example          -- ^ example to benchmark+    , experiment   :: Escaped String   -- ^ experiment to run+    }++data ProfilingMode = NoProfiling | CheapHeapProfiling Seconds+    deriving (Eq)++profilingP :: String -> Maybe ProfilingMode+profilingP "unprofiled" = Just NoProfiling+profilingP inp | Just delay <- stripPrefix "profiled-" inp, Just i <- readMaybe delay = Just $ CheapHeapProfiling i+profilingP _ = Nothing++profilingPath :: ProfilingMode -> FilePath+profilingPath NoProfiling            = "unprofiled"+profilingPath (CheapHeapProfiling i) = "profiled-" <> show i++-- TODO generalize BuildSystem+benchRules :: RuleResultForExample example => FilePattern -> MkBenchRules BuildSystem example -> Rules ()+benchRules build MkBenchRules{..} = do++  benchResource <- newResource "ghcide-bench" 1+  -- warmup an example+  build -/- "binaries/*/*.warmup" %> \out -> do+        let [_, _, ver, exampleName] = splitDirectories (dropExtension out)+        let exePath = build </> "binaries" </> ver </> executableName+            ghcPath = build </> "binaries" </> ver </> "ghc.path"+        need [exePath, ghcPath]+        buildSystem <- askOracle  $ GetBuildSystem ()+        example <- fromMaybe (error $ "Unknown example " <> exampleName)+                    <$> askOracle (GetExample exampleName)+        let exeExtraArgs = []+            outcsv = ""+            experiment = Escaped "hover"+        withResource benchResource 1 $ warmupProject buildSystem exePath+              [ EchoStdout False,+                FileStdout out,+                RemEnv "NIX_GHC_LIBDIR",+                RemEnv "GHC_PACKAGE_PATH",+                AddPath [takeDirectory ghcPath, "."] []+              ]+              example+  -- run an experiment+  priority 0 $+    [ build -/- "*/*/*/*.csv",+      build -/- "*/*/*/*.gcStats.log",+      build -/- "*/*/*/*.output.log",+      build -/- "*/*/*/*.eventlog",+      build -/- "*/*/*/*.hp"+    ] &%> \[outcsv, outGc, outLog, outEventlog, outHp] -> do+        let [_, flavour, exampleName, ver, exp] = splitDirectories outcsv+            prof = fromMaybe (error $ "Not a valid profiling mode: " <> flavour) $ profilingP flavour+        example <- fromMaybe (error $ "Unknown example " <> exampleName)+                    <$> askOracle (GetExample exampleName)+        buildSystem <- askOracle  $ GetBuildSystem ()+        setupRes    <- setupProject+        liftIO $ createDirectoryIfMissing True $ dropFileName outcsv+        let exePath    = build </> "binaries" </> ver </> executableName+            exeExtraArgs =+                [ "+RTS"+                , "-l-au"+                , "-S" <> outGc]+             ++ concat+                [[ "-h"+                  , "-i" <> show i+                  , "-qg"]+                 | CheapHeapProfiling i <- [prof]]+             ++ ["-RTS"]+            ghcPath    = build </> "binaries" </> ver </> "ghc.path"+            warmupPath = build </> "binaries" </> ver </> exampleName <.> "warmup"+            experiment = Escaped $ dropExtension exp+        need [exePath, ghcPath, warmupPath]+        ghcPath <- readFile' ghcPath+        withResource benchResource 1 $ do+          benchProject setupRes buildSystem+              [ EchoStdout False,+                FileStdout outLog,+                RemEnv "NIX_GHC_LIBDIR",+                RemEnv "GHC_PACKAGE_PATH",+                AddPath [takeDirectory ghcPath, "."] []+              ]+              BenchProject {..}+        liftIO $ renameFile "ghcide.eventlog" outEventlog+        liftIO $ case prof of+            CheapHeapProfiling{} -> renameFile "ghcide.hp" outHp+            NoProfiling          -> writeFile outHp dummyHp++        -- extend csv output with allocation data+        csvContents <- liftIO $ lines <$> readFile outcsv+        let header = head csvContents+            results = tail csvContents+            header' = header <> ", maxResidency, allocatedBytes"+        results' <- forM results $ \row -> do+            (maxResidency, allocations) <- liftIO+                    (parseMaxResidencyAndAllocations <$> readFile outGc)+            return $ printf "%s, %s, %s" row (showMB maxResidency) (showMB allocations)+        let csvContents' = header' : results'+        writeFileLines outcsv csvContents'+    where+        showMB :: Int -> String+        showMB x = show (x `div` 2^(20::Int)) <> "MB"++-- Parse the max residency and allocations in RTS -s output+parseMaxResidencyAndAllocations :: String -> (Int, Int)+parseMaxResidencyAndAllocations input =+    (f "maximum residency", f "bytes allocated in the heap")+  where+    inps = reverse $ lines input+    f label = case find (label `isInfixOf`) inps of+        Just l  -> read $ filter isDigit $ head $ words l+        Nothing -> -1+++--------------------------------------------------------------------------------++-- | Rules to aggregate the CSV output of individual experiments+csvRules :: forall example . RuleResultForExample example => FilePattern -> Rules ()+csvRules build = do+  -- build results for every experiment*example+  build -/- "*/*/*/results.csv" %> \out -> do+      experiments <- askOracle $ GetExperiments ()++      let allResultFiles = [takeDirectory out </> escaped (escapeExperiment e) <.> "csv" | e <- experiments]+      allResults <- traverse readFileLines allResultFiles++      let header = head $ head allResults+          results = map tail allResults+      writeFileChanged out $ unlines $ header : concat results++  -- aggregate all experiments for an example+  build -/- "*/*/results.csv" %> \out -> do+    versions <- map (T.unpack . humanName) <$> askOracle (GetVersions ())+    let allResultFiles = [takeDirectory out </> v </> "results.csv" | v <- versions]++    allResults <- traverse readFileLines allResultFiles++    let header = head $ head allResults+        results = map tail allResults+        header' = "version, " <> header+        results' = zipWith (\v -> map (\l -> v <> ", " <> l)) versions results++    writeFileChanged out $ unlines $ header' : interleave results'++  -- aggregate all examples+  build -/- "*/results.csv" %> \out -> do+    examples <- map (getExampleName @example) <$> askOracle (GetExamples ())+    let allResultFiles = [takeDirectory out </> e </> "results.csv" | e <- examples]++    allResults <- traverse readFileLines allResultFiles++    let header = head $ head allResults+        results = map tail allResults+        header' = "example, " <> header+        results' = zipWith (\e -> map (\l -> e <> ", " <> l)) examples results++    writeFileChanged out $ unlines $ header' : concat results'++--------------------------------------------------------------------------------++-- | Rules to produce charts for the GC stats+svgRules :: FilePattern -> Rules ()+svgRules build = do+  void $ addOracle $ \(GetParent name) -> findPrev name <$> askOracle (GetVersions ())+  -- chart GC stats for an experiment on a given revision+  priority 1 $+    build -/- "*/*/*/*.svg" %> \out -> do+      let [_, _, _example, ver, _exp] = splitDirectories out+      runLog <- loadRunLog (Escaped $ replaceExtension out "csv") ver+      let diagram = Diagram Live [runLog] title+          title = ver <> " live bytes over time"+      plotDiagram True diagram out++  -- chart of GC stats for an experiment on this and the previous revision+  priority 2 $+    build -/- "*/*/*/*.diff.svg" %> \out -> do+      let [b, flav, example, ver, exp_] = splitDirectories out+          exp = Escaped $ dropExtension2 exp_+      prev <- fmap T.unpack $ askOracle $ GetParent $ T.pack ver++      runLog <- loadRunLog (Escaped $ replaceExtension (dropExtension out) "csv") ver+      runLogPrev <- loadRunLog (Escaped $ joinPath [b,flav, example, prev, replaceExtension (dropExtension exp_) "csv"]) prev++      let diagram = Diagram Live [runLog, runLogPrev] title+          title = show (unescapeExperiment exp) <> " - live bytes over time compared"+      plotDiagram True diagram out++  -- aggregated chart of GC stats for all the revisions+  build -/- "*/*/*.svg" %> \out -> do+    let exp = Escaped $ dropExtension $ takeFileName out+    versions <- askOracle $ GetVersions ()++    runLogs <- forM (filter include versions) $ \v -> do+      let v' = T.unpack (humanName v)+      loadRunLog (Escaped $ takeDirectory out </> v' </> replaceExtension (takeFileName out) "csv") v'++    let diagram = Diagram Live runLogs title+        title = show (unescapeExperiment exp) <> " - live bytes over time"+    plotDiagram False diagram out++heapProfileRules :: FilePattern -> Rules ()+heapProfileRules build = do+  priority 3 $+    build -/- "*/*/*/*.heap.svg" %> \out -> do+      let hpFile = dropExtension2 out <.> "hp"+      need [hpFile]+      cmd_ ("hp2pretty" :: String) [hpFile]+      liftIO $ renameFile (dropExtension hpFile <.> "svg") out++dropExtension2 :: FilePath -> FilePath+dropExtension2 = dropExtension . dropExtension+--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++-- | Default build system that handles Cabal and Stack+data BuildSystem = Cabal | Stack+  deriving (Eq, Read, Show, Generic)+  deriving (Binary, Hashable, NFData)++findGhcForBuildSystem :: BuildSystem -> FilePath -> IO FilePath+findGhcForBuildSystem Cabal _cwd =+    liftIO $ fromMaybe (error "ghc is not in the PATH") <$> findExecutable "ghc"+findGhcForBuildSystem Stack cwd = do+    Stdout ghcLoc <- cmd [Cwd cwd] ("stack exec which ghc" :: String)+    return ghcLoc++instance FromJSON BuildSystem where+    parseJSON x = fromString . lower <$> parseJSON x+      where+        fromString "stack" = Stack+        fromString "cabal" = Cabal+        fromString other   = error $ "Unknown build system: " <> other++instance ToJSON BuildSystem where+    toJSON = toJSON . show++--------------------------------------------------------------------------------++data GitCommit = GitCommit+  { -- | A git hash, tag or branch name (e.g. v0.1.0)+    gitName :: Text,+    -- | A human understandable name (e.g. fix-collisions-leak)+    name    :: Maybe Text,+    -- | The human understandable name of the parent, if specified explicitly+    parent  :: Maybe Text,+    -- | Whether to include this version in the top chart+    include :: Bool+  }+  deriving (Binary, Eq, Hashable, Generic, NFData, Show)++instance FromJSON GitCommit where+  parseJSON (String s) = pure $ GitCommit s Nothing Nothing True+  parseJSON (Object (toList -> [(name, String gitName)])) =+    pure $ GitCommit gitName (Just name) Nothing True+  parseJSON (Object (toList -> [(name, Object props)])) =+    GitCommit+      <$> props .:? "git"  .!= name+      <*> pure (Just name)+      <*> props .:? "parent"+      <*> props .:? "include" .!= True+  parseJSON _ = empty++instance ToJSON GitCommit where+  toJSON GitCommit {..} =+    case name of+      Nothing -> String gitName+      Just n  -> Object $ fromList [(n, String gitName)]++humanName :: GitCommit -> Text+humanName GitCommit {..} = fromMaybe gitName name++findPrev :: Text -> [GitCommit] -> Text+findPrev name (x : y : xx)+  | humanName y == name = humanName x+  | otherwise = findPrev name (y : xx)+findPrev name _ = name++--------------------------------------------------------------------------------++-- | A line in the output of -S+data Frame = Frame+  { allocated, copied, live            :: !Int,+    user, elapsed, totUser, totElapsed :: !Double,+    generation                         :: !Int+  }+  deriving (Show)++instance Read Frame where+  readPrec = do+    spaces+    allocated <- readPrec @Int <* spaces+    copied <- readPrec @Int <* spaces+    live <- readPrec @Int <* spaces+    user <- readPrec @Double <* spaces+    elapsed <- readPrec @Double <* spaces+    totUser <- readPrec @Double <* spaces+    totElapsed <- readPrec @Double <* spaces+    _ <- readPrec @Int <* spaces+    _ <- readPrec @Int <* spaces+    "(Gen:  " <- replicateM 7 get+    generation <- readPrec @Int+    ')' <- get+    return Frame {..}+    where+      spaces = readP_to_Prec $ const P.skipSpaces++-- | A file path containing the output of -S for a given run+data RunLog = RunLog+  { runVersion :: !String,+    runFrames  :: ![Frame],+    runSuccess :: !Bool+  }++loadRunLog :: HasCallStack => Escaped FilePath -> String -> Action RunLog+loadRunLog (Escaped csv_fp) ver = do+  let log_fp = replaceExtension csv_fp "gcStats.log"+  log <- readFileLines log_fp+  csv <- readFileLines csv_fp+  let frames =+        [ f+          | l <- log,+            Just f <- [readMaybe l],+            -- filter out gen 0 events as there are too many+            generation f == 1+        ]+      -- TODO this assumes a certain structure in the CSV file+      success = case map (T.split (== ',') . T.pack) csv of+          [_header, _name:s:_] | Just s <- readMaybe (T.unpack s) -> s+          _ -> error $ "Cannot parse: " <> csv_fp+  return $ RunLog ver frames success++--------------------------------------------------------------------------------++data TraceMetric = Allocated | Copied | Live | User | Elapsed+  deriving (Generic, Enum, Bounded, Read)++instance Show TraceMetric where+  show Allocated = "Allocated bytes"+  show Copied    = "Copied bytes"+  show Live      = "Live bytes"+  show User      = "User time"+  show Elapsed   = "Elapsed time"++frameMetric :: TraceMetric -> Frame -> Double+frameMetric Allocated = fromIntegral . allocated+frameMetric Copied    = fromIntegral . copied+frameMetric Live      = fromIntegral . live+frameMetric Elapsed   = elapsed+frameMetric User      = user++data Diagram = Diagram+  { traceMetric :: TraceMetric,+    runLogs     :: [RunLog],+    title       :: String+  }+  deriving (Generic)++plotDiagram :: Bool -> Diagram -> FilePath -> Action ()+plotDiagram includeFailed t@Diagram {traceMetric, runLogs} out = do+  let extract = frameMetric traceMetric+  liftIO $ E.toFile E.def out $ do+    E.layout_title .= title t+    E.setColors myColors+    forM_ runLogs $ \rl ->+      when (includeFailed || runSuccess rl) $ E.plot $ do+        lplot <- E.line+            (runVersion rl ++ if runSuccess rl then "" else " (FAILED)")+            [ [ (totElapsed f, extract f)+                | f <- runFrames rl+                ]+            ]+        return (lplot E.& E.plot_lines_style . E.line_width E.*~ 2)++--------------------------------------------------------------------------------++newtype Escaped a = Escaped {escaped :: a}++newtype Unescaped a = Unescaped {unescaped :: a}+  deriving newtype (Show, FromJSON, ToJSON, Eq, NFData, Binary, Hashable)++escapeExperiment :: Unescaped String -> Escaped String+escapeExperiment = Escaped . map f . unescaped+  where+    f ' '   = '_'+    f other = other++unescapeExperiment :: Escaped String -> Unescaped String+unescapeExperiment = Unescaped . map f . escaped+  where+    f '_'   = ' '+    f other = other++--------------------------------------------------------------------------------++(-/-) :: FilePattern -> FilePattern -> FilePattern+a -/- b = a <> "/" <> b++interleave :: [[a]] -> [a]+interleave = concat . transpose++--------------------------------------------------------------------------------++myColors :: [E.AlphaColour Double]+myColors = map E.opaque+  [ E.blue+  , E.green+  , E.red+  , E.orange+  , E.yellow+  , E.violet+  , E.black+  , E.gold+  , E.brown+  , E.hotpink+  , E.aliceblue+  , E.aqua+  , E.beige+  , E.bisque+  , E.blueviolet+  , E.burlywood+  , E.cadetblue+  , E.chartreuse+  , E.coral+  , E.crimson+  , E.darkblue+  , E.darkgray+  , E.darkgreen+  , E.darkkhaki+  , E.darkmagenta+  , E.deeppink+  , E.dodgerblue+  , E.firebrick+  , E.forestgreen+  , E.fuchsia+  , E.greenyellow+  , E.lightsalmon+  , E.seagreen+  , E.olive+  , E.sandybrown+  , E.sienna+  , E.peru+  ]++dummyHp :: String+dummyHp =+    "JOB \"ghcide\" \+    \DATE \"Sun Jan 31 09:30 2021\" \+    \SAMPLE_UNIT \"seconds\" \+    \VALUE_UNIT \"bytes\" \+    \BEGIN_SAMPLE 0.000000 \+    \END_SAMPLE 0.000000"