shake-bench 0.2.0.0 → 0.3.0.0

raw patch · 2 files changed

+120/−353 lines, 2 filesdep −Chartdep −Chart-diagramsdep −diagrams-contribPVP ok

version bump matches the API change (PVP)

Dependencies removed: Chart, Chart-diagrams, diagrams-contrib, diagrams-core, diagrams-lib, diagrams-svg

API changes (from Hackage documentation)

Files

• shake-bench.cabal +2/−18
• src/Development/Benchmark/Rules.hs +118/−335

@@ -1,6 +1,6 @@ cabal-version: 2.2 name:          shake-bench-version:       0.2.0.0+version:       0.3.0.0 synopsis:      Build rules for historical benchmarking license:       Apache-2.0 license-file:  LICENSE@@ -22,12 +22,6 @@         aeson,         base == 4.*,         bytestring,-        Chart,-        Chart-diagrams,-        diagrams-contrib,-        diagrams-core,-        diagrams-lib,-        diagrams-svg,         directory,         extra >= 1.7.2,         filepath,@@ -36,18 +30,8 @@         mtl,         shake,         text-  default-language: Haskell2010+  default-language: GHC2021   default-extensions:-        BangPatterns-        DeriveFunctor-        DeriveGeneric-        FlexibleContexts-        GeneralizedNewtypeDeriving         LambdaCase-        NamedFieldPuns         RecordWildCards-        ScopedTypeVariables-        StandaloneDeriving-        TupleSections-        TypeApplications         ViewPatterns

@@ -1,13 +1,10 @@-{-# LANGUAGE AllowAmbiguousTypes       #-}-{-# LANGUAGE ApplicativeDo             #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE DeriveAnyClass            #-}-{-# LANGUAGE DerivingStrategies        #-}-{-# LANGUAGE DuplicateRecordFields     #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings         #-}-{-# LANGUAGE RankNTypes                #-}-{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE ApplicativeDo         #-}+{-# LANGUAGE DeriveAnyClass        #-}+{-# LANGUAGE DerivingStrategies    #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeFamilies          #-}  {- |     This module provides a bunch of Shake rules to build multiple revisions of a@@ -30,20 +27,17 @@     │        └── commitid                         - Git commit id for this reference     ├─ <example>     │   ├── results.csv                           - aggregated results for all the versions and configurations-    │   ├── <experiment>.svg                      - graph of bytes over elapsed time, for all the versions and configurations     |   └── <git-reference>     │       └── <configuration>     │           ├── <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>.hp                   - raw heap profile data     │           ├── <experiment>.log                  - bench stdout     │           └── results.csv                       - results of all the experiments for the example     ├── results.csv        - aggregated results of all the examples, experiments, versions and configurations-    └── <experiment>.svg   - graph of bytes over elapsed time, for all the examples, experiments, versions and configurations+    └── resultDiff.csv     - diff of aggregated results compared with previous version -   For diff graphs, the "previous version" is the preceding entry in the list of versions+   For diff results, 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 #-}@@ -51,9 +45,8 @@   (       buildRules, MkBuildRules(..), OutputFolder, ProjectRoot,       benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..),+      addGetParentOracle,       csvRules,-      svgRules,-      heapProfileRules,       phonyRules,       allTargetsForExample,       GetExample(..), GetExamples(..),@@ -70,45 +63,32 @@   ) where  import           Control.Applicative-import           Control.Lens                              (preview, view, (^.))+import           Control.Lens              (preview, (^.)) import           Control.Monad-import qualified Control.Monad.State                       as S-import           Data.Aeson                                (FromJSON (..),-                                                            ToJSON (..),-                                                            Value (..), object,-                                                            (.!=), (.:?), (.=))-import           Data.Aeson.Lens                           (AsJSON (_JSON),-                                                            _Object, _String)-import           Data.ByteString.Lazy                      (ByteString)-import           Data.Char                                 (isDigit)-import           Data.List                                 (find, isInfixOf,-                                                            stripPrefix,-                                                            transpose)-import           Data.List.Extra                           (lower)-import           Data.Maybe                                (fromMaybe)-import           Data.String                               (fromString)-import           Data.Text                                 (Text)-import qualified Data.Text                                 as T+import           Data.Aeson                (FromJSON (..), ToJSON (..),+                                            Value (..), object, (.!=), (.:?),+                                            (.=))+import           Data.Aeson.Lens           (AsJSON (_JSON), _Object, _String)+import           Data.ByteString.Lazy      (ByteString)+import           Data.Char                 (isDigit)+import           Data.List                 (find, intercalate, isInfixOf,+                                            isSuffixOf, stripPrefix, transpose)+import           Data.List.Extra           (lower, splitOn)+import           Data.Maybe                (fromMaybe)+import           Data.String               (fromString)+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 qualified Graphics.Rendering.Chart.Easy             as E+import           Development.Shake.Classes (Binary, Hashable, NFData, Typeable)+import           GHC.Exts                  (IsList (toList), fromList)+import           GHC.Generics              (Generic) import           Numeric.Natural-import           System.Directory                          (createDirectoryIfMissing,-                                                            findExecutable,-                                                            renameFile)+import           System.Directory          (createDirectoryIfMissing,+                                            findExecutable) import           System.FilePath-import           System.Time.Extra                         (Seconds)-import qualified Text.ParserCombinators.ReadP              as P+import           System.Time.Extra         (Seconds) import           Text.Printf-import           Text.Read                                 (Read (..), get,-                                                            readMaybe,-                                                            readP_to_Prec)+import           Text.Read                 (readMaybe)  newtype GetExperiments = GetExperiments () deriving newtype (Binary, Eq, Hashable, NFData, Show) newtype GetVersions = GetVersions () deriving newtype (Binary, Eq, Hashable, NFData, Show)@@ -131,7 +111,7 @@     , IsExample e)  data Configuration = Configuration {confName :: String, confValue :: ByteString}-    deriving (Binary, Eq, Generic, Hashable, NFData, Show, Typeable)+    deriving (Binary, Eq, Generic, Hashable, NFData, Show) type instance RuleResult GetConfigurations = [Configuration]  -- | Knowledge needed to run an example@@ -142,26 +122,11 @@  allTargetsForExample :: IsExample e => ProfilingMode -> FilePath -> e -> Action [FilePath] allTargetsForExample prof baseFolder ex = do-    experiments <- askOracle $ GetExperiments ()-    versions    <- askOracle $ GetVersions ()-    configurations <- askOracle $ GetConfigurations ()     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) </>-             confName </>-             escaped (escapeExperiment e) <.>-             mode-             | e <- experiments,-               ver <- versions,-               Configuration{confName} <- configurations,-               mode <- ["svg", "diff.svg"] ++ ["heap.svg" | prof /= NoProfiling]-           ]+        [+            buildFolder </> getExampleName ex </> "results.csv"+            , buildFolder </> getExampleName ex </> "resultDiff.csv"]  allBinaries :: FilePath -> String -> Action [FilePath] allBinaries buildFolder executableName = do@@ -190,6 +155,8 @@             allTargetsForExample prof buildFolder ex         need $ (buildFolder </> profilingPath prof </> "results.csv")              : concat exampleTargets+        need $ (buildFolder </> profilingPath prof </> "resultDiff.csv")+             : concat exampleTargets     phony (prefix <> "all-binaries") $ need =<< allBinaries buildFolder executableName -------------------------------------------------------------------------------- type OutputFolder = FilePath@@ -336,7 +303,7 @@              ++ concat                 [[ "-h"                   , "-i" <> show i-                  , "-po" <> outHp+                  , "-po" <> dropExtension outHp                   , "-qg"]                  | CheapHeapProfiling i <- [prof]]              ++ ["-RTS"]@@ -387,134 +354,106 @@   ---------------------------------------------------------------------------------+-- | oracles to get previous version of a given version+-- used for diff the results+addGetParentOracle :: Rules ()+addGetParentOracle = void $ addOracle $ \(GetParent name) -> findPrev name <$> askOracle (GetVersions ()) -- | Rules to aggregate the CSV output of individual experiments csvRules :: forall example . RuleResultForExample example => FilePattern -> Rules () csvRules build = do+  let genConfig resultName prefixName prefixOracles out = do+        configurations <- prefixOracles+        let allResultFiles = [takeDirectory out </> c </> resultName | c <- configurations ]+        allResults <- traverse readFileLines allResultFiles+        let header = head $ head allResults+            results = map tail allResults+            header' = prefixName <> ", " <> header+            results' = zipWith (\v -> map (\l -> v <> ", " <> l)) configurations results+        writeFileChanged out $ unlines $ header' : interleave results'   -- build results for every experiment*example-  build -/- "*/*/*/*/results.csv" %> \out -> do+  priority 1 $ 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-+  priority 2 $ build -/- "*/*/*/*/resultDiff.csv" %> \out -> do+    let [b, flav, example, ver, conf, _exp] = splitDirectories out+    prev <- fmap T.unpack $ askOracle $ GetParent $ T.pack ver+    allResultsCur <- readFileLines $ joinPath [b ,flav, example, ver, conf] </> "results.csv"+    resultDiff <-+      if prev == ver+        then pure []+        else do+          allResultsPrev <- readFileLines $ joinPath [b ,flav, example, prev, conf] </> "results.csv"+          let resultsPrev = tail allResultsPrev+          let resultsCur = tail allResultsCur+          pure $ zipWith convertToDiffResults resultsCur resultsPrev+    writeFileChanged out $ unlines $ head allResultsCur : resultDiff   -- aggregate all configurations for an experiment-  build -/- "*/*/*/results.csv" %> \out -> do-    configurations <- map confName <$> askOracle (GetConfigurations ())-    let allResultFiles = [takeDirectory out </> c </> "results.csv" | c <- configurations ]--    allResults <- traverse readFileLines allResultFiles--    let header = head $ head allResults-        results = map tail allResults-        header' = "configuration, " <> header-        results' = zipWith (\v -> map (\l -> v <> ", " <> l)) configurations results--    writeFileChanged out $ unlines $ header' : interleave results'-+  priority 3 $ build -/- "*/*/*/results.csv" %> genConfig "results.csv"+    "Configuration" (map confName <$> askOracle (GetConfigurations ()))+  priority 3 $ build -/- "*/*/*/resultDiff.csv" %> genConfig "resultDiff.csv"+    "Configuration" (map confName <$> askOracle (GetConfigurations ()))   -- 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'-+  priority 4 $ build -/- "*/*/results.csv" %> genConfig "results.csv"+        "Version" (map (T.unpack . humanName) <$> askOracle (GetVersions ()))+  priority 4 $ build -/- "*/*/resultDiff.csv" %> genConfig "resultDiff.csv"+        "Version" (map (T.unpack . humanName) <$> askOracle (GetVersions ()))   -- 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, conf, _exp] = splitDirectories out-      runLog <- loadRunLog (Escaped $ replaceExtension out "csv") ver conf-      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, conf, exp_] = splitDirectories out-          exp = Escaped $ dropExtension2 exp_-      prev <- fmap T.unpack $ askOracle $ GetParent $ T.pack ver--      runLog <- loadRunLog (Escaped $ replaceExtension (dropExtension out) "csv") ver conf-      runLogPrev <- loadRunLog (Escaped $ joinPath [b,flav, example, prev, conf, replaceExtension (dropExtension exp_) "csv"]) prev conf--      let diagram = Diagram Live [runLog, runLogPrev] title-          title = show (unescapeExperiment exp) <> " - live bytes over time compared"-      plotDiagram True diagram out+  priority 5 $ build -/- "*/results.csv" %> genConfig "results.csv"+        "Example" (map getExampleName <$> askOracle (GetExamples ()))+  priority 5 $ build -/- "*/resultDiff.csv" %> genConfig "resultDiff.csv"+        "Example" (map getExampleName <$> askOracle (GetExamples ())) -  -- aggregated chart of GC stats for all the configurations-  build -/- "*/*/*/*.svg" %> \out -> do-    let exp = Escaped $ dropExtension $ takeFileName out-        [b, flav, example, ver] = splitDirectories out-    versions <- askOracle $ GetVersions ()-    configurations <- askOracle $ GetConfigurations ()+convertToDiffResults :: String -> String -> String+convertToDiffResults line baseLine = intercalate "," diffResults+        where items = parseLine line+              baseItems = parseLine baseLine+              diffItems = zipWith diffItem items baseItems+              diffResults = map showItemDiffResult diffItems -    runLogs <- forM configurations $ \Configuration{confName} -> do-      loadRunLog (Escaped $ takeDirectory out </> confName </> replaceExtension (takeFileName out) "csv") ver confName+showItemDiffResult ::  (Item, Maybe Double) -> String+showItemDiffResult (ItemString x, _) = x+showItemDiffResult (_, Nothing)      = "NA"+showItemDiffResult (Mem _, Just y)   = showPercentageDiff y+showItemDiffResult (Time _, Just y)  = showPercentageDiff y -    let diagram = Diagram Live runLogs title-        title = show (unescapeExperiment exp) <> " - live bytes over time"-    plotDiagram False diagram out+showPercentageDiff :: Double -> String+showPercentageDiff ratio+  | not (isFinite percent) = "NA"+  | otherwise = printf "%.2f" percent <> "%"+  where+    percent = ratio * 100 - 100 -  -- aggregated chart of GC stats for all the revisions-  build -/- "*/*/*.svg" %> \out -> do-    let exp = Escaped $ dropExtension $ takeFileName out-    versions <- askOracle $ GetVersions ()-    configurations <- askOracle $ GetConfigurations ()+isFinite :: Double -> Bool+isFinite x = not (isNaN x || isInfinite x) -    runLogs <- forM (filter include versions) $ \v ->-                forM configurations $ \Configuration{confName} -> do-      let v' = T.unpack (humanName v)-      loadRunLog (Escaped $ takeDirectory out </> v' </> confName </> replaceExtension (takeFileName out) "csv") v' confName+diffItem :: Item -> Item -> (Item, Maybe Double)+diffItem (Mem x) (Mem y) = (Mem x, ratioMaybe (fromIntegral x) (fromIntegral y))+diffItem (Time x) (Time y) = (Time x, ratioMaybe x y)+diffItem (ItemString x) (ItemString y) = (ItemString x, Nothing)+diffItem _ _ = (ItemString "no match", Nothing) -    let diagram = Diagram Live (concat runLogs) title-        title = show (unescapeExperiment exp) <> " - live bytes over time"-    plotDiagram False diagram out+ratioMaybe :: Double -> Double -> Maybe Double+ratioMaybe x y+  | y == 0 = Nothing+  | not (isFinite x && isFinite y) = Nothing+  | otherwise = Just $ x / y -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+data Item = Mem Int | Time Double | ItemString String+  deriving (Show) -dropExtension2 :: FilePath -> FilePath-dropExtension2 = dropExtension . dropExtension------------------------------------------------------------------------------------------------------------------------------------------------------------------+parseLine :: String -> [Item]+parseLine = map f . splitOn ","+  where+    f x+      | "MB" `isSuffixOf` x = Mem $ read $ reverse $ drop 2 $ reverse x+      | otherwise =+            case readMaybe @Double x of+                Just time -> Time time+                Nothing   -> ItemString x  -- | Default build system that handles Cabal and Stack data BuildSystem = Cabal | Stack@@ -584,119 +523,6 @@   | 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,-    runConfiguration :: !String,-    runFrames        :: ![Frame],-    runSuccess       :: !Bool,-    runFirstReponse  :: !(Maybe Seconds)-  }--loadRunLog :: HasCallStack => Escaped FilePath -> String -> String -> Action RunLog-loadRunLog (Escaped csv_fp) ver conf = 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, firstResponse) = case map (map T.strip . T.split (== ',') . T.pack) csv of-          [header, row]-            | let table = zip header row-                  timeForFirstResponse :: Maybe Seconds-                  timeForFirstResponse = readMaybe . T.unpack =<< lookup "firstBuildTime" table-            , Just s <- lookup "success" table-            , Just s <- readMaybe (T.unpack s)-            -> (s,timeForFirstResponse)-          _ -> error $ "Cannot parse: " <> csv_fp-  return $ RunLog ver conf frames success firstResponse------------------------------------------------------------------------------------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 E..= title t-    E.setColors myColors-    forM_ runLogs $ \rl ->-      when (includeFailed || runSuccess rl) $ do-        -- Get the color we are going to use-        ~(c:_) <- E.liftCState $ S.gets (E.view E.colors)-        E.plot $ do-          lplot <- E.line-              (runVersion rl ++ " " ++ runConfiguration 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)-        case runFirstReponse rl of-          Just t -> E.plot $ pure $-              E.vlinePlot ("First build: " ++ runVersion rl) (E.defaultPlotLineStyle E.& E.line_color E..~ c) t-          _ -> pure ()----------------------------------------------------------------------------------- newtype Escaped a = Escaped {escaped :: a}  newtype Unescaped a = Unescaped {unescaped :: a}@@ -721,49 +547,6 @@  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 =