mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-10-26 09:20:16 +03:00
Add performace diff benchmarks (#4203)
* add performance diff `resultDiff.csv` showing the performance different between two version * add resultDiff CI --------- Co-authored-by: Michael Peyton Jones <me@michaelpj.com> Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com>
This commit is contained in:
parent
ced09a7456
commit
863d0cdca6
3
.github/workflows/bench.yml
vendored
3
.github/workflows/bench.yml
vendored
@ -156,6 +156,9 @@ jobs:
|
|||||||
- name: Display results
|
- name: Display results
|
||||||
run: |
|
run: |
|
||||||
column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/results.txt
|
column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/results.txt
|
||||||
|
echo
|
||||||
|
echo "Performance Diff(comparing to its previous Version):"
|
||||||
|
column -s, -t < bench-results/unprofiled/${{ matrix.example }}/resultDiff.csv | tee bench-results/unprofiled/${{ matrix.example }}/resultDiff.txt
|
||||||
|
|
||||||
- name: tar benchmarking artifacts
|
- name: tar benchmarking artifacts
|
||||||
run: find bench-results -name "*.csv" -or -name "*.svg" -or -name "*.html" | xargs tar -czf benchmark-artifacts.tar.gz
|
run: find bench-results -name "*.csv" -or -name "*.svg" -or -name "*.html" | xargs tar -czf benchmark-artifacts.tar.gz
|
||||||
|
@ -163,6 +163,7 @@ createBuildSystem config = do
|
|||||||
|
|
||||||
buildRules build hlsBuildRules
|
buildRules build hlsBuildRules
|
||||||
benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchHls warmupHls "haskell-language-server" (parallelism configStatic))
|
benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchHls warmupHls "haskell-language-server" (parallelism configStatic))
|
||||||
|
addGetParentOracle
|
||||||
csvRules build
|
csvRules build
|
||||||
svgRules build
|
svgRules build
|
||||||
heapProfileRules build
|
heapProfileRules build
|
||||||
|
@ -54,6 +54,9 @@ Targets:
|
|||||||
- bench-results/*/*/*/results.csv
|
- bench-results/*/*/*/results.csv
|
||||||
- bench-results/*/*/results.csv
|
- bench-results/*/*/results.csv
|
||||||
- bench-results/*/results.csv
|
- bench-results/*/results.csv
|
||||||
|
- bench-results/*/*/*/resultDiff.csv
|
||||||
|
- bench-results/*/*/resultDiff.csv
|
||||||
|
- bench-results/*/resultDiff.csv
|
||||||
- bench-results/*/*/*/*.svg
|
- bench-results/*/*/*/*.svg
|
||||||
- bench-results/*/*/*/*.diff.svg
|
- bench-results/*/*/*/*.diff.svg
|
||||||
- bench-results/*/*/*.svg
|
- bench-results/*/*/*.svg
|
||||||
|
@ -48,6 +48,7 @@ module Development.Benchmark.Rules
|
|||||||
(
|
(
|
||||||
buildRules, MkBuildRules(..), OutputFolder, ProjectRoot,
|
buildRules, MkBuildRules(..), OutputFolder, ProjectRoot,
|
||||||
benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..),
|
benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..),
|
||||||
|
addGetParentOracle,
|
||||||
csvRules,
|
csvRules,
|
||||||
svgRules,
|
svgRules,
|
||||||
heapProfileRules,
|
heapProfileRules,
|
||||||
@ -77,11 +78,13 @@ import Data.Aeson (FromJSON (..),
|
|||||||
import Data.Aeson.Lens (AsJSON (_JSON),
|
import Data.Aeson.Lens (AsJSON (_JSON),
|
||||||
_Object, _String)
|
_Object, _String)
|
||||||
import Data.ByteString.Lazy (ByteString)
|
import Data.ByteString.Lazy (ByteString)
|
||||||
import Data.Char (isDigit)
|
import Data.Char (isAlpha, isDigit)
|
||||||
import Data.List (find, isInfixOf,
|
import Data.List (find, intercalate,
|
||||||
|
isInfixOf,
|
||||||
|
isSuffixOf,
|
||||||
stripPrefix,
|
stripPrefix,
|
||||||
transpose)
|
transpose)
|
||||||
import Data.List.Extra (lower)
|
import Data.List.Extra (lower, splitOn)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@ -144,7 +147,9 @@ allTargetsForExample prof baseFolder ex = do
|
|||||||
configurations <- askOracle $ GetConfigurations ()
|
configurations <- askOracle $ GetConfigurations ()
|
||||||
let buildFolder = baseFolder </> profilingPath prof
|
let buildFolder = baseFolder </> profilingPath prof
|
||||||
return $
|
return $
|
||||||
[buildFolder </> getExampleName ex </> "results.csv"]
|
[
|
||||||
|
buildFolder </> getExampleName ex </> "results.csv"
|
||||||
|
, buildFolder </> getExampleName ex </> "resultDiff.csv"]
|
||||||
++ [ buildFolder </> getExampleName ex </> escaped (escapeExperiment e) <.> "svg"
|
++ [ buildFolder </> getExampleName ex </> escaped (escapeExperiment e) <.> "svg"
|
||||||
| e <- experiments
|
| e <- experiments
|
||||||
]
|
]
|
||||||
@ -187,6 +192,8 @@ phonyRules prefix executableName prof buildFolder examples = do
|
|||||||
allTargetsForExample prof buildFolder ex
|
allTargetsForExample prof buildFolder ex
|
||||||
need $ (buildFolder </> profilingPath prof </> "results.csv")
|
need $ (buildFolder </> profilingPath prof </> "results.csv")
|
||||||
: concat exampleTargets
|
: concat exampleTargets
|
||||||
|
need $ (buildFolder </> profilingPath prof </> "resultDiff.csv")
|
||||||
|
: concat exampleTargets
|
||||||
phony (prefix <> "all-binaries") $ need =<< allBinaries buildFolder executableName
|
phony (prefix <> "all-binaries") $ need =<< allBinaries buildFolder executableName
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
type OutputFolder = FilePath
|
type OutputFolder = FilePath
|
||||||
@ -384,69 +391,92 @@ parseMaxResidencyAndAllocations input =
|
|||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
-- | 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
|
-- | Rules to aggregate the CSV output of individual experiments
|
||||||
csvRules :: forall example . RuleResultForExample example => FilePattern -> Rules ()
|
csvRules :: forall example . RuleResultForExample example => FilePattern -> Rules ()
|
||||||
csvRules build = do
|
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 for every experiment*example
|
||||||
build -/- "*/*/*/*/results.csv" %> \out -> do
|
priority 1 $ build -/- "*/*/*/*/results.csv" %> \out -> do
|
||||||
experiments <- askOracle $ GetExperiments ()
|
experiments <- askOracle $ GetExperiments ()
|
||||||
|
|
||||||
let allResultFiles = [takeDirectory out </> escaped (escapeExperiment e) <.> "csv" | e <- experiments]
|
let allResultFiles = [takeDirectory out </> escaped (escapeExperiment e) <.> "csv" | e <- experiments]
|
||||||
allResults <- traverse readFileLines allResultFiles
|
allResults <- traverse readFileLines allResultFiles
|
||||||
|
|
||||||
let header = head $ head allResults
|
let header = head $ head allResults
|
||||||
results = map tail allResults
|
results = map tail allResults
|
||||||
writeFileChanged out $ unlines $ header : concat results
|
writeFileChanged out $ unlines $ header : concat results
|
||||||
|
priority 2 $ build -/- "*/*/*/*/resultDiff.csv" %> \out -> do
|
||||||
|
let out2@[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"
|
||||||
|
allResultsPrev <- readFileLines $ joinPath [b ,flav, example, prev, conf] </> "results.csv"
|
||||||
|
let resultsPrev = tail allResultsPrev
|
||||||
|
let resultsCur = tail allResultsCur
|
||||||
|
let resultDiff = zipWith convertToDiffResults resultsCur resultsPrev
|
||||||
|
writeFileChanged out $ unlines $ head allResultsCur : resultDiff
|
||||||
-- aggregate all configurations for an experiment
|
-- aggregate all configurations for an experiment
|
||||||
build -/- "*/*/*/results.csv" %> \out -> do
|
priority 3 $ build -/- "*/*/*/results.csv" %> genConfig "results.csv"
|
||||||
configurations <- map confName <$> askOracle (GetConfigurations ())
|
"Configuration" (map confName <$> askOracle (GetConfigurations ()))
|
||||||
let allResultFiles = [takeDirectory out </> c </> "results.csv" | c <- configurations ]
|
priority 3 $ build -/- "*/*/*/resultDiff.csv" %> genConfig "resultDiff.csv"
|
||||||
|
"Configuration" (map confName <$> askOracle (GetConfigurations ()))
|
||||||
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'
|
|
||||||
|
|
||||||
-- aggregate all experiments for an example
|
-- aggregate all experiments for an example
|
||||||
build -/- "*/*/results.csv" %> \out -> do
|
priority 4 $ build -/- "*/*/results.csv" %> genConfig "results.csv"
|
||||||
versions <- map (T.unpack . humanName) <$> askOracle (GetVersions ())
|
"Version" (map (T.unpack . humanName) <$> askOracle (GetVersions ()))
|
||||||
let allResultFiles = [takeDirectory out </> v </> "results.csv" | v <- versions]
|
priority 4 $ build -/- "*/*/resultDiff.csv" %> genConfig "resultDiff.csv"
|
||||||
|
"Version" (map (T.unpack . humanName) <$> askOracle (GetVersions ()))
|
||||||
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
|
-- aggregate all examples
|
||||||
build -/- "*/results.csv" %> \out -> do
|
priority 5 $ build -/- "*/results.csv" %> genConfig "results.csv"
|
||||||
examples <- map (getExampleName @example) <$> askOracle (GetExamples ())
|
"Example" (map getExampleName <$> askOracle (GetExamples ()))
|
||||||
let allResultFiles = [takeDirectory out </> e </> "results.csv" | e <- examples]
|
priority 5 $ build -/- "*/resultDiff.csv" %> genConfig "resultDiff.csv"
|
||||||
|
"Example" (map getExampleName <$> askOracle (GetExamples ()))
|
||||||
|
|
||||||
allResults <- traverse readFileLines allResultFiles
|
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
|
||||||
|
|
||||||
let header = head $ head allResults
|
showItemDiffResult :: (Item, Maybe Double) -> String
|
||||||
results = map tail allResults
|
showItemDiffResult (ItemString x, _) = x
|
||||||
header' = "example, " <> header
|
showItemDiffResult (_, Nothing) = "NA"
|
||||||
results' = zipWith (\e -> map (\l -> e <> ", " <> l)) examples results
|
showItemDiffResult (Mem x, Just y) = printf "%.2f" (y * 100 - 100) <> "%"
|
||||||
|
showItemDiffResult (Time x, Just y) = printf "%.2f" (y * 100 - 100) <> "%"
|
||||||
|
|
||||||
writeFileChanged out $ unlines $ header' : concat results'
|
diffItem :: Item -> Item -> (Item, Maybe Double)
|
||||||
|
diffItem (Mem x) (Mem y) = (Mem x, Just $ fromIntegral x / fromIntegral y)
|
||||||
|
diffItem (Time x) (Time y) = (Time x, if y == 0 then Nothing else Just $ x / y)
|
||||||
|
diffItem (ItemString x) (ItemString y) = (ItemString x, Nothing)
|
||||||
|
diffItem _ _ = (ItemString "no match", Nothing)
|
||||||
|
|
||||||
|
data Item = Mem Int | Time Double | ItemString String
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
-- | Rules to produce charts for the GC stats
|
-- | Rules to produce charts for the GC stats
|
||||||
svgRules :: FilePattern -> Rules ()
|
svgRules :: FilePattern -> Rules ()
|
||||||
svgRules build = do
|
svgRules build = do
|
||||||
void $ addOracle $ \(GetParent name) -> findPrev name <$> askOracle (GetVersions ())
|
|
||||||
-- chart GC stats for an experiment on a given revision
|
-- chart GC stats for an experiment on a given revision
|
||||||
priority 1 $
|
priority 1 $
|
||||||
build -/- "*/*/*/*/*.svg" %> \out -> do
|
build -/- "*/*/*/*/*.svg" %> \out -> do
|
||||||
|
Loading…
Reference in New Issue
Block a user