haskell/ghcide
1
1
Fork 0
mirror of https://github.com/haskell/ghcide.git synced 2024-09-11 05:36:09 +03:00
Code Issues Projects Releases Wiki Activity

Run benchmarks on a list of examples (#864)

Browse Source 
- Cabal 3.0.0.0
- haskell-lsp-types 0.22.0.0
This commit is contained in:
Pepe Iborra 2020-10-11 20:10:15 +01:00 committed by GitHub
parent f26c4abb69
commit 7339784509
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 96 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
bench/config.yaml
View File

@ -13,11 +13,17 @@ outputFolder: bench-results
# Example project used to run the experiments
# Can either be a Hackage package (name,version)
# or a local project (path) with a valid `hie.yaml` file
example:
name: Cabal
examples:
# Medium-sized project without TH
- name: Cabal
version: 3.0.0.0
# path: path/to/example
module: Distribution/Simple.hs
# Small-sized project with TH
- name: haskell-lsp-types
version: 0.22.0.0
module: src/Language/Haskell/LSP/Types/Lens.hs
# - path: path-to-example
# module: path-to-module
# The set of experiments to execute
experiments:

125
bench/hist/Main.hs
View File

@ -10,17 +10,20 @@
system with the following structure:
bench-results
├── <git-reference> - one folder per version
│   ├── <experiment>.benchmark-gcStats - 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>.log - ghcide-bench output
│   ├── ghc.path - path to ghc used to build the binary
│   ├── ghcide - binary for this version
│   └── results.csv - results of all the experiments for the version
├── <git-reference>
│  ├── ghc.path - path to ghc used to build the binary
│  ├── ghcide - binary for this version
├─ <example>
│ ├── results.csv - aggregated results for all the versions
│ └── <git-reference>
│   ├── <experiment>.benchmark-gcStats - 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>.log - ghcide-bench output
│   └── 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
└── <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`.
@ -35,6 +38,7 @@
> cabal bench --benchmark-options "bench-results/HEAD/results.csv bench-results/HEAD/edit.diff.svg"
-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies#-}
{-# LANGUAGE TypeFamilies #-}
@ -49,7 +53,7 @@ import qualified Data.Text as T
import Data.Yaml ((.!=), (.:?), FromJSON (..), ToJSON (..), Value (..), decodeFileThrow)
import Development.Shake
import Development.Shake.Classes (Binary, Hashable, NFData)
import Experiments.Types (exampleToOptions, Example(..))
import Experiments.Types (getExampleName, exampleToOptions, Example(..))
import GHC.Exts (IsList (..))
import GHC.Generics (Generic)
import qualified Graphics.Rendering.Chart.Backend.Diagrams as E
@ -60,6 +64,7 @@ import System.Directory
import System.FilePath
import qualified Text.ParserCombinators.ReadP as P
import Text.Read (Read (..), get, readMaybe, readP_to_Prec)
import GHC.Stack (HasCallStack)
config :: FilePath
config = "bench/config.yaml"
@ -68,24 +73,20 @@ config = "bench/config.yaml"
readConfigIO :: FilePath -> IO Config
readConfigIO = decodeFileThrow
newtype GetExample = GetExample String deriving newtype (Binary, Eq, Hashable, NFData, Show)
newtype GetExamples = GetExamples () deriving newtype (Binary, Eq, Hashable, NFData, Show)
newtype GetSamples = GetSamples () deriving newtype (Binary, Eq, Hashable, NFData, Show)
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)
type instance RuleResult GetExample = Maybe Example
type instance RuleResult GetExamples = [Example]
type instance RuleResult GetSamples = Natural
type instance RuleResult GetExperiments = [Unescaped String]
type instance RuleResult GetVersions = [GitCommit]
type instance RuleResult GetParent = Text
type instance RuleResult GetCommitId = String
main :: IO ()
@ -97,12 +98,16 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
_ <- addOracle $ \GetSamples {} -> samples <$> readConfig config
_ <- addOracle $ \GetExperiments {} -> experiments <$> readConfig config
_ <- addOracle $ \GetVersions {} -> versions <$> readConfig config
_ <- addOracle $ \GetExamples{} -> examples <$> readConfig config
_ <- addOracle $ \(GetParent name) -> findPrev name . versions <$> readConfig config
_ <- addOracle $ \(GetExample name) -> find (\e -> getExampleName e == name) . examples <$> readConfig config
let readVersions = askOracle $ GetVersions ()
readExperiments = askOracle $ GetExperiments ()
readExamples = askOracle $ GetExamples ()
readSamples = askOracle $ GetSamples ()
getParent = askOracle . GetParent
getExample = askOracle . GetExample
configStatic <- liftIO $ readConfigIO config
ghcideBenchPath <- ghcideBench <$> liftIO (readConfigIO config)
@ -112,16 +117,16 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
phony "all" $ do
Config {..} <- readConfig config
forM_ versions $ \ver ->
need [build </> T.unpack (humanName ver) </> "results.csv"]
need $
[build </> getExampleName e </> "results.csv" | e <- examples ] ++
[build </> "results.csv"]
++ [ build </> escaped (escapeExperiment e) <.> "svg"
++ [ build </> getExampleName ex </> escaped (escapeExperiment e) <.> "svg"
| e <- experiments
, ex <- examples
]
++ [ build </> T.unpack (humanName ver) </> escaped (escapeExperiment e) <.> mode <.> "svg"
++ [ build </> getExampleName ex </> T.unpack (humanName ver) </> escaped (escapeExperiment e) <.> mode <.> "svg"
| e <- experiments,
ex <- examples,
ver <- versions,
mode <- ["", "diff"]
]
@ -136,7 +141,7 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
Stdout commitid <- command [] "git" ["rev-list", "-n", "1", gitThing]
writeFileChanged out $ init commitid
priority 10 $ [build -/- "HEAD/ghcide"
priority 10 $ [ build -/- "HEAD/ghcide"
, build -/- "HEAD/ghc.path"
]
&%> \[out, ghcpath] -> do
@ -159,8 +164,7 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
cmd_ [Cwd "bench-temp"] $ buildGhcide buildSystem (".." </> takeDirectory out)
writeFile' ghcpath ghcLoc
priority 8000 $
build -/- "*/results.csv" %> \out -> do
build -/- "*/*/results.csv" %> \out -> do
experiments <- readExperiments
let allResultFiles = [takeDirectory out </> escaped (escapeExperiment e) <.> "csv" | e <- experiments]
@ -173,16 +177,17 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
ghcideBenchResource <- newResource "ghcide-bench" 1
priority 0 $
[ build -/- "*/*.csv",
build -/- "*/*.benchmark-gcStats",
build -/- "*/*.log"
[ build -/- "*/*/*.csv",
build -/- "*/*/*.benchmark-gcStats",
build -/- "*/*/*.log"
]
&%> \[outcsv, _outGc, outLog] -> do
let [_, _, exp] = splitDirectories outcsv
let [_, exampleName, ver, exp] = splitDirectories outcsv
example <- fromMaybe (error $ "Unknown example " <> exampleName) <$> getExample exampleName
samples <- readSamples
liftIO $ createDirectoryIfMissing True $ dropFileName outcsv
let ghcide = dropFileName outcsv </> "ghcide"
ghcpath = dropFileName outcsv </> "ghc.path"
let ghcide = build </> ver </> "ghcide"
ghcpath = build </> ver </> "ghc.path"
need [ghcide, ghcpath]
ghcPath <- readFile' ghcpath
withResource ghcideBenchResource 1 $ do
@ -203,53 +208,66 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
"--select",
unescaped (unescapeExperiment (Escaped $ dropExtension exp))
] ++
exampleToOptions (example configStatic) ++
exampleToOptions example ++
[ "--stack" | Stack == buildSystem]
cmd_ Shell $ "mv *.benchmark-gcStats " <> dropFileName outcsv
build -/- "results.csv" %> \out -> do
versions <- readVersions
let allResultFiles =
[build </> T.unpack (humanName v) </> "results.csv" | v <- versions]
examples <- map getExampleName <$> readExamples
let allResultFiles = [build </> e </> "results.csv" | e <- examples]
need [build </> T.unpack (humanName v) </> "ghcide" | v <- versions]
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'
build -/- "*/results.csv" %> \out -> do
versions <- map (T.unpack . humanName) <$> readVersions
let example = takeFileName $ takeDirectory out
allResultFiles =
[build </> example </> 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 -> T.unpack (humanName v) <> ", " <> l)) versions results
results' = zipWith (\v -> map (\l -> v <> ", " <> l)) versions results
writeFileChanged out $ unlines $ header' : concat results'
priority 2 $
build -/- "*/*.diff.svg" %> \out -> do
let [b, ver, exp_] = splitDirectories out
build -/- "*/*/*.diff.svg" %> \out -> do
let [b, example, ver, exp_] = splitDirectories out
exp = Escaped $ dropExtension $ dropExtension exp_
prev <- getParent $ T.pack ver
runLog <- loadRunLog b exp ver
runLogPrev <- loadRunLog b exp $ T.unpack prev
runLog <- loadRunLog b example exp ver
runLogPrev <- loadRunLog b example exp $ T.unpack prev
let diagram = Diagram Live [runLog, runLogPrev] title
title = show (unescapeExperiment exp) <> " - live bytes over time compared"
plotDiagram True diagram out
priority 1 $
build -/- "*/*.svg" %> \out -> do
let [b, ver, exp] = splitDirectories out
runLog <- loadRunLog b (Escaped $ dropExtension exp) ver
build -/- "*/*/*.svg" %> \out -> do
let [b, example, ver, exp] = splitDirectories out
runLog <- loadRunLog b example (Escaped $ dropExtension exp) ver
let diagram = Diagram Live [runLog] title
title = ver <> " live bytes over time"
plotDiagram True diagram out
build -/- "*.svg" %> \out -> do
build -/- "*/*.svg" %> \out -> do
let exp = Escaped $ dropExtension $ takeFileName out
example = takeFileName $ takeDirectory out
versions <- readVersions
runLogs <- forM (filter include versions) $ \v -> do
loadRunLog build exp $ T.unpack $ humanName v
loadRunLog build example exp $ T.unpack $ humanName v
let diagram = Diagram Live runLogs title
title = show (unescapeExperiment exp) <> " - live bytes over time"
@ -282,7 +300,7 @@ findGhc Stack = do
data Config = Config
{ experiments :: [Unescaped String],
example :: Example,
examples :: [Example],
samples :: Natural,
versions :: [GitCommit],
-- | Path to the ghcide-bench binary for the experiments
@ -401,14 +419,15 @@ data Diagram = Diagram
-- | A file path containing the output of -S for a given run
data RunLog = RunLog
{ runVersion :: !String,
_runExample :: !String,
_runExperiment :: !String,
runFrames :: ![Frame],
runSuccess :: !Bool
}
loadRunLog :: FilePath -> Escaped FilePath -> FilePath -> Action RunLog
loadRunLog buildF exp ver = do
let log_fp = buildF </> ver </> escaped exp <.> "benchmark-gcStats"
loadRunLog :: HasCallStack => FilePath -> String -> Escaped FilePath -> FilePath -> Action RunLog
loadRunLog buildF example exp ver = do
let log_fp = buildF </> example </> ver </> escaped exp <.> "benchmark-gcStats"
csv_fp = replaceExtension log_fp "csv"
log <- readFileLines log_fp
csv <- readFileLines csv_fp
@ -422,7 +441,7 @@ loadRunLog buildF exp ver = do
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 (dropExtension $ escaped exp) frames success
return $ RunLog ver example (dropExtension $ escaped exp) frames success
plotDiagram :: Bool -> Diagram -> FilePath -> Action ()
plotDiagram includeFailed t@Diagram {traceMetric, runLogs} out = do

15
bench/lib/Experiments/Types.hs
View File

@ -5,6 +5,9 @@ module Experiments.Types where
import Data.Aeson
import Data.Version
import Numeric.Natural
import System.FilePath (isPathSeparator)
import Development.Shake.Classes
import GHC.Generics
data CabalStack = Cabal | Stack
deriving (Eq, Show)
@ -29,7 +32,17 @@ data Config = Config
data Example
= GetPackage {exampleName, exampleModule :: String, exampleVersion :: Version}
| UsePackage {examplePath :: FilePath, exampleModule :: String}
deriving (Eq, Show)
deriving (Eq, Generic, Show)
deriving anyclass (Binary, Hashable, NFData)
getExampleName :: Example -> String
getExampleName UsePackage{examplePath} = map replaceSeparator examplePath
where
replaceSeparator x
| isPathSeparator x = '_'
| otherwise = x
getExampleName GetPackage{exampleName, exampleVersion} =
exampleName <> "-" <> showVersion exampleVersion
instance FromJSON Example where
parseJSON = withObject "example" $ \x -> do

1
ghcide.cabal
View File

@ -399,6 +399,7 @@ executable ghcide-bench
optparse-applicative,
process,
safe-exceptions,
shake,
text
hs-source-dirs: bench/lib bench/exe
include-dirs: include