From 9631dbedc14705a0efa9a064bc7c71a821f65ee8 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 28 Jul 2026 21:32:07 +0200 Subject: [PATCH 1/6] wip fixing layout and master commits --- app/BenchmarkDisplay.hs | 95 +++++++++++------- src/Perf/DB/Materialize.hs | 34 +++++++ src/Perf/Web/Chart.hs | 41 ++++---- src/Perf/Web/Plot.hs | 199 +++++++++++++++++++++++++++++++++---- src/Perf/Web/Routes.hs | 46 +++++---- 5 files changed, 323 insertions(+), 92 deletions(-) diff --git a/app/BenchmarkDisplay.hs b/app/BenchmarkDisplay.hs index 3cf3e2b..0d0f07c 100644 --- a/app/BenchmarkDisplay.hs +++ b/app/BenchmarkDisplay.hs @@ -2,13 +2,13 @@ import Data.Aeson (eitherDecodeFileStrict') import Data.Char (isHexDigit) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NonEmpty -import Data.Maybe (catMaybes) import Data.Text (Text) +import Data.Text.IO qualified as TIO import Data.Text qualified as T import Data.Text.Lazy.IO qualified as LTIO -import Database.Persist +import Database.Persist (SelectOpt (Asc), entityVal, selectList) import Database.Persist.Sqlite (runMigration, runSqlite) -import Lucid (renderText) +import Lucid (Html, renderText) import Options.Applicative import Perf.DB.Materialize import Perf.Types.DB qualified as DB @@ -26,41 +26,58 @@ data Cli = Cli sqlitePath :: Maybe FilePath, branchName :: Text, maxCommits :: Int, + listBranches :: Bool, jsonFiles :: [FilePath] } data Source = JsonFiles (NonEmpty FilePath) | Sqlite FilePath Text Int + | ListBranches FilePath main :: IO () main = do cli <- execParser parserInfo source <- validateSource cli - html <- case source of + case source of + ListBranches sqlite -> listBranchesFromSqlite sqlite JsonFiles files -> do snapshots <- mapM loadSnapshot $ NonEmpty.toList files - pure $ - staticLayout_ "Benchmarks" $ - generateExternalPlots $ - materializeExternalSnapshots $ - NonEmpty.fromList snapshots + let html = + staticLayout_ "Benchmarks" $ + generateExternalPlots $ + materializeExternalSnapshots $ + NonEmpty.fromList snapshots + writeAndOpen cli.outputPath html Sqlite sqlite branch limit -> do - benchmarks <- loadBenchmarksFromSqlite sqlite branch limit - pure $ - staticLayout_ ("Benchmarks: " <> branch) $ - generateCommitPlots benchmarks - absoluteOutput <- makeAbsolute cli.outputPath + htmlBody <- loadBenchmarksHtmlFromSqlite sqlite branch limit + writeAndOpen cli.outputPath $ + staticLayout_ ("Benchmarks: " <> branch) htmlBody + +writeAndOpen :: FilePath -> Html () -> IO () +writeAndOpen outputPath html = do + absoluteOutput <- makeAbsolute outputPath LTIO.writeFile absoluteOutput (renderText html) openFile absoluteOutput validateSource :: Cli -> IO Source validateSource cli = - case (cli.sqlitePath, NonEmpty.nonEmpty cli.jsonFiles) of - (Just sqlite, Nothing) -> pure $ Sqlite sqlite cli.branchName cli.maxCommits - (Nothing, Just files) -> pure $ JsonFiles files - (Just _, Just _) -> die "Use either JSON files or --sqlite, not both." - (Nothing, Nothing) -> die "Provide one or more JSON files, or use --sqlite." + case (cli.listBranches, cli.sqlitePath, NonEmpty.nonEmpty cli.jsonFiles) of + (True, Just sqlite, Nothing) -> pure $ ListBranches sqlite + (True, Nothing, _) -> die "--list-branches requires --sqlite PATH." + (True, Just _, Just _) -> die "Use --list-branches with --sqlite only, not with JSON files." + (False, Just sqlite, Nothing) -> pure $ Sqlite sqlite cli.branchName cli.maxCommits + (False, Nothing, Just files) -> pure $ JsonFiles files + (False, Just _, Just _) -> die "Use either JSON files or --sqlite, not both." + (False, Nothing, Nothing) -> die "Provide one or more JSON files, or use --sqlite." + +listBranchesFromSqlite :: FilePath -> IO () +listBranchesFromSqlite sqlite = do + names <- runSqlite (T.pack sqlite) do + runMigration DB.migrateAll + branches <- selectList @DB.Branch [] [Asc DB.BranchName] + pure $ map ((.branchName) . entityVal) branches + mapM_ TIO.putStrLn names loadSnapshot :: FilePath -> IO (Text, [EX.Benchmark]) loadSnapshot path = do @@ -78,22 +95,28 @@ labelFromPath path = then T.pack suffix else T.pack base -loadBenchmarksFromSqlite :: FilePath -> Text -> Int -> IO (BenchmarkSeries DB.Commit DB.Metric) -loadBenchmarksFromSqlite sqlite branch limit = +loadBenchmarksHtmlFromSqlite :: FilePath -> Text -> Int -> IO (Html ()) +loadBenchmarksHtmlFromSqlite sqlite branch limit = runSqlite (T.pack sqlite) do runMigration DB.migrateAll - mbranch <- selectFirst [DB.BranchName ==. branch] [] - case mbranch of + branchCommitEntities <- loadBranchCommits branch limit + case NonEmpty.nonEmpty branchCommitEntities of Nothing -> pure mempty - Just (Entity branchId _) -> do - mappings <- - selectList - [DB.MapBranchCommitBranchId ==. branchId] - [Desc DB.MapBranchCommitId, LimitTo limit] - commits <- mapM (\mapping -> selectFirst [DB.CommitId ==. mapping.entityVal.mapBranchCommitCommitId] []) mappings - case NonEmpty.nonEmpty $ reverse $ catMaybes commits of - Nothing -> pure mempty - Just existingCommits -> materializeCommits existingCommits + Just branchCommitsNE -> do + let isMaster = branch == "master" + branchCommits = map entityVal branchCommitEntities + branchBenchmarks <- materializeCommits branchCommitsNE + if isMaster + then pure $ generateCommitPlotsWith MasterComparisonDisabled branchCommits branchBenchmarks + else do + masterCommitEntities <- loadBranchCommits "master" 10 + let masterCtx = MasterComparisonEnabled (map entityVal masterCommitEntities) + benchmarks <- case NonEmpty.nonEmpty masterCommitEntities of + Nothing -> pure branchBenchmarks + Just masterCommitsNE -> do + masterBenchmarks <- materializeCommits masterCommitsNE + pure $ mergeMasterIntoBranch masterBenchmarks branchBenchmarks + pure $ generateCommitPlotsWith masterCtx branchCommits benchmarks openFile :: FilePath -> IO () openFile path = @@ -102,8 +125,8 @@ openFile path = "linux" -> runOpen "xdg-open" _ -> putStrLn $ "Wrote " <> path where - runOpen command = do - status <- rawSystem command [path] + runOpen openCommand = do + status <- rawSystem openCommand [path] case status of ExitSuccess -> pure () _ -> putStrLn $ "Wrote " <> path @@ -148,6 +171,10 @@ cliParser = <> showDefault <> help "Number of most recent commits in sqlite mode." ) + <*> switch + ( long "list-branches" + <> help "With --sqlite, print available branch names and exit." + ) <*> many (strArgument ( metavar "JSON_FILES..." diff --git a/src/Perf/DB/Materialize.hs b/src/Perf/DB/Materialize.hs index d205316..271364e 100644 --- a/src/Perf/DB/Materialize.hs +++ b/src/Perf/DB/Materialize.hs @@ -1,5 +1,6 @@ module Perf.DB.Materialize where +import Data.Maybe (catMaybes) import qualified Data.List as List import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty @@ -25,6 +26,39 @@ data DisplayMetric = DisplayMetric } deriving (Eq, Show) +-- | Most recent commits on a branch, returned in historical order (oldest first). +loadBranchCommits :: Text -> Int -> DB.DB [Entity DB.Commit] +loadBranchCommits branchName limit = do + mbranch <- selectFirst [DB.BranchName ==. branchName] [] + case mbranch of + Nothing -> pure [] + Just (Entity branchId _) -> do + mappings <- + selectList + [DB.MapBranchCommitBranchId ==. branchId] + [Desc DB.MapBranchCommitId, LimitTo limit] + commits <- + mapM + (\mapping -> selectFirst [DB.CommitId ==. mapping.entityVal.mapBranchCommitCommitId] []) + mappings + pure $ reverse $ catMaybes commits + +-- | Merge master metrics into branch subjects only (drop master-only subjects). +mergeMasterIntoBranch :: + Ord key => + BenchmarkSeries key metric -> + BenchmarkSeries key metric -> + BenchmarkSeries key metric +mergeMasterIntoBranch masterBenchmarks branchBenchmarks = + Map.mapWithKey + ( \subject branchTests -> + case Map.lookup subject masterBenchmarks of + Nothing -> branchTests + Just masterTests -> + Map.unionWith (Map.unionWith Map.union) masterTests branchTests + ) + branchBenchmarks + -- Materialize a set of commits into a data set we can work with. materializeCommits :: NonEmpty (Entity DB.Commit) -> diff --git a/src/Perf/Web/Chart.hs b/src/Perf/Web/Chart.hs index 9187562..2d411ea 100644 --- a/src/Perf/Web/Chart.hs +++ b/src/Perf/Web/Chart.hs @@ -6,26 +6,29 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Lucid +import Lucid.Base (makeAttributes) -chart_ :: Text -> Value -> Value -> Html () -chart_ idx plotData layout = do - div_ [id_ idx, style_ "height: 300px; max-width: 400px;"] do - pure () - script_ $ - T.concat - [ "(() => {", - "const data = ", - encode' plotData, - ";", - "const layout = ", - encode' layout, - ";", - "const config = {responsive: true, modeBarButtonsToRemove: ['select2d', 'lasso2d']};", - "Plotly.newPlot(", - encode' idx, - ", data, layout, config);", - "})();" - ] +data ChartOptions = ChartOptions + { chartId :: Text, + plotData :: Value, + layout :: Value, + masterCount :: Int, + heightPx :: Int + } + +-- | Emit a plot container. Plotting is performed by the shared controls script +-- in 'Perf.Web.Plot', which reads the data-* attributes. +chart_ :: ChartOptions -> Html () +chart_ opts = do + div_ + [ id_ opts.chartId, + class_ "benchmark-plot", + style_ $ "height: " <> T.pack (show opts.heightPx) <> "px; max-width: 400px; width: 100%;", + makeAttributes "data-full" (encode' opts.plotData), + makeAttributes "data-layout" (encode' opts.layout), + makeAttributes "data-master-count" (T.pack (show opts.masterCount)) + ] + (pure ()) encode' :: ToJSON a => a -> Text encode' = T.decodeUtf8 . L.toStrict . encode diff --git a/src/Perf/Web/Plot.hs b/src/Perf/Web/Plot.hs index 798e413..0ac7af2 100644 --- a/src/Perf/Web/Plot.hs +++ b/src/Perf/Web/Plot.hs @@ -10,50 +10,194 @@ import Data.Text (Text) import Data.Text qualified as T import Control.Monad import Lucid +import Lucid.Base (makeAttributes) import Perf.DB.Materialize import Perf.Types.DB qualified as DB import Perf.Types.Prim qualified as Prim import Perf.Web.Chart +-- | Whether the "show master branch commits" control is available. +data MasterPlotContext key + = MasterComparisonDisabled + | MasterComparisonEnabled [key] + -- ^ Master keys in historical order (oldest first), at most 10. + generateCommitPlots :: BenchmarkSeries DB.Commit DB.Metric -> Html () -generateCommitPlots = +generateCommitPlots benchmarks = + generateCommitPlotsWith + MasterComparisonDisabled + (collectKeys benchmarks) + benchmarks + +generateCommitPlotsWith :: + MasterPlotContext DB.Commit -> + [DB.Commit] -> + BenchmarkSeries DB.Commit DB.Metric -> + Html () +generateCommitPlotsWith masterCtx branchCommits = generatePlotsWith + masterCtx + branchCommits (T.take 8 . (coerce :: Prim.Hash -> Text) . (.commitHash)) (.metricMean) generateExternalPlots :: BenchmarkSeries Text DisplayMetric -> Html () -generateExternalPlots = - generatePlotsWith id (.mean) +generateExternalPlots benchmarks = + generatePlotsWith + MasterComparisonDisabled + (collectKeys benchmarks) + id + (.mean) + benchmarks generatePlotsWith :: Ord key => + MasterPlotContext key -> + [key] -> (key -> Text) -> (metric -> Double) -> BenchmarkSeries key metric -> Html () -generatePlotsWith renderKey metricMean benchmarks = do - unless (Map.null benchmarks) $ h1_ "Plots" +generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do + let masterKeys = case masterCtx of + MasterComparisonDisabled -> [] + MasterComparisonEnabled cs -> cs + masterCount = length masterKeys + orderedKeys = masterKeys <> branchKeys + masterEnabled = case masterCtx of + MasterComparisonDisabled -> False + MasterComparisonEnabled {} -> True + unless (Map.null benchmarks) $ plotControls_ masterEnabled Foldable.for_ (zip [0 :: Int ..] (Map.toList benchmarks)) \(benchmarkIdx, (subject, tests)) -> do - h2_ $ toHtml subject - let keys = - Set.fromList $ concatMap (concatMap Map.keys . Map.elems) $ Map.elems tests - let orderedKeys = Set.toList keys - let labels = map renderKey orderedKeys let metrics :: Set Prim.MetricLabel = Set.fromList $ concatMap Map.keys $ Map.elems tests - div_ [style_ "display: flex; flex-wrap: wrap;"] do - Foldable.for_ (zip [0 :: Int ..] (Set.toList metrics)) \(metricIdx, metricLabel) -> do - let dataSets = - flip map (Map.toList tests) \(factors, allMetrics) -> - (factors, toSeries orderedKeys (Map.findWithDefault Map.empty metricLabel allMetrics)) - let (plotData, layout) = makePlotlyConfig metricLabel labels dataSets - chart_ (T.pack (show benchmarkIdx) <> "-" <> T.pack (show metricIdx)) plotData layout + searchText = + T.toLower $ + T.unwords $ + coerce subject : map coerce (Set.toList metrics) + div_ + [ class_ "benchmark-subject", + makeAttributes "data-plot-title" (coerce subject), + makeAttributes "data-search-text" searchText + ] + do + h2_ $ toHtml subject + div_ [style_ "display: flex; flex-wrap: wrap;"] do + Foldable.for_ (zip [0 :: Int ..] (Set.toList metrics)) \(metricIdx, metricLabel) -> do + let dataSets = + flip map (Map.toList tests) \(factors, allMetrics) -> + (factors, toSeries orderedKeys (Map.findWithDefault Map.empty metricLabel allMetrics)) + labels = map renderKey orderedKeys + (plotData, layout) = makePlotlyConfig metricLabel labels dataSets + chartId = T.pack (show benchmarkIdx) <> "-" <> T.pack (show metricIdx) + legendLines = length dataSets + chartHeight = 280 + min 320 (40 + legendLines * 16) + chart_ + ChartOptions + { chartId, + plotData, + layout, + masterCount, + heightPx = chartHeight + } + -- Script must run after plot containers are in the DOM. + unless (Map.null benchmarks) $ script_ plotControlsScript where - toSeries orderedKeys metricMap = - flip map orderedKeys \key -> + toSeries keys metricMap = + flip map keys \key -> maybe Null (toJSON . metricMean) $ Map.lookup key metricMap +collectKeys :: Ord key => BenchmarkSeries key metric -> [key] +collectKeys benchmarks = + Set.toList $ + Set.fromList $ + concatMap (concatMap Map.keys . Map.elems) $ + concatMap Map.elems $ + Map.elems benchmarks + +plotControls_ :: Bool -> Html () +plotControls_ masterEnabled = do + div_ + [ class_ "plot-controls", + style_ "display: flex; flex-wrap: wrap; gap: 1rem; align-items: center; margin: 1rem 0;" + ] + do + input_ + [ type_ "search", + id_ "plot-search", + placeholder_ "Search in plot title", + style_ "flex: 1; min-width: 16rem; padding: 0.35rem 0.5rem; font-family: monospace;" + ] + label_ + [ for_ "master-commits", + style_ "display: flex; align-items: center; gap: 0.4rem; white-space: nowrap;" + ] + do + "show master branch commits:" + select_ + ( [ id_ "master-commits", + style_ "font-family: monospace; padding: 0.25rem;" + ] + <> [makeAttributes "disabled" "disabled" | not masterEnabled] + ) + do + forM_ ([0, 1, 2, 3, 5, 10] :: [Int]) \n -> + option_ + ( [value_ (T.pack (show n))] + <> [makeAttributes "selected" "selected" | n == 0] + ) + (toHtml (show n)) + +plotControlsScript :: Text +plotControlsScript = + T.unlines + [ "(function () {", + " const search = document.getElementById('plot-search');", + " const masterSelect = document.getElementById('master-commits');", + " const config = {responsive: true, modeBarButtonsToRemove: ['select2d', 'lasso2d']};", + " function applySearch() {", + " if (!search) return;", + " const q = (search.value || '').trim().toLowerCase();", + " document.querySelectorAll('.benchmark-subject').forEach((el) => {", + " const hay = el.getAttribute('data-search-text') || '';", + " el.style.display = (!q || hay.includes(q)) ? '' : 'none';", + " });", + " }", + " function masterShow() {", + " if (!masterSelect || masterSelect.disabled) return 0;", + " const n = parseInt(masterSelect.value, 10);", + " return Number.isFinite(n) ? n : 0;", + " }", + " function slicePlotData(fullData, masterCount, showMaster) {", + " const start = Math.max(0, masterCount - showMaster);", + " return fullData.map((trace) => Object.assign({}, trace, {", + " x: (trace.x || []).slice(start),", + " y: (trace.y || []).slice(start)", + " }));", + " }", + " function redrawPlots() {", + " const show = masterShow();", + " document.querySelectorAll('.benchmark-plot').forEach((el) => {", + " const fullData = JSON.parse(el.getAttribute('data-full') || '[]');", + " const layout = JSON.parse(el.getAttribute('data-layout') || '{}');", + " const masterCount = parseInt(el.getAttribute('data-master-count') || '0', 10) || 0;", + " const data = slicePlotData(fullData, masterCount, show);", + " if (el.getAttribute('data-plotted') === '1') {", + " Plotly.react(el, data, layout, config);", + " } else {", + " Plotly.newPlot(el, data, layout, config);", + " el.setAttribute('data-plotted', '1');", + " }", + " });", + " }", + " if (search) search.addEventListener('input', applySearch);", + " if (masterSelect) masterSelect.addEventListener('change', redrawPlots);", + " applySearch();", + " redrawPlots();", + "})();" + ] + makePlotlyConfig :: Prim.MetricLabel -> [Text] -> @@ -73,6 +217,8 @@ makePlotlyConfig metricName labels dataSets = ] | ((factors, series), color) <- zip dataSets $ cycle colors ] + legendLines = length dataSets + bottomMargin = min 320 (40 + legendLines * 16) layout = object [ "title" @@ -94,8 +240,19 @@ makePlotlyConfig metricName labels dataSets = "font" .= object ["family" .= ("monospace" :: Text)], "hovermode" .= ("x unified" :: Text), "showlegend" .= True, - "legend" .= object ["x" .= (1 :: Int), "y" .= (0 :: Int), "xanchor" .= ("right" :: Text), "bgcolor" .= ("rgba(0,0,0,0)" :: Text), "font" .= object ["color" .= ("rgba(0,0,0,0.4)" :: Text)]], - "margin" .= object ["t" .= (40 :: Int), "b" .= (40 :: Int), "l" .= (60 :: Int), "r" .= (20 :: Int)] + "legend" + .= object + [ "orientation" .= ("v" :: Text), + "x" .= (0 :: Double), + "y" .= (0 :: Double), + "xanchor" .= ("left" :: Text), + "yanchor" .= ("bottom" :: Text), + "yref" .= ("container" :: Text), + "xref" .= ("paper" :: Text), + "bgcolor" .= ("rgba(0,0,0,0)" :: Text), + "font" .= object ["color" .= ("rgba(0,0,0,0.55)" :: Text), "size" .= (11 :: Int)] + ], + "margin" .= object ["t" .= (40 :: Int), "b" .= bottomMargin, "l" .= (60 :: Int), "r" .= (20 :: Int)] ] colors :: [Text] = T.words "#4394E5 #87BB62 #876FD4 #F5921B" diff --git a/src/Perf/Web/Routes.hs b/src/Perf/Web/Routes.hs index f4fe809..2d984a6 100644 --- a/src/Perf/Web/Routes.hs +++ b/src/Perf/Web/Routes.hs @@ -19,7 +19,7 @@ import Perf.DB.Materialize import Perf.Types.DB qualified as DB import Perf.Types.External qualified as EX import Perf.Types.Prim qualified as Prim -import Perf.Types.Web +import Perf.Types.Web import Perf.Web.Db import Perf.Web.Foundation import Perf.Web.Layout @@ -54,24 +54,39 @@ getBranchR name = do mbranch <- db $ selectFirst [DB.BranchName ==. name] [] case mbranch of Nothing -> notFound - Just (Entity branchId branch) -> do + Just (Entity _branchId branch) -> do mmaxGraph <- fmap (>>= (RIO.readMaybe @Int . T.unpack)) $ lookupGetParam "limit" let maxGraph :: Int = fromMaybe 28 $ mmaxGraph - mappings <- - db $ - selectList - [DB.MapBranchCommitBranchId ==. branchId] - [Desc DB.MapBranchCommitId, LimitTo maxGraph] - commits <- fmap catMaybes $ RIO.for mappings \mapping -> - db $ selectFirst [DB.CommitId ==. mapping.entityVal.mapBranchCommitCommitId] [] - mbenchmarks <- db $ for (NonEmpty.nonEmpty $ reverse commits) materializeCommits + isMaster = name == "master" + branchCommitEntities <- db $ loadBranchCommits name maxGraph + -- Newest-first for the commits table (historical order is reversed). + let commitsNewestFirst = reverse branchCommitEntities + masterCommitEntities <- + if isMaster + then pure [] + else db $ loadBranchCommits "master" 10 + let masterCtx = + if isMaster + then MasterComparisonDisabled + else MasterComparisonEnabled (map entityVal masterCommitEntities) + branchCommits = map entityVal branchCommitEntities + mbenchmarks <- db do + branchBenchmarks <- for (NonEmpty.nonEmpty branchCommitEntities) materializeCommits + masterBenchmarks <- for (NonEmpty.nonEmpty masterCommitEntities) materializeCommits + pure $ + case (branchBenchmarks, masterBenchmarks) of + (Nothing, _) -> Nothing + (Just branchName, Nothing) -> Just branchName + (Just branchName, Just master) -> Just (mergeMasterIntoBranch master branchName) lucid do defaultLayout_ branch.branchName do - for_ mbenchmarks $ generalizeHtmlT . generatePlots + for_ mbenchmarks \benchmarks -> + generalizeHtmlT $ + generateCommitPlotsWith masterCtx branchCommits benchmarks h1_ "Commits" table_ do - let prevCommits = map Just (drop 1 commits) <> repeat Nothing - for_ (zip commits prevCommits) \(Entity _ commit, mprev) -> do + let prevCommits = map Just (drop 1 commitsNewestFirst) <> repeat Nothing + for_ (zip commitsNewestFirst prevCommits) \(Entity _ commit, mprev) -> do let mprevious = fmap (.entityVal) mprev url <- asks (.url) tr_ do @@ -97,11 +112,6 @@ getBranchR name = do toHtml $ show maxGraph " commits)" -generatePlots :: - BenchmarkSeries DB.Commit DB.Metric -> - Html () -generatePlots = generateCommitPlots - getCommitR :: Prim.Hash -> Handler (Html ()) getCommitR hash = do mcommit <- db $ selectFirst [DB.CommitHash ==. hash] [] From 1b63eb6202c4d13a599c15f1cb484c69feea4935 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 28 Jul 2026 21:37:43 +0200 Subject: [PATCH 2/6] show: include master branch comparison, filter benchmarks by title --- readme.md | 1 + src/Perf/Web/Chart.hs | 2 +- src/Perf/Web/Layout.hs | 12 ++++++-- src/Perf/Web/Plot.hs | 67 +++++++++++++++++++++--------------------- 4 files changed, 46 insertions(+), 36 deletions(-) diff --git a/readme.md b/readme.md index 9090026..17fd740 100644 --- a/readme.md +++ b/readme.md @@ -93,6 +93,7 @@ cabal run benchmark-display -- --output benchmark.html run-1.json run-2.json Notes: +- To get the sqlite DB file, use a command like this: `scp brossa.io:/root/perfly/perf.sqlite3 .` (you will need permissions to access `brossa.io` via ssh). - The generated file defaults to `benchmark-display.html`. - After writing, the tool runs `open benchmark-display.html` on macOS (or `xdg-open` on Linux). diff --git a/src/Perf/Web/Chart.hs b/src/Perf/Web/Chart.hs index 2d411ea..55d432f 100644 --- a/src/Perf/Web/Chart.hs +++ b/src/Perf/Web/Chart.hs @@ -23,7 +23,7 @@ chart_ opts = do div_ [ id_ opts.chartId, class_ "benchmark-plot", - style_ $ "height: " <> T.pack (show opts.heightPx) <> "px; max-width: 400px; width: 100%;", + style_ $ "height: " <> T.pack (show opts.heightPx) <> "px;", makeAttributes "data-full" (encode' opts.plotData), makeAttributes "data-layout" (encode' opts.layout), makeAttributes "data-master-count" (T.pack (show opts.masterCount)) diff --git a/src/Perf/Web/Layout.hs b/src/Perf/Web/Layout.hs index 50ac3d9..5cd776a 100644 --- a/src/Perf/Web/Layout.hs +++ b/src/Perf/Web/Layout.hs @@ -34,11 +34,19 @@ headCommon_ :: Monad m => Text -> HtmlT m () headCommon_ title = head_ do meta_ [charset_ "utf-8"] + meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"] title_ $ toHtml title style_ $ T.unwords - [ "body {font-family: monospace; margin: 0 auto; max-width: 800px;}", - "table.metrics td, table.metrics th {border: 1px solid black; padding: 2px;}" + [ "body {font-family: monospace; margin: 24px; max-width: none;}", + "table.metrics td, table.metrics th {border: 1px solid black; padding: 2px;}", + ".benchmark-subject {margin-bottom: 2rem;}", + ".chart-grid {display: grid; grid-template-columns: repeat(auto-fit, minmax(420px, 1fr)); gap: 1.75rem 12px; align-items: start;}", + ".chart-cell {min-width: 0; margin-bottom: 0.5rem;}", + ".benchmark-plot {width: 100%; min-height: 340px; border: 1px solid #d1d5db; box-sizing: border-box;}", + ".factor-lines {margin-top: 2px; margin-bottom: 0.75rem; color: rgba(0,0,0,0.55); font-size: 0.92rem; line-height: 1.35;}", + ".factor-line {margin-top: 4px; display: flex; align-items: center; gap: 8px;}", + ".factor-swatch {width: 14px; height: 2px; flex: 0 0 auto; background: currentColor;}" ] script_ [ src_ "https://cdn.jsdelivr.net/npm/plotly.js-dist-min@2.35.2/plotly.min.js", diff --git a/src/Perf/Web/Plot.hs b/src/Perf/Web/Plot.hs index 0ac7af2..3e51538 100644 --- a/src/Perf/Web/Plot.hs +++ b/src/Perf/Web/Plot.hs @@ -16,7 +16,7 @@ import Perf.Types.DB qualified as DB import Perf.Types.Prim qualified as Prim import Perf.Web.Chart --- | Whether the "show master branch commits" control is available. +-- | Whether the "Show master branch commits" control is available. data MasterPlotContext key = MasterComparisonDisabled | MasterComparisonEnabled [key] @@ -82,7 +82,7 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do ] do h2_ $ toHtml subject - div_ [style_ "display: flex; flex-wrap: wrap;"] do + div_ [class_ "chart-grid"] do Foldable.for_ (zip [0 :: Int ..] (Set.toList metrics)) \(metricIdx, metricLabel) -> do let dataSets = flip map (Map.toList tests) \(factors, allMetrics) -> @@ -90,16 +90,18 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do labels = map renderKey orderedKeys (plotData, layout) = makePlotlyConfig metricLabel labels dataSets chartId = T.pack (show benchmarkIdx) <> "-" <> T.pack (show metricIdx) - legendLines = length dataSets - chartHeight = 280 + min 320 (40 + legendLines * 16) - chart_ - ChartOptions - { chartId, - plotData, - layout, - masterCount, - heightPx = chartHeight - } + legendEntries = + zip (cycle plotColors) (map (factorsSmall . fst) dataSets) + div_ [class_ "chart-cell"] do + chart_ + ChartOptions + { chartId, + plotData, + layout, + masterCount, + heightPx = 360 + } + factorLegend_ legendEntries -- Script must run after plot containers are in the DOM. unless (Map.null benchmarks) $ script_ plotControlsScript where @@ -134,7 +136,7 @@ plotControls_ masterEnabled = do style_ "display: flex; align-items: center; gap: 0.4rem; white-space: nowrap;" ] do - "show master branch commits:" + "Show master branch commits:" select_ ( [ id_ "master-commits", style_ "font-family: monospace; padding: 0.25rem;" @@ -213,12 +215,11 @@ makePlotlyConfig metricName labels dataSets = "type" .= ("scatter" :: Text), "mode" .= ("lines+markers" :: Text), "name" .= factorsSmall factors, - "line" .= object ["color" .= color] + "line" .= object ["color" .= color, "width" .= (2 :: Int)], + "marker" .= object ["size" .= (7 :: Int), "color" .= color] ] - | ((factors, series), color) <- zip dataSets $ cycle colors + | ((factors, series), color) <- zip dataSets $ cycle plotColors ] - legendLines = length dataSets - bottomMargin = min 320 (40 + legendLines * 16) layout = object [ "title" @@ -229,33 +230,33 @@ makePlotlyConfig metricName labels dataSets = "xaxis" .= object [ "title" .= ("" :: Text), + "tickangle" .= (-30 :: Int), + "automargin" .= True, "tickfont" .= object ["family" .= ("monospace" :: Text)] ], "yaxis" .= object [ "title" .= coerce @_ @Text metricName, "rangemode" .= ("tozero" :: Text), + "automargin" .= True, "tickfont" .= object ["family" .= ("monospace" :: Text)] ], "font" .= object ["family" .= ("monospace" :: Text)], "hovermode" .= ("x unified" :: Text), - "showlegend" .= True, - "legend" - .= object - [ "orientation" .= ("v" :: Text), - "x" .= (0 :: Double), - "y" .= (0 :: Double), - "xanchor" .= ("left" :: Text), - "yanchor" .= ("bottom" :: Text), - "yref" .= ("container" :: Text), - "xref" .= ("paper" :: Text), - "bgcolor" .= ("rgba(0,0,0,0)" :: Text), - "font" .= object ["color" .= ("rgba(0,0,0,0.55)" :: Text), "size" .= (11 :: Int)] - ], - "margin" .= object ["t" .= (40 :: Int), "b" .= bottomMargin, "l" .= (60 :: Int), "r" .= (20 :: Int)] + "showlegend" .= False, + "margin" .= object ["t" .= (40 :: Int), "b" .= (56 :: Int), "l" .= (64 :: Int), "r" .= (40 :: Int)] ] - colors :: [Text] = - T.words "#4394E5 #87BB62 #876FD4 #F5921B" + +plotColors :: [Text] +plotColors = T.words "#4394E5 #87BB62 #876FD4 #F5921B #1f77b4 #ff7f0e #2ca02c #d62728" + +factorLegend_ :: [(Text, Text)] -> Html () +factorLegend_ entries = + div_ [class_ "factor-lines"] do + Foldable.for_ entries \(color, name) -> + div_ [class_ "factor-line"] do + span_ [class_ "factor-swatch", style_ ("background-color: " <> color)] (pure ()) + span_ (toHtml name) factorSmall :: Prim.GeneralFactor -> Text factorSmall factor = T.concat [T.strip factor.name, "=", T.strip factor.value] From c46216d3880c32d5f891531a0961cc49649be7b4 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 28 Jul 2026 21:59:46 +0200 Subject: [PATCH 3/6] further tweaks --- app/BenchmarkDisplay.hs | 41 +++++++----- src/Perf/Web/Layout.hs | 15 +++-- src/Perf/Web/Plot.hs | 134 +++++++++++++++++++++++++++++++++------- src/Perf/Web/Routes.hs | 32 +++++----- 4 files changed, 162 insertions(+), 60 deletions(-) diff --git a/app/BenchmarkDisplay.hs b/app/BenchmarkDisplay.hs index 0d0f07c..a04f149 100644 --- a/app/BenchmarkDisplay.hs +++ b/app/BenchmarkDisplay.hs @@ -99,24 +99,31 @@ loadBenchmarksHtmlFromSqlite :: FilePath -> Text -> Int -> IO (Html ()) loadBenchmarksHtmlFromSqlite sqlite branch limit = runSqlite (T.pack sqlite) do runMigration DB.migrateAll - branchCommitEntities <- loadBranchCommits branch limit - case NonEmpty.nonEmpty branchCommitEntities of - Nothing -> pure mempty - Just branchCommitsNE -> do - let isMaster = branch == "master" - branchCommits = map entityVal branchCommitEntities + let isMaster = branch == "master" + masterCommitEntities <- loadBranchCommits "master" maxMasterCommits + branchCommitEntities <- + if isMaster + then pure [] + else loadBranchCommits branch limit + let masterCtx = MasterComparisonEnabled (map entityVal masterCommitEntities) + branchCommits = map entityVal branchCommitEntities + case (isMaster, NonEmpty.nonEmpty masterCommitEntities, NonEmpty.nonEmpty branchCommitEntities) of + (True, Nothing, _) -> pure mempty + (True, Just masterCommitsNE, _) -> do + masterBenchmarks <- materializeCommits masterCommitsNE + pure $ generateCommitPlotsWith masterCtx [] masterBenchmarks + (False, _, Nothing) -> pure mempty + (False, Nothing, Just branchCommitsNE) -> do branchBenchmarks <- materializeCommits branchCommitsNE - if isMaster - then pure $ generateCommitPlotsWith MasterComparisonDisabled branchCommits branchBenchmarks - else do - masterCommitEntities <- loadBranchCommits "master" 10 - let masterCtx = MasterComparisonEnabled (map entityVal masterCommitEntities) - benchmarks <- case NonEmpty.nonEmpty masterCommitEntities of - Nothing -> pure branchBenchmarks - Just masterCommitsNE -> do - masterBenchmarks <- materializeCommits masterCommitsNE - pure $ mergeMasterIntoBranch masterBenchmarks branchBenchmarks - pure $ generateCommitPlotsWith masterCtx branchCommits benchmarks + pure $ generateCommitPlotsWith masterCtx branchCommits branchBenchmarks + (False, Just masterCommitsNE, Just branchCommitsNE) -> do + masterBenchmarks <- materializeCommits masterCommitsNE + branchBenchmarks <- materializeCommits branchCommitsNE + pure $ + generateCommitPlotsWith + masterCtx + branchCommits + (mergeMasterIntoBranch masterBenchmarks branchBenchmarks) openFile :: FilePath -> IO () openFile path = diff --git a/src/Perf/Web/Layout.hs b/src/Perf/Web/Layout.hs index 5cd776a..fd517ef 100644 --- a/src/Perf/Web/Layout.hs +++ b/src/Perf/Web/Layout.hs @@ -38,15 +38,18 @@ headCommon_ title = title_ $ toHtml title style_ $ T.unwords - [ "body {font-family: monospace; margin: 24px; max-width: none;}", + [ "body {font-family: monospace; margin: 24px; max-width: none; background: #f6f7f9; color: #111827;}", "table.metrics td, table.metrics th {border: 1px solid black; padding: 2px;}", - ".benchmark-subject {margin-bottom: 2rem;}", + ".benchmark-subject {background: #ffffff; border: 1px solid #e5e7eb; border-radius: 10px; padding: 14px 14px 18px 14px; margin-bottom: 1.25rem;}", + ".benchmark-subject > h2 {margin: 0 0 8px 0;}", ".chart-grid {display: grid; grid-template-columns: repeat(auto-fit, minmax(420px, 1fr)); gap: 1.75rem 12px; align-items: start;}", ".chart-cell {min-width: 0; margin-bottom: 0.5rem;}", - ".benchmark-plot {width: 100%; min-height: 340px; border: 1px solid #d1d5db; box-sizing: border-box;}", - ".factor-lines {margin-top: 2px; margin-bottom: 0.75rem; color: rgba(0,0,0,0.55); font-size: 0.92rem; line-height: 1.35;}", - ".factor-line {margin-top: 4px; display: flex; align-items: center; gap: 8px;}", - ".factor-swatch {width: 14px; height: 2px; flex: 0 0 auto; background: currentColor;}" + ".benchmark-plot {width: 100%; min-height: 340px;}", + ".factor-lines {margin-top: 2px; margin-bottom: 0.75rem; color: #6b7280; font-size: 0.92rem; line-height: 1.35;}", + ".factor-line {margin-top: 4px;}", + ".factor-toggle {border: none; background: transparent; color: #4b5563; cursor: pointer; font: inherit; display: inline-flex; align-items: center; gap: 8px; padding: 0; text-align: left;}", + ".factor-toggle.off {opacity: 0.5; text-decoration: line-through;}", + ".factor-swatch {width: 14px; height: 2px; border-radius: 2px; flex: 0 0 auto;}" ] script_ [ src_ "https://cdn.jsdelivr.net/npm/plotly.js-dist-min@2.35.2/plotly.min.js", diff --git a/src/Perf/Web/Plot.hs b/src/Perf/Web/Plot.hs index 3e51538..30f3edc 100644 --- a/src/Perf/Web/Plot.hs +++ b/src/Perf/Web/Plot.hs @@ -20,7 +20,15 @@ import Perf.Web.Chart data MasterPlotContext key = MasterComparisonDisabled | MasterComparisonEnabled [key] - -- ^ Master keys in historical order (oldest first), at most 10. + -- ^ Master keys in historical order (oldest first), at most 'maxMasterCommits'. + +-- | Selectable values for the master-commits control. +masterCommitOptions :: [Int] +masterCommitOptions = [0, 1, 2, 3, 5, 10, 20, 30, 50, 100] + +-- | How many master commits to load for the control (largest option). +maxMasterCommits :: Int +maxMasterCommits = maximum masterCommitOptions generateCommitPlots :: BenchmarkSeries DB.Commit DB.Metric -> Html () generateCommitPlots benchmarks = @@ -67,7 +75,12 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do masterEnabled = case masterCtx of MasterComparisonDisabled -> False MasterComparisonEnabled {} -> True - unless (Map.null benchmarks) $ plotControls_ masterEnabled + -- On master itself there is no trailing branch series. + defaultMasterShow + | masterEnabled && null branchKeys = 20 + | masterEnabled = 1 + | otherwise = 0 + unless (Map.null benchmarks) $ plotControls_ masterEnabled defaultMasterShow Foldable.for_ (zip [0 :: Int ..] (Map.toList benchmarks)) \(benchmarkIdx, (subject, tests)) -> do let metrics :: Set Prim.MetricLabel = Set.fromList $ concatMap Map.keys $ Map.elems tests @@ -101,7 +114,7 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do masterCount, heightPx = 360 } - factorLegend_ legendEntries + factorLegend_ chartId legendEntries -- Script must run after plot containers are in the DOM. unless (Map.null benchmarks) $ script_ plotControlsScript where @@ -118,8 +131,8 @@ collectKeys benchmarks = concatMap Map.elems $ Map.elems benchmarks -plotControls_ :: Bool -> Html () -plotControls_ masterEnabled = do +plotControls_ :: Bool -> Int -> Html () +plotControls_ masterEnabled defaultMasterShow = do div_ [ class_ "plot-controls", style_ "display: flex; flex-wrap: wrap; gap: 1rem; align-items: center; margin: 1rem 0;" @@ -129,25 +142,25 @@ plotControls_ masterEnabled = do [ type_ "search", id_ "plot-search", placeholder_ "Search in plot title", - style_ "flex: 1; min-width: 16rem; padding: 0.35rem 0.5rem; font-family: monospace;" + style_ "flex: 1 1 30%; min-width: 200px; max-width: 30%; padding: 0.35rem 0.5rem; font-family: monospace;" ] label_ [ for_ "master-commits", - style_ "display: flex; align-items: center; gap: 0.4rem; white-space: nowrap;" + style_ "display: flex; align-items: center; gap: 0.4rem; white-space: nowrap; color: #15803d;" ] do "Show master branch commits:" select_ ( [ id_ "master-commits", - style_ "font-family: monospace; padding: 0.25rem;" + style_ "font-family: monospace; padding: 0.25rem; color: #111111;" ] <> [makeAttributes "disabled" "disabled" | not masterEnabled] ) do - forM_ ([0, 1, 2, 3, 5, 10] :: [Int]) \n -> + forM_ masterCommitOptions \n -> option_ ( [value_ (T.pack (show n))] - <> [makeAttributes "selected" "selected" | n == 0] + <> [makeAttributes "selected" "selected" | n == defaultMasterShow] ) (toHtml (show n)) @@ -158,6 +171,8 @@ plotControlsScript = " const search = document.getElementById('plot-search');", " const masterSelect = document.getElementById('master-commits');", " const config = {responsive: true, modeBarButtonsToRemove: ['select2d', 'lasso2d']};", + " const traceVisibility = new Map();", + " const singleClickTimers = new Map();", " function applySearch() {", " if (!search) return;", " const q = (search.value || '').trim().toLowerCase();", @@ -178,6 +193,37 @@ plotControlsScript = " y: (trace.y || []).slice(start)", " }));", " }", + " function ensureVisibility(chartId, traceCount) {", + " let vis = traceVisibility.get(chartId);", + " if (!vis || vis.length !== traceCount) {", + " vis = Array.from({length: traceCount}, () => true);", + " traceVisibility.set(chartId, vis);", + " }", + " return vis;", + " }", + " function syncLegendUI(chartEl) {", + " const vis = traceVisibility.get(chartEl.id) || [];", + " const root = chartEl.parentElement;", + " if (!root) return;", + " root.querySelectorAll('.factor-toggle').forEach((btn, i) => {", + " btn.classList.toggle('off', !vis[i]);", + " });", + " }", + " function applyVisibility(chartEl) {", + " const count = (chartEl.data && chartEl.data.length) || 0;", + " if (!count) return Promise.resolve();", + " const vis = ensureVisibility(chartEl.id, count);", + " syncLegendUI(chartEl);", + " return Plotly.restyle(chartEl, {visible: vis.slice()});", + " }", + " function colorMasterTicks(plotEl, showMaster) {", + " const shown = Math.max(0, showMaster);", + " plotEl.querySelectorAll('g.xtick text').forEach((node, i) => {", + " const color = i < shown ? '#15803d' : '#111111';", + " node.style.fill = color;", + " node.setAttribute('fill', color);", + " });", + " }", " function redrawPlots() {", " const show = masterShow();", " document.querySelectorAll('.benchmark-plot').forEach((el) => {", @@ -185,14 +231,50 @@ plotControlsScript = " const layout = JSON.parse(el.getAttribute('data-layout') || '{}');", " const masterCount = parseInt(el.getAttribute('data-master-count') || '0', 10) || 0;", " const data = slicePlotData(fullData, masterCount, show);", - " if (el.getAttribute('data-plotted') === '1') {", - " Plotly.react(el, data, layout, config);", - " } else {", - " Plotly.newPlot(el, data, layout, config);", - " el.setAttribute('data-plotted', '1');", - " }", + " ensureVisibility(el.id, data.length);", + " const shownMaster = Math.min(show, masterCount);", + " const finish = () => {", + " colorMasterTicks(el, shownMaster);", + " return applyVisibility(el).then(() => requestAnimationFrame(() => colorMasterTicks(el, shownMaster)));", + " };", + " const plotted = el.getAttribute('data-plotted') === '1'", + " ? Plotly.react(el, data, layout, config)", + " : Plotly.newPlot(el, data, layout, config).then(() => el.setAttribute('data-plotted', '1'));", + " Promise.resolve(plotted).then(finish);", " });", " }", + " function isolateTrace(chartEl, onlyIdx) {", + " const count = (chartEl.data && chartEl.data.length) || 0;", + " const vis = ensureVisibility(chartEl.id, count);", + " for (let i = 0; i < vis.length; i++) vis[i] = i === onlyIdx;", + " applyVisibility(chartEl);", + " }", + " document.addEventListener('click', (e) => {", + " const btn = e.target.closest('.factor-toggle');", + " if (!btn) return;", + " const chartId = btn.getAttribute('data-chart-id');", + " const traceIdx = parseInt(btn.getAttribute('data-trace-idx'), 10);", + " const chartEl = chartId ? document.getElementById(chartId) : null;", + " if (!chartEl || !Number.isFinite(traceIdx)) return;", + " if (e.detail === 2) {", + " const prev = singleClickTimers.get(btn);", + " if (prev) clearTimeout(prev);", + " singleClickTimers.delete(btn);", + " isolateTrace(chartEl, traceIdx);", + " return;", + " }", + " if (e.detail === 1) {", + " const prev = singleClickTimers.get(btn);", + " if (prev) clearTimeout(prev);", + " singleClickTimers.set(btn, setTimeout(() => {", + " singleClickTimers.delete(btn);", + " const count = (chartEl.data && chartEl.data.length) || 0;", + " const vis = ensureVisibility(chartEl.id, count);", + " vis[traceIdx] = !vis[traceIdx];", + " applyVisibility(chartEl);", + " }, 280));", + " }", + " });", " if (search) search.addEventListener('input', applySearch);", " if (masterSelect) masterSelect.addEventListener('change', redrawPlots);", " applySearch();", @@ -232,7 +314,7 @@ makePlotlyConfig metricName labels dataSets = [ "title" .= ("" :: Text), "tickangle" .= (-30 :: Int), "automargin" .= True, - "tickfont" .= object ["family" .= ("monospace" :: Text)] + "tickfont" .= object ["family" .= ("monospace" :: Text), "color" .= ("#111111" :: Text)] ], "yaxis" .= object @@ -250,13 +332,21 @@ makePlotlyConfig metricName labels dataSets = plotColors :: [Text] plotColors = T.words "#4394E5 #87BB62 #876FD4 #F5921B #1f77b4 #ff7f0e #2ca02c #d62728" -factorLegend_ :: [(Text, Text)] -> Html () -factorLegend_ entries = +factorLegend_ :: Text -> [(Text, Text)] -> Html () +factorLegend_ chartId entries = div_ [class_ "factor-lines"] do - Foldable.for_ entries \(color, name) -> + Foldable.for_ (zip [0 :: Int ..] entries) \(idx, (color, name)) -> div_ [class_ "factor-line"] do - span_ [class_ "factor-swatch", style_ ("background-color: " <> color)] (pure ()) - span_ (toHtml name) + button_ + [ type_ "button", + class_ "factor-toggle", + title_ "Click to show or hide this line. Double-click to show only this line.", + makeAttributes "data-chart-id" chartId, + makeAttributes "data-trace-idx" (T.pack (show idx)) + ] + do + span_ [class_ "factor-swatch", style_ ("background-color: " <> color)] (pure ()) + span_ (toHtml name) factorSmall :: Prim.GeneralFactor -> Text factorSmall factor = T.concat [T.strip factor.name, "=", T.strip factor.value] diff --git a/src/Perf/Web/Routes.hs b/src/Perf/Web/Routes.hs index 2d984a6..a917323 100644 --- a/src/Perf/Web/Routes.hs +++ b/src/Perf/Web/Routes.hs @@ -58,26 +58,28 @@ getBranchR name = do mmaxGraph <- fmap (>>= (RIO.readMaybe @Int . T.unpack)) $ lookupGetParam "limit" let maxGraph :: Int = fromMaybe 28 $ mmaxGraph isMaster = name == "master" - branchCommitEntities <- db $ loadBranchCommits name maxGraph - -- Newest-first for the commits table (historical order is reversed). - let commitsNewestFirst = reverse branchCommitEntities - masterCommitEntities <- + masterCommitEntities <- db $ loadBranchCommits "master" maxMasterCommits + branchCommitEntities <- if isMaster then pure [] - else db $ loadBranchCommits "master" 10 - let masterCtx = - if isMaster - then MasterComparisonDisabled - else MasterComparisonEnabled (map entityVal masterCommitEntities) + else db $ loadBranchCommits name maxGraph + -- Newest-first for the commits table (historical order is reversed). + let commitsNewestFirst = + reverse $ + if isMaster then masterCommitEntities else branchCommitEntities + masterCtx = MasterComparisonEnabled (map entityVal masterCommitEntities) branchCommits = map entityVal branchCommitEntities mbenchmarks <- db do - branchBenchmarks <- for (NonEmpty.nonEmpty branchCommitEntities) materializeCommits masterBenchmarks <- for (NonEmpty.nonEmpty masterCommitEntities) materializeCommits + branchBenchmarks <- for (NonEmpty.nonEmpty branchCommitEntities) materializeCommits pure $ - case (branchBenchmarks, masterBenchmarks) of - (Nothing, _) -> Nothing - (Just branchName, Nothing) -> Just branchName - (Just branchName, Just master) -> Just (mergeMasterIntoBranch master branchName) + case (isMaster, masterBenchmarks, branchBenchmarks) of + (True, Nothing, _) -> Nothing + (True, Just master, _) -> Just master + (False, _, Nothing) -> Nothing + (False, Nothing, Just branchSeries) -> Just branchSeries + (False, Just master, Just branchSeries) -> + Just (mergeMasterIntoBranch master branchSeries) lucid do defaultLayout_ branch.branchName do for_ mbenchmarks \benchmarks -> @@ -109,7 +111,7 @@ getBranchR name = do $ "compare previous" p_ $ small_ do "(limited to most recent " - toHtml $ show maxGraph + toHtml $ show $ if isMaster then maxMasterCommits else maxGraph " commits)" getCommitR :: Prim.Hash -> Handler (Html ()) From e9185db8c0b42dca4a69a7f18504d3054f41a275 Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 28 Jul 2026 22:40:40 +0200 Subject: [PATCH 4/6] more fixes --- app/BenchmarkDisplay.hs | 43 ++---- package.yaml | 1 + perfly.cabal | 1 + src/Perf/DB/Materialize.hs | 66 +++++++++ src/Perf/Web/Chart.hs | 16 ++- src/Perf/Web/Layout.hs | 35 ++--- src/Perf/Web/Plot.hs | 282 ++++++++++++++++++++----------------- src/Perf/Web/Routes.hs | 35 ++--- 8 files changed, 276 insertions(+), 203 deletions(-) diff --git a/app/BenchmarkDisplay.hs b/app/BenchmarkDisplay.hs index a04f149..3d10788 100644 --- a/app/BenchmarkDisplay.hs +++ b/app/BenchmarkDisplay.hs @@ -50,7 +50,14 @@ main = do NonEmpty.fromList snapshots writeAndOpen cli.outputPath html Sqlite sqlite branch limit -> do - htmlBody <- loadBenchmarksHtmlFromSqlite sqlite branch limit + mplotData <- loadBenchmarksFromSqlite sqlite branch limit + let htmlBody = case mplotData of + Nothing -> mempty + Just plotData -> + generateCommitPlotsWith + (MasterComparisonEnabled plotData.masterCommits) + plotData.branchCommits + plotData.benchmarks writeAndOpen cli.outputPath $ staticLayout_ ("Benchmarks: " <> branch) htmlBody @@ -95,35 +102,15 @@ labelFromPath path = then T.pack suffix else T.pack base -loadBenchmarksHtmlFromSqlite :: FilePath -> Text -> Int -> IO (Html ()) -loadBenchmarksHtmlFromSqlite sqlite branch limit = +-- | Load plot data from sqlite (no HTML). +loadBenchmarksFromSqlite :: FilePath -> Text -> Int -> IO (Maybe BranchPlotData) +loadBenchmarksFromSqlite sqlite branch limit = runSqlite (T.pack sqlite) do runMigration DB.migrateAll - let isMaster = branch == "master" - masterCommitEntities <- loadBranchCommits "master" maxMasterCommits - branchCommitEntities <- - if isMaster - then pure [] - else loadBranchCommits branch limit - let masterCtx = MasterComparisonEnabled (map entityVal masterCommitEntities) - branchCommits = map entityVal branchCommitEntities - case (isMaster, NonEmpty.nonEmpty masterCommitEntities, NonEmpty.nonEmpty branchCommitEntities) of - (True, Nothing, _) -> pure mempty - (True, Just masterCommitsNE, _) -> do - masterBenchmarks <- materializeCommits masterCommitsNE - pure $ generateCommitPlotsWith masterCtx [] masterBenchmarks - (False, _, Nothing) -> pure mempty - (False, Nothing, Just branchCommitsNE) -> do - branchBenchmarks <- materializeCommits branchCommitsNE - pure $ generateCommitPlotsWith masterCtx branchCommits branchBenchmarks - (False, Just masterCommitsNE, Just branchCommitsNE) -> do - masterBenchmarks <- materializeCommits masterCommitsNE - branchBenchmarks <- materializeCommits branchCommitsNE - pure $ - generateCommitPlotsWith - masterCtx - branchCommits - (mergeMasterIntoBranch masterBenchmarks branchBenchmarks) + loadBranchPlotData + branch + limit + (if branch == "master" then maxMasterCommits else maxMasterCommitsOnBranch) openFile :: FilePath -> IO () openFile path = diff --git a/package.yaml b/package.yaml index ba9d8ea..5a39c96 100644 --- a/package.yaml +++ b/package.yaml @@ -46,6 +46,7 @@ dependencies: - persistent-template - hspec-discover - containers +- neat-interpolation ghc-options: - -Wall diff --git a/perfly.cabal b/perfly.cabal index 45794da..66b88f1 100644 --- a/perfly.cabal +++ b/perfly.cabal @@ -63,6 +63,7 @@ library , lucid2 , monad-logger , mtl + , neat-interpolation , persistent , persistent-sqlite , persistent-template diff --git a/src/Perf/DB/Materialize.hs b/src/Perf/DB/Materialize.hs index 271364e..a17dca8 100644 --- a/src/Perf/DB/Materialize.hs +++ b/src/Perf/DB/Materialize.hs @@ -59,6 +59,72 @@ mergeMasterIntoBranch masterBenchmarks branchBenchmarks = ) branchBenchmarks +-- | Loaded plot series for a branch page / CLI report. +data BranchPlotData = BranchPlotData + { masterCommits :: [DB.Commit], + -- ^ Master commits in historical order (oldest first). + branchCommits :: [DB.Commit], + -- ^ Current-branch commits in historical order; empty when viewing master. + benchmarks :: BenchmarkSeries DB.Commit DB.Metric, + tableCommitEntities :: [Entity DB.Commit] + -- ^ Commits for the branch commits table (historical order). + } + +-- | Load master + branch series for plotting. +-- +-- When @branchName == "master"@, @branchCommits@ is empty and @benchmarks@ +-- contains only master data. Otherwise master metrics are merged into branch +-- subjects (master-only subjects are dropped). +loadBranchPlotData :: + Text -> + Int -> + Int -> + DB.DB (Maybe BranchPlotData) +loadBranchPlotData branchName branchLimit masterLimit = do + let isMaster = branchName == "master" + masterEntities <- loadBranchCommits "master" masterLimit + branchEntities <- + if isMaster + then pure [] + else loadBranchCommits branchName branchLimit + let masterCommits = map entityVal masterEntities + branchCommits = map entityVal branchEntities + tableCommitEntities = if isMaster then masterEntities else branchEntities + case (isMaster, NonEmpty.nonEmpty masterEntities, NonEmpty.nonEmpty branchEntities) of + (True, Nothing, _) -> pure Nothing + (True, Just masterNE, _) -> do + benchmarks <- materializeCommits masterNE + pure $ + Just + BranchPlotData + { masterCommits, + branchCommits = [], + benchmarks, + tableCommitEntities + } + (False, _, Nothing) -> pure Nothing + (False, Nothing, Just branchNE) -> do + benchmarks <- materializeCommits branchNE + pure $ + Just + BranchPlotData + { masterCommits, + branchCommits, + benchmarks, + tableCommitEntities + } + (False, Just masterNE, Just branchNE) -> do + masterBenchmarks <- materializeCommits masterNE + branchBenchmarks <- materializeCommits branchNE + pure $ + Just + BranchPlotData + { masterCommits, + branchCommits, + benchmarks = mergeMasterIntoBranch masterBenchmarks branchBenchmarks, + tableCommitEntities + } + -- Materialize a set of commits into a data set we can work with. materializeCommits :: NonEmpty (Entity DB.Commit) -> diff --git a/src/Perf/Web/Chart.hs b/src/Perf/Web/Chart.hs index 55d432f..0e6e204 100644 --- a/src/Perf/Web/Chart.hs +++ b/src/Perf/Web/Chart.hs @@ -16,8 +16,20 @@ data ChartOptions = ChartOptions heightPx :: Int } --- | Emit a plot container. Plotting is performed by the shared controls script --- in 'Perf.Web.Plot', which reads the data-* attributes. +-- | Shared Plotly config (also embedded in the plot-controls script). +plotlyConfig :: Value +plotlyConfig = + object + [ "responsive" .= True, + "modeBarButtonsToRemove" .= (["select2d", "lasso2d"] :: [Text]) + ] + +plotlyConfigJson :: Text +plotlyConfigJson = encode' plotlyConfig + +-- | Emit a plot container. The shared controls script in 'Perf.Web.Plot' calls +-- @Plotly.newPlot@ / @Plotly.react@ using the data-* attributes (so master-commit +-- slicing and legend toggles can update plots in the browser). chart_ :: ChartOptions -> Html () chart_ opts = do div_ diff --git a/src/Perf/Web/Layout.hs b/src/Perf/Web/Layout.hs index fd517ef..538b763 100644 --- a/src/Perf/Web/Layout.hs +++ b/src/Perf/Web/Layout.hs @@ -2,8 +2,8 @@ module Perf.Web.Layout where import Data.List qualified as List import Data.Text (Text) -import Data.Text qualified as T import Lucid.Base +import NeatInterpolation (trimming) import Perf.Types.Web import Yesod.Lucid @@ -36,24 +36,27 @@ headCommon_ title = meta_ [charset_ "utf-8"] meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"] title_ $ toHtml title - style_ $ - T.unwords - [ "body {font-family: monospace; margin: 24px; max-width: none; background: #f6f7f9; color: #111827;}", - "table.metrics td, table.metrics th {border: 1px solid black; padding: 2px;}", - ".benchmark-subject {background: #ffffff; border: 1px solid #e5e7eb; border-radius: 10px; padding: 14px 14px 18px 14px; margin-bottom: 1.25rem;}", - ".benchmark-subject > h2 {margin: 0 0 8px 0;}", - ".chart-grid {display: grid; grid-template-columns: repeat(auto-fit, minmax(420px, 1fr)); gap: 1.75rem 12px; align-items: start;}", - ".chart-cell {min-width: 0; margin-bottom: 0.5rem;}", - ".benchmark-plot {width: 100%; min-height: 340px;}", - ".factor-lines {margin-top: 2px; margin-bottom: 0.75rem; color: #6b7280; font-size: 0.92rem; line-height: 1.35;}", - ".factor-line {margin-top: 4px;}", - ".factor-toggle {border: none; background: transparent; color: #4b5563; cursor: pointer; font: inherit; display: inline-flex; align-items: center; gap: 8px; padding: 0; text-align: left;}", - ".factor-toggle.off {opacity: 0.5; text-decoration: line-through;}", - ".factor-swatch {width: 14px; height: 2px; border-radius: 2px; flex: 0 0 auto;}" - ] + style_ commonStyles script_ [ src_ "https://cdn.jsdelivr.net/npm/plotly.js-dist-min@2.35.2/plotly.min.js", crossorigin_ "anonymous", makeAttributes "referrerpolicy" "no-referrer" ] (mempty :: Text) + +commonStyles :: Text +commonStyles = + [trimming| + body {font-family: monospace; margin: 24px; max-width: none; background: #f6f7f9; color: #111827;} + table.metrics td, table.metrics th {border: 1px solid black; padding: 2px;} + .benchmark-subject {background: #ffffff; border: 1px solid #e5e7eb; border-radius: 10px; padding: 14px 14px 18px 14px; margin-bottom: 1.25rem;} + .benchmark-subject > h2 {margin: 0 0 8px 0;} + .chart-grid {display: grid; grid-template-columns: repeat(auto-fit, minmax(420px, 1fr)); gap: 1.75rem 12px; align-items: start;} + .chart-cell {min-width: 0; margin-bottom: 0.5rem;} + .benchmark-plot {width: 100%; min-height: 340px;} + .factor-lines {margin-top: 2px; margin-bottom: 0.75rem; color: #6b7280; font-size: 0.92rem; line-height: 1.35;} + .factor-line {margin-top: 4px;} + .factor-toggle {border: none; background: transparent; color: #4b5563; cursor: pointer; font: inherit; display: inline-flex; align-items: center; gap: 8px; padding: 0; text-align: left;} + .factor-toggle.off {opacity: 0.5; text-decoration: line-through;} + .factor-swatch {width: 14px; height: 2px; border-radius: 2px; flex: 0 0 auto;} + |] diff --git a/src/Perf/Web/Plot.hs b/src/Perf/Web/Plot.hs index 30f3edc..24f0d0c 100644 --- a/src/Perf/Web/Plot.hs +++ b/src/Perf/Web/Plot.hs @@ -1,7 +1,6 @@ module Perf.Web.Plot where import Data.Aeson -import Data.Coerce import Data.Foldable qualified as Foldable import Data.Map qualified as Map import Data.Set (Set) @@ -11,6 +10,7 @@ import Data.Text qualified as T import Control.Monad import Lucid import Lucid.Base (makeAttributes) +import NeatInterpolation (trimming) import Perf.DB.Materialize import Perf.Types.DB qualified as DB import Perf.Types.Prim qualified as Prim @@ -23,12 +23,18 @@ data MasterPlotContext key -- ^ Master keys in historical order (oldest first), at most 'maxMasterCommits'. -- | Selectable values for the master-commits control. -masterCommitOptions :: [Int] -masterCommitOptions = [0, 1, 2, 3, 5, 10, 20, 30, 50, 100] +masterCommitOptions :: Bool -> [Int] +masterCommitOptions viewingMaster + | viewingMaster = [0, 1, 2, 3, 5, 10, 20, 30, 50, 100] + | otherwise = [0, 1, 2, 3, 5, 10, 20] --- | How many master commits to load for the control (largest option). +-- | How many master commits to load when viewing master. maxMasterCommits :: Int -maxMasterCommits = maximum masterCommitOptions +maxMasterCommits = maximum (masterCommitOptions True) + +-- | How many master commits to load when viewing a non-master branch. +maxMasterCommitsOnBranch :: Int +maxMasterCommitsOnBranch = maximum (masterCommitOptions False) generateCommitPlots :: BenchmarkSeries DB.Commit DB.Metric -> Html () generateCommitPlots benchmarks = @@ -46,7 +52,7 @@ generateCommitPlotsWith masterCtx branchCommits = generatePlotsWith masterCtx branchCommits - (T.take 8 . (coerce :: Prim.Hash -> Text) . (.commitHash)) + shortCommitLabel (.metricMean) generateExternalPlots :: BenchmarkSeries Text DisplayMetric -> Html () @@ -76,21 +82,23 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do MasterComparisonDisabled -> False MasterComparisonEnabled {} -> True -- On master itself there is no trailing branch series. + viewingMaster = masterEnabled && null branchKeys defaultMasterShow - | masterEnabled && null branchKeys = 20 + | viewingMaster = 20 | masterEnabled = 1 | otherwise = 0 - unless (Map.null benchmarks) $ plotControls_ masterEnabled defaultMasterShow + unless (Map.null benchmarks) $ + plotControls_ masterEnabled defaultMasterShow (masterCommitOptions viewingMaster) Foldable.for_ (zip [0 :: Int ..] (Map.toList benchmarks)) \(benchmarkIdx, (subject, tests)) -> do let metrics :: Set Prim.MetricLabel = Set.fromList $ concatMap Map.keys $ Map.elems tests searchText = T.toLower $ T.unwords $ - coerce subject : map coerce (Set.toList metrics) + subjectText subject : map metricText (Set.toList metrics) div_ [ class_ "benchmark-subject", - makeAttributes "data-plot-title" (coerce subject), + makeAttributes "data-plot-title" (subjectText subject), makeAttributes "data-search-text" searchText ] do @@ -131,8 +139,8 @@ collectKeys benchmarks = concatMap Map.elems $ Map.elems benchmarks -plotControls_ :: Bool -> Int -> Html () -plotControls_ masterEnabled defaultMasterShow = do +plotControls_ :: Bool -> Int -> [Int] -> Html () +plotControls_ masterEnabled defaultMasterShow options = do div_ [ class_ "plot-controls", style_ "display: flex; flex-wrap: wrap; gap: 1rem; align-items: center; margin: 1rem 0;" @@ -157,7 +165,7 @@ plotControls_ masterEnabled defaultMasterShow = do <> [makeAttributes "disabled" "disabled" | not masterEnabled] ) do - forM_ masterCommitOptions \n -> + forM_ options \n -> option_ ( [value_ (T.pack (show n))] <> [makeAttributes "selected" "selected" | n == defaultMasterShow] @@ -166,121 +174,121 @@ plotControls_ masterEnabled defaultMasterShow = do plotControlsScript :: Text plotControlsScript = - T.unlines - [ "(function () {", - " const search = document.getElementById('plot-search');", - " const masterSelect = document.getElementById('master-commits');", - " const config = {responsive: true, modeBarButtonsToRemove: ['select2d', 'lasso2d']};", - " const traceVisibility = new Map();", - " const singleClickTimers = new Map();", - " function applySearch() {", - " if (!search) return;", - " const q = (search.value || '').trim().toLowerCase();", - " document.querySelectorAll('.benchmark-subject').forEach((el) => {", - " const hay = el.getAttribute('data-search-text') || '';", - " el.style.display = (!q || hay.includes(q)) ? '' : 'none';", - " });", - " }", - " function masterShow() {", - " if (!masterSelect || masterSelect.disabled) return 0;", - " const n = parseInt(masterSelect.value, 10);", - " return Number.isFinite(n) ? n : 0;", - " }", - " function slicePlotData(fullData, masterCount, showMaster) {", - " const start = Math.max(0, masterCount - showMaster);", - " return fullData.map((trace) => Object.assign({}, trace, {", - " x: (trace.x || []).slice(start),", - " y: (trace.y || []).slice(start)", - " }));", - " }", - " function ensureVisibility(chartId, traceCount) {", - " let vis = traceVisibility.get(chartId);", - " if (!vis || vis.length !== traceCount) {", - " vis = Array.from({length: traceCount}, () => true);", - " traceVisibility.set(chartId, vis);", - " }", - " return vis;", - " }", - " function syncLegendUI(chartEl) {", - " const vis = traceVisibility.get(chartEl.id) || [];", - " const root = chartEl.parentElement;", - " if (!root) return;", - " root.querySelectorAll('.factor-toggle').forEach((btn, i) => {", - " btn.classList.toggle('off', !vis[i]);", - " });", - " }", - " function applyVisibility(chartEl) {", - " const count = (chartEl.data && chartEl.data.length) || 0;", - " if (!count) return Promise.resolve();", - " const vis = ensureVisibility(chartEl.id, count);", - " syncLegendUI(chartEl);", - " return Plotly.restyle(chartEl, {visible: vis.slice()});", - " }", - " function colorMasterTicks(plotEl, showMaster) {", - " const shown = Math.max(0, showMaster);", - " plotEl.querySelectorAll('g.xtick text').forEach((node, i) => {", - " const color = i < shown ? '#15803d' : '#111111';", - " node.style.fill = color;", - " node.setAttribute('fill', color);", - " });", - " }", - " function redrawPlots() {", - " const show = masterShow();", - " document.querySelectorAll('.benchmark-plot').forEach((el) => {", - " const fullData = JSON.parse(el.getAttribute('data-full') || '[]');", - " const layout = JSON.parse(el.getAttribute('data-layout') || '{}');", - " const masterCount = parseInt(el.getAttribute('data-master-count') || '0', 10) || 0;", - " const data = slicePlotData(fullData, masterCount, show);", - " ensureVisibility(el.id, data.length);", - " const shownMaster = Math.min(show, masterCount);", - " const finish = () => {", - " colorMasterTicks(el, shownMaster);", - " return applyVisibility(el).then(() => requestAnimationFrame(() => colorMasterTicks(el, shownMaster)));", - " };", - " const plotted = el.getAttribute('data-plotted') === '1'", - " ? Plotly.react(el, data, layout, config)", - " : Plotly.newPlot(el, data, layout, config).then(() => el.setAttribute('data-plotted', '1'));", - " Promise.resolve(plotted).then(finish);", - " });", - " }", - " function isolateTrace(chartEl, onlyIdx) {", - " const count = (chartEl.data && chartEl.data.length) || 0;", - " const vis = ensureVisibility(chartEl.id, count);", - " for (let i = 0; i < vis.length; i++) vis[i] = i === onlyIdx;", - " applyVisibility(chartEl);", - " }", - " document.addEventListener('click', (e) => {", - " const btn = e.target.closest('.factor-toggle');", - " if (!btn) return;", - " const chartId = btn.getAttribute('data-chart-id');", - " const traceIdx = parseInt(btn.getAttribute('data-trace-idx'), 10);", - " const chartEl = chartId ? document.getElementById(chartId) : null;", - " if (!chartEl || !Number.isFinite(traceIdx)) return;", - " if (e.detail === 2) {", - " const prev = singleClickTimers.get(btn);", - " if (prev) clearTimeout(prev);", - " singleClickTimers.delete(btn);", - " isolateTrace(chartEl, traceIdx);", - " return;", - " }", - " if (e.detail === 1) {", - " const prev = singleClickTimers.get(btn);", - " if (prev) clearTimeout(prev);", - " singleClickTimers.set(btn, setTimeout(() => {", - " singleClickTimers.delete(btn);", - " const count = (chartEl.data && chartEl.data.length) || 0;", - " const vis = ensureVisibility(chartEl.id, count);", - " vis[traceIdx] = !vis[traceIdx];", - " applyVisibility(chartEl);", - " }, 280));", - " }", - " });", - " if (search) search.addEventListener('input', applySearch);", - " if (masterSelect) masterSelect.addEventListener('change', redrawPlots);", - " applySearch();", - " redrawPlots();", - "})();" - ] + [trimming| + (function () { + const search = document.getElementById('plot-search'); + const masterSelect = document.getElementById('master-commits'); + const config = ${plotlyConfigJson}; + const traceVisibility = new Map(); + const singleClickTimers = new Map(); + function applySearch() { + if (!search) return; + const q = (search.value || '').trim().toLowerCase(); + document.querySelectorAll('.benchmark-subject').forEach((el) => { + const hay = el.getAttribute('data-search-text') || ''; + el.style.display = (!q || hay.includes(q)) ? '' : 'none'; + }); + } + function masterShow() { + if (!masterSelect || masterSelect.disabled) return 0; + const n = parseInt(masterSelect.value, 10); + return Number.isFinite(n) ? n : 0; + } + function slicePlotData(fullData, masterCount, showMaster) { + const start = Math.max(0, masterCount - showMaster); + return fullData.map((trace) => Object.assign({}, trace, { + x: (trace.x || []).slice(start), + y: (trace.y || []).slice(start) + })); + } + function ensureVisibility(chartId, traceCount) { + let vis = traceVisibility.get(chartId); + if (!vis || vis.length !== traceCount) { + vis = Array.from({length: traceCount}, () => true); + traceVisibility.set(chartId, vis); + } + return vis; + } + function syncLegendUI(chartEl) { + const vis = traceVisibility.get(chartEl.id) || []; + const root = chartEl.parentElement; + if (!root) return; + root.querySelectorAll('.factor-toggle').forEach((btn, i) => { + btn.classList.toggle('off', !vis[i]); + }); + } + function applyVisibility(chartEl) { + const count = (chartEl.data && chartEl.data.length) || 0; + if (!count) return Promise.resolve(); + const vis = ensureVisibility(chartEl.id, count); + syncLegendUI(chartEl); + return Plotly.restyle(chartEl, {visible: vis.slice()}); + } + function colorMasterTicks(plotEl, showMaster) { + const shown = Math.max(0, showMaster); + plotEl.querySelectorAll('g.xtick text').forEach((node, i) => { + const color = i < shown ? '#15803d' : '#111111'; + node.style.fill = color; + node.setAttribute('fill', color); + }); + } + function redrawPlots() { + const show = masterShow(); + document.querySelectorAll('.benchmark-plot').forEach((el) => { + const fullData = JSON.parse(el.getAttribute('data-full') || '[]'); + const layout = JSON.parse(el.getAttribute('data-layout') || '{}'); + const masterCount = parseInt(el.getAttribute('data-master-count') || '0', 10) || 0; + const data = slicePlotData(fullData, masterCount, show); + ensureVisibility(el.id, data.length); + const shownMaster = Math.min(show, masterCount); + const finish = () => { + colorMasterTicks(el, shownMaster); + return applyVisibility(el).then(() => requestAnimationFrame(() => colorMasterTicks(el, shownMaster))); + }; + const plotted = el.getAttribute('data-plotted') === '1' + ? Plotly.react(el, data, layout, config) + : Plotly.newPlot(el, data, layout, config).then(() => el.setAttribute('data-plotted', '1')); + Promise.resolve(plotted).then(finish); + }); + } + function isolateTrace(chartEl, onlyIdx) { + const count = (chartEl.data && chartEl.data.length) || 0; + const vis = ensureVisibility(chartEl.id, count); + for (let i = 0; i < vis.length; i++) vis[i] = i === onlyIdx; + applyVisibility(chartEl); + } + document.addEventListener('click', (e) => { + const btn = e.target.closest('.factor-toggle'); + if (!btn) return; + const chartId = btn.getAttribute('data-chart-id'); + const traceIdx = parseInt(btn.getAttribute('data-trace-idx'), 10); + const chartEl = chartId ? document.getElementById(chartId) : null; + if (!chartEl || !Number.isFinite(traceIdx)) return; + if (e.detail === 2) { + const prev = singleClickTimers.get(btn); + if (prev) clearTimeout(prev); + singleClickTimers.delete(btn); + isolateTrace(chartEl, traceIdx); + return; + } + if (e.detail === 1) { + const prev = singleClickTimers.get(btn); + if (prev) clearTimeout(prev); + singleClickTimers.set(btn, setTimeout(() => { + singleClickTimers.delete(btn); + const count = (chartEl.data && chartEl.data.length) || 0; + const vis = ensureVisibility(chartEl.id, count); + vis[traceIdx] = !vis[traceIdx]; + applyVisibility(chartEl); + }, 280)); + } + }); + if (search) search.addEventListener('input', applySearch); + if (masterSelect) masterSelect.addEventListener('change', redrawPlots); + applySearch(); + redrawPlots(); + })(); + |] makePlotlyConfig :: Prim.MetricLabel -> @@ -304,9 +312,9 @@ makePlotlyConfig metricName labels dataSets = ] layout = object - [ "title" + [ "title" .= object - [ "text" .= coerce @_ @Text metricName, + [ "text" .= metricText metricName, "font" .= object ["family" .= ("monospace" :: Text), "size" .= (16 :: Int)] ], "xaxis" @@ -318,7 +326,7 @@ makePlotlyConfig metricName labels dataSets = ], "yaxis" .= object - [ "title" .= coerce @_ @Text metricName, + [ "title" .= metricText metricName, "rangemode" .= ("tozero" :: Text), "automargin" .= True, "tickfont" .= object ["family" .= ("monospace" :: Text)] @@ -353,3 +361,15 @@ factorSmall factor = T.concat [T.strip factor.name, "=", T.strip factor.value] factorsSmall :: Set Prim.GeneralFactor -> Text factorsSmall = T.intercalate "," . map factorSmall . Set.toList + +subjectText :: Prim.SubjectName -> Text +subjectText (Prim.SubjectName t) = t + +metricText :: Prim.MetricLabel -> Text +metricText (Prim.MetricLabel t) = t + +shortCommitLabel :: DB.Commit -> Text +shortCommitLabel commit = + T.take 8 $ + case commit.commitHash of + Prim.Hash h -> h diff --git a/src/Perf/Web/Routes.hs b/src/Perf/Web/Routes.hs index a917323..86fc9b3 100644 --- a/src/Perf/Web/Routes.hs +++ b/src/Perf/Web/Routes.hs @@ -11,7 +11,6 @@ import Data.Maybe import Data.Set (Set) import Data.Text (Text) import Data.Text qualified as T -import Data.Traversable import Database.Persist import Lucid.Base import Perf.DB.Import @@ -58,36 +57,20 @@ getBranchR name = do mmaxGraph <- fmap (>>= (RIO.readMaybe @Int . T.unpack)) $ lookupGetParam "limit" let maxGraph :: Int = fromMaybe 28 $ mmaxGraph isMaster = name == "master" - masterCommitEntities <- db $ loadBranchCommits "master" maxMasterCommits - branchCommitEntities <- - if isMaster - then pure [] - else db $ loadBranchCommits name maxGraph - -- Newest-first for the commits table (historical order is reversed). - let commitsNewestFirst = - reverse $ - if isMaster then masterCommitEntities else branchCommitEntities - masterCtx = MasterComparisonEnabled (map entityVal masterCommitEntities) - branchCommits = map entityVal branchCommitEntities - mbenchmarks <- db do - masterBenchmarks <- for (NonEmpty.nonEmpty masterCommitEntities) materializeCommits - branchBenchmarks <- for (NonEmpty.nonEmpty branchCommitEntities) materializeCommits - pure $ - case (isMaster, masterBenchmarks, branchBenchmarks) of - (True, Nothing, _) -> Nothing - (True, Just master, _) -> Just master - (False, _, Nothing) -> Nothing - (False, Nothing, Just branchSeries) -> Just branchSeries - (False, Just master, Just branchSeries) -> - Just (mergeMasterIntoBranch master branchSeries) + let masterLimit = if isMaster then maxMasterCommits else maxMasterCommitsOnBranch + mplotData <- db $ loadBranchPlotData name maxGraph masterLimit lucid do defaultLayout_ branch.branchName do - for_ mbenchmarks \benchmarks -> + for_ mplotData \plotData -> generalizeHtmlT $ - generateCommitPlotsWith masterCtx branchCommits benchmarks + generateCommitPlotsWith + (MasterComparisonEnabled plotData.masterCommits) + plotData.branchCommits + plotData.benchmarks h1_ "Commits" table_ do - let prevCommits = map Just (drop 1 commitsNewestFirst) <> repeat Nothing + let commitsNewestFirst = maybe [] (reverse . (.tableCommitEntities)) mplotData + prevCommits = map Just (drop 1 commitsNewestFirst) <> repeat Nothing for_ (zip commitsNewestFirst prevCommits) \(Entity _ commit, mprev) -> do let mprevious = fmap (.entityVal) mprev url <- asks (.url) From edd5115c3d28e55af3b1b87e874f5b2b7169448a Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Tue, 28 Jul 2026 22:59:00 +0200 Subject: [PATCH 5/6] more precise filtering --- src/Perf/Web/Plot.hs | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/src/Perf/Web/Plot.hs b/src/Perf/Web/Plot.hs index 24f0d0c..6b0afba 100644 --- a/src/Perf/Web/Plot.hs +++ b/src/Perf/Web/Plot.hs @@ -92,14 +92,11 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do Foldable.for_ (zip [0 :: Int ..] (Map.toList benchmarks)) \(benchmarkIdx, (subject, tests)) -> do let metrics :: Set Prim.MetricLabel = Set.fromList $ concatMap Map.keys $ Map.elems tests - searchText = - T.toLower $ - T.unwords $ - subjectText subject : map metricText (Set.toList metrics) div_ [ class_ "benchmark-subject", makeAttributes "data-plot-title" (subjectText subject), - makeAttributes "data-search-text" searchText + -- Match the visible subject heading only (not metric labels like "time"). + makeAttributes "data-search-text" (T.toLower (subjectText subject)) ] do h2_ $ toHtml subject @@ -123,8 +120,10 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean benchmarks = do heightPx = 360 } factorLegend_ chartId legendEntries - -- Script must run after plot containers are in the DOM. - unless (Map.null benchmarks) $ script_ plotControlsScript + unless (Map.null benchmarks) do + style_ masterTickStyles + -- Script must run after plot containers are in the DOM. + script_ plotControlsScript where toSeries keys metricMap = flip map keys \key -> @@ -172,6 +171,20 @@ plotControls_ masterEnabled defaultMasterShow options = do ) (toHtml (show n)) +-- | Color the first N x-axis ticks green via CSS (survives Plotly resize redraws). +masterTickStyles :: Text +masterTickStyles = + T.unlines + [ ".benchmark-plot[data-shown-master=\"" + <> nText + <> "\"] g.xtick:nth-child(-n+" + <> nText + <> ") text { fill: #15803d !important; }" + | n <- masterCommitOptions True + , n > 0 + , let nText = T.pack (show n) + ] + plotControlsScript :: Text plotControlsScript = [trimming| @@ -224,14 +237,6 @@ plotControlsScript = syncLegendUI(chartEl); return Plotly.restyle(chartEl, {visible: vis.slice()}); } - function colorMasterTicks(plotEl, showMaster) { - const shown = Math.max(0, showMaster); - plotEl.querySelectorAll('g.xtick text').forEach((node, i) => { - const color = i < shown ? '#15803d' : '#111111'; - node.style.fill = color; - node.setAttribute('fill', color); - }); - } function redrawPlots() { const show = masterShow(); document.querySelectorAll('.benchmark-plot').forEach((el) => { @@ -241,10 +246,8 @@ plotControlsScript = const data = slicePlotData(fullData, masterCount, show); ensureVisibility(el.id, data.length); const shownMaster = Math.min(show, masterCount); - const finish = () => { - colorMasterTicks(el, shownMaster); - return applyVisibility(el).then(() => requestAnimationFrame(() => colorMasterTicks(el, shownMaster))); - }; + el.setAttribute('data-shown-master', String(shownMaster)); + const finish = () => applyVisibility(el); const plotted = el.getAttribute('data-plotted') === '1' ? Plotly.react(el, data, layout, config) : Plotly.newPlot(el, data, layout, config).then(() => el.setAttribute('data-plotted', '1')); From 88a2051d3fe51f608df100d4231b4140b25a36dc Mon Sep 17 00:00:00 2001 From: Sergei Winitzki Date: Wed, 29 Jul 2026 11:26:39 +0200 Subject: [PATCH 6/6] remove brossa.io mention --- readme.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/readme.md b/readme.md index 17fd740..abbe6f3 100644 --- a/readme.md +++ b/readme.md @@ -93,7 +93,7 @@ cabal run benchmark-display -- --output benchmark.html run-1.json run-2.json Notes: -- To get the sqlite DB file, use a command like this: `scp brossa.io:/root/perfly/perf.sqlite3 .` (you will need permissions to access `brossa.io` via ssh). +- To get the sqlite DB file, use a command like this: `scp your.deployed.host:/root/perfly/perf.sqlite3 .` - adjust directories as needed. - The generated file defaults to `benchmark-display.html`. - After writing, the tool runs `open benchmark-display.html` on macOS (or `xdg-open` on Linux).