diff --git a/app/BenchmarkDisplay.hs b/app/BenchmarkDisplay.hs index 3d10788..e3bf4d6 100644 --- a/app/BenchmarkDisplay.hs +++ b/app/BenchmarkDisplay.hs @@ -56,6 +56,7 @@ main = do Just plotData -> generateCommitPlotsWith (MasterComparisonEnabled plotData.masterCommits) + Nothing plotData.branchCommits plotData.benchmarks writeAndOpen cli.outputPath $ diff --git a/package.yaml b/package.yaml index 5a39c96..5194156 100644 --- a/package.yaml +++ b/package.yaml @@ -44,6 +44,7 @@ dependencies: - persistent-sqlite - persistent - persistent-template +- esqueleto - hspec-discover - containers - neat-interpolation diff --git a/perfly.cabal b/perfly.cabal index 66b88f1..f3b3118 100644 --- a/perfly.cabal +++ b/perfly.cabal @@ -55,6 +55,7 @@ library , containers , criterion-measurement , directory + , esqueleto , exceptions , formatting , hspec-discover @@ -107,6 +108,7 @@ executable benchmark-display , containers , criterion-measurement , directory + , esqueleto , exceptions , filepath , formatting @@ -162,6 +164,7 @@ executable perfly , containers , criterion-measurement , directory + , esqueleto , exceptions , formatting , hspec-discover @@ -219,6 +222,7 @@ test-suite spec , containers , criterion-measurement , directory + , esqueleto , exceptions , formatting , hspec diff --git a/src/Perf/DB/Materialize.hs b/src/Perf/DB/Materialize.hs index eb1ac84..28fe4ae 100644 --- a/src/Perf/DB/Materialize.hs +++ b/src/Perf/DB/Materialize.hs @@ -1,6 +1,5 @@ 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 @@ -10,7 +9,8 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import Data.Traversable -import Database.Persist +import Database.Esqueleto.Experimental +import qualified Database.Persist as Persist import qualified Perf.Types.Prim as Prim import qualified Perf.Types.DB as DB import qualified Perf.Types.External as EX @@ -29,20 +29,24 @@ data DisplayMetric = DisplayMetric -- | 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 +loadBranchCommits branchName maxCommits = do + commits <- select $ do + (branch :& mapping :& commit) <- + from $ + table @DB.Branch + `innerJoin` table @DB.MapBranchCommit + `on` ( \(branch :& mapping) -> + branch ^. DB.BranchId ==. mapping ^. DB.MapBranchCommitBranchId + ) + `innerJoin` table @DB.Commit + `on` ( \(_branch :& mapping :& commit) -> + mapping ^. DB.MapBranchCommitCommitId ==. commit ^. DB.CommitId + ) + where_ $ branch ^. DB.BranchName ==. val branchName + orderBy [desc (mapping ^. DB.MapBranchCommitId)] + limit (fromIntegral maxCommits) + pure commit + pure (reverse commits) -- | Merge master metrics into branch subjects only (drop master-only subjects). mergeMasterIntoBranch :: @@ -132,12 +136,52 @@ materializeCommits :: DB.DB (BenchmarkSeries DB.Commit DB.Metric) materializeCommits commits = do - benchmarks <- traverse materializeCommit commits + let commitsById = Map.fromList [(entityKey commit, entityVal commit) | commit <- NonEmpty.toList commits] + commitIds = Map.keys commitsById + factorRows <- select $ do + (factor :& _test :& benchmark) <- + from $ + table @DB.Factor + `innerJoin` table @DB.Test + `on` ( \(factor :& test) -> + factor ^. DB.FactorTestId ==. test ^. DB.TestId + ) + `innerJoin` table @DB.Benchmark + `on` ( \(_factor :& test :& benchmark) -> + test ^. DB.TestBenchmarkId ==. benchmark ^. DB.BenchmarkId + ) + where_ $ benchmark ^. DB.BenchmarkCommitId `in_` valList commitIds + pure (factor ^. DB.FactorTestId, factor ^. DB.FactorName, factor ^. DB.FactorValue) + metricRows <- select $ do + (metric :& _test :& benchmark) <- + from $ + table @DB.Metric + `innerJoin` table @DB.Test + `on` ( \(metric :& test) -> + metric ^. DB.MetricTestId ==. test ^. DB.TestId + ) + `innerJoin` table @DB.Benchmark + `on` ( \(_metric :& test :& benchmark) -> + test ^. DB.TestBenchmarkId ==. benchmark ^. DB.BenchmarkId + ) + where_ $ benchmark ^. DB.BenchmarkCommitId `in_` valList commitIds + pure (metric, benchmark ^. DB.BenchmarkCommitId, benchmark ^. DB.BenchmarkSubject) + let factorsByTest = + Map.fromListWith + Set.union + [ (testId, Set.singleton (Prim.GeneralFactor name value)) + | (Value testId, Value name, Value value) <- factorRows + ] pure $ - List.foldl1' (Map.unionWith (Map.unionWith (Map.unionWith Map.union))) $ - NonEmpty.toList $ - fmap (fmap (fmap (fmap (\(commit, metric) -> Map.singleton commit metric)))) $ - benchmarks + Map.fromListWith (Map.unionWith (Map.unionWith Map.union)) + [ ( subject, + Map.singleton + (Map.findWithDefault Set.empty metric.metricTestId factorsByTest) + (Map.singleton metric.metricName (Map.singleton commit metric)) + ) + | (Entity _ metric, Value commitId, Value subject) <- metricRows, + Just commit <- [Map.lookup commitId commitsById] + ] -- Materialize a commit at a given timestamp into data we can work with. materializeCommit :: @@ -148,12 +192,12 @@ materializeCommit :: (Map Prim.MetricLabel (DB.Commit, DB.Metric)))) materializeCommit commit = do - benchmarks0 <- selectList [DB.BenchmarkCommitId ==. commit.entityKey] [Desc DB.BenchmarkCommitId] + benchmarks0 <- Persist.selectList [DB.BenchmarkCommitId Persist.==. commit.entityKey] [Persist.Desc DB.BenchmarkCommitId] benchmarks <- for benchmarks0 \(Entity benchmarkId benchmark) -> do - tests0 <- selectList [DB.TestBenchmarkId ==. benchmarkId] [] + tests0 <- Persist.selectList [DB.TestBenchmarkId Persist.==. benchmarkId] [] tests <- for tests0 \(Entity testId _) -> do - factors <- selectList [DB.FactorTestId ==. testId] [] - metrics <- selectList [DB.MetricTestId ==. testId] [] + factors <- Persist.selectList [DB.FactorTestId Persist.==. testId] [] + metrics <- Persist.selectList [DB.MetricTestId Persist.==. testId] [] pure (map (\factor -> Prim.GeneralFactor factor.entityVal.factorName factor.entityVal.factorValue) factors, diff --git a/src/Perf/Web/Chart.hs b/src/Perf/Web/Chart.hs index 0e6e204..89301c0 100644 --- a/src/Perf/Web/Chart.hs +++ b/src/Perf/Web/Chart.hs @@ -10,9 +10,11 @@ import Lucid.Base (makeAttributes) data ChartOptions = ChartOptions { chartId :: Text, - plotData :: Value, + -- | One entry per line: its series key, legend name and colour. + traces :: Value, + -- | Plotly layout without the x-axis categories, which depend on how many + -- master commits are shown. layout :: Value, - masterCount :: Int, heightPx :: Int } @@ -27,18 +29,17 @@ plotlyConfig = 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). +-- | Emit an empty plot container. The shared controls script in 'Perf.Web.Plot' +-- fills it with @Plotly.newPlot@ / @Plotly.react@ once it scrolls into view, +-- reading the points from the page-level plot data. chart_ :: ChartOptions -> Html () chart_ opts = do div_ [ id_ opts.chartId, class_ "benchmark-plot", 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)) + makeAttributes "data-traces" (encode' opts.traces), + makeAttributes "data-layout" (encode' opts.layout) ] (pure ()) diff --git a/src/Perf/Web/Foundation.hs b/src/Perf/Web/Foundation.hs index f513ab9..7e7fd29 100644 --- a/src/Perf/Web/Foundation.hs +++ b/src/Perf/Web/Foundation.hs @@ -16,6 +16,7 @@ mkYesodData "App" [parseRoutes| /branch/#Text/#Hash BranchCommitR GET /commit/#Hash CommitR GET /compare/#Hash/#Hash CompareCommitsR GET + /master-series MasterSeriesR GET /hooks/update ReceiverR POST |] @@ -33,4 +34,5 @@ instance YesodBreadcrumbs App where let short x = T.take 8 $ coerce x in return ("Compare " <> short hash0 <> " .. " <> short hash1, Just HomeR) BranchCommitR branch commit -> return (coerce commit, Just $ BranchR branch) + MasterSeriesR -> return ("Master series", Nothing) ReceiverR -> return ("Webhook Receiver", Nothing) diff --git a/src/Perf/Web/Plot.hs b/src/Perf/Web/Plot.hs index e1584f9..d06f08f 100644 --- a/src/Perf/Web/Plot.hs +++ b/src/Perf/Web/Plot.hs @@ -22,7 +22,7 @@ import Perf.Web.Chart data MasterPlotContext key = MasterComparisonDisabled | MasterComparisonEnabled [key] - -- ^ Master keys in historical order (oldest first), at most 'maxMasterCommits'. + -- ^ Master keys loaded with the page, in historical order (oldest first). -- | Selectable values for the master-commits control. masterCommitOptions :: Bool -> [Int] @@ -38,21 +38,34 @@ maxMasterCommits = maximum (masterCommitOptions True) maxMasterCommitsOnBranch :: Int maxMasterCommitsOnBranch = maximum (masterCommitOptions False) +-- | How many master commits are shown, and loaded with the page, before the +-- user picks another count. +defaultMasterShown :: Bool -> Int +defaultMasterShown viewingMaster + | viewingMaster = 20 + | otherwise = 3 + generateCommitPlots :: BenchmarkSeries DB.Commit DB.Metric -> Html () generateCommitPlots benchmarks = generateCommitPlotsWith MasterComparisonDisabled + Nothing (collectKeys benchmarks) benchmarks +-- | The optional URL serves more master commits on demand (see +-- 'masterSeriesJson'). Without it, the page can only show the master commits +-- it was rendered with. generateCommitPlotsWith :: MasterPlotContext DB.Commit -> + Maybe Text -> [DB.Commit] -> BenchmarkSeries DB.Commit DB.Metric -> Html () -generateCommitPlotsWith masterCtx branchCommits = +generateCommitPlotsWith masterCtx masterSeriesUrl branchCommits = generatePlotsWith masterCtx + masterSeriesUrl branchCommits shortCommitLabel (.metricMean) @@ -62,38 +75,91 @@ generateExternalPlots :: BenchmarkSeries Text DisplayMetric -> Html () generateExternalPlots benchmarks = generatePlotsWith MasterComparisonDisabled + Nothing (collectKeys benchmarks) id (.mean) (.stddev) benchmarks +-- | Master commits for the master-series endpoint, in the same shape as the +-- master half of the page's plot data. +masterSeriesJson :: [DB.Commit] -> BenchmarkSeries DB.Commit DB.Metric -> Value +masterSeriesJson commits benchmarks = + object + [ "masterLabels" .= map shortCommitLabel commits, + "master" .= seriesJson (.metricMean) (.metricStddev) commits benchmarks + ] + +-- | Identifies one plotted line across the page and the master-series endpoint. +seriesKey :: Prim.SubjectName -> Prim.MetricLabel -> Set Prim.GeneralFactor -> Text +seriesKey subject metricLabel factors = + T.intercalate "\t" [subjectText subject, metricText metricLabel, factorsSmall factors] + +-- | @[[seriesKey, points]]@, where the points follow @keys@ and are +-- @[mean, stddev]@ or @null@ for a commit without that series. +seriesJson :: + Ord key => + (metric -> Double) -> + (metric -> Double) -> + [key] -> + BenchmarkSeries key metric -> + Value +seriesJson metricMean metricStddev keys benchmarks = + toJSON + [ (seriesKey subject metricLabel factors, map point keys) + | (subject, tests) <- Map.toList benchmarks, + (factors, metrics) <- Map.toList tests, + (metricLabel, metricMap) <- Map.toList metrics, + let point key = fmap (\metric -> [roundForChart (metricMean metric), roundForChart (metricStddev metric)]) (Map.lookup key metricMap), + any (`Map.member` metricMap) keys + ] + +-- | Six significant digits are plenty for a chart and keep the JSON small. +roundForChart :: Double -> Double +roundForChart x + | x == 0 || isNaN x || isInfinite x = x + | digits >= 0 = fromInteger (round (x * 10 ^ digits)) / 10 ^ digits + | otherwise = fromInteger (round (x / 10 ^ negate digits)) * 10 ^ negate digits + where + digits = 5 - floor (logBase 10 (abs x)) :: Int + generatePlotsWith :: Ord key => MasterPlotContext key -> + Maybe Text -> [key] -> (key -> Text) -> (metric -> Double) -> (metric -> Double) -> BenchmarkSeries key metric -> Html () -generatePlotsWith masterCtx branchKeys renderKey metricMean metricStddev benchmarks = do +generatePlotsWith masterCtx masterSeriesUrl branchKeys renderKey metricMean metricStddev 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 -- On master itself there is no trailing branch series. viewingMaster = masterEnabled && null branchKeys defaultMasterShow - | viewingMaster = 20 - | masterEnabled = 3 + | masterEnabled = defaultMasterShown viewingMaster | otherwise = 0 - unless (Map.null benchmarks) $ + plotData = + object + [ "masterLabels" .= map renderKey masterKeys, + "branchLabels" .= map renderKey branchKeys, + "master" .= seriesJson metricMean metricStddev masterKeys benchmarks, + "branch" .= seriesJson metricMean metricStddev branchKeys benchmarks, + "fetchUrl" .= masterSeriesUrl + ] + unless (Map.null benchmarks) do plotControls_ masterEnabled defaultMasterShow (masterCommitOptions viewingMaster) + -- The HTML parser ends a script at " do let metrics = orderMetrics $ @@ -110,27 +176,26 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean metricStddev benchma h2_ $ toHtml subject div_ [class_ "chart-grid"] do Foldable.for_ (zip [0 :: Int ..] metrics) \(metricIdx, metricLabel) -> do - let dataSets = - flip map (Map.toList tests) \(factors, allMetrics) -> - let metricSeries = Map.findWithDefault Map.empty metricLabel allMetrics - in ( factors, - toSeries metricMean orderedKeys metricSeries, - toSeries ((2 *) . metricStddev) orderedKeys metricSeries - ) - labels = map renderKey orderedKeys - (plotData, layout) = makePlotlyConfig metricLabel labels dataSets - chartId = T.pack (show benchmarkIdx) <> "-" <> T.pack (show metricIdx) - legendEntries = + let chartLines = zip + [factors | (factors, allMetrics) <- Map.toList tests, Map.member metricLabel allMetrics] (cycle plotColors) - (map (\(factors, _, _) -> factorsSmall factors) dataSets) + traces = + [ object + [ "key" .= seriesKey subject metricLabel factors, + "name" .= factorsSmall factors, + "color" .= color + ] + | (factors, color) <- chartLines + ] + chartId = T.pack (show benchmarkIdx) <> "-" <> T.pack (show metricIdx) + legendEntries = [(color, factorsSmall factors) | (factors, color) <- chartLines] div_ [class_ "chart-cell"] do chart_ ChartOptions { chartId, - plotData, - layout, - masterCount, + traces = toJSON traces, + layout = plotLayout metricLabel, heightPx = 360 } factorLegend_ chartId legendEntries @@ -138,11 +203,6 @@ generatePlotsWith masterCtx branchKeys renderKey metricMean metricStddev benchma style_ masterTickStyles -- Script must run after plot containers are in the DOM. script_ plotControlsScript - where - toSeries accessor keys metricMap = - flip map keys \key -> - maybe Null (toJSON . accessor) $ - Map.lookup key metricMap collectKeys :: Ord key => BenchmarkSeries key metric -> [key] collectKeys benchmarks = @@ -195,8 +255,11 @@ plotControls_ masterEnabled defaultMasterShow options = do makeAttributes "checked" "checked" ] "Start Y axis at zero" + span_ [id_ "plot-status", style_ "color: #6b7280;"] (pure ()) -- | Color the first N x-axis ticks green via CSS (survives Plotly resize redraws). +-- Plotly often inserts extra SVG siblings next to @g.xtick@, so we select the +-- first N ticks with @:nth-child(-n+N of g.xtick)@ rather than @:nth-child@. masterTickStyles :: Text masterTickStyles = T.unlines @@ -204,7 +267,7 @@ masterTickStyles = <> nText <> "\"] g.xtick:nth-child(-n+" <> nText - <> ") text { fill: #15803d !important; }" + <> " of g.xtick) text { fill: #15803d !important; }" | n <- masterCommitOptions True , n > 0 , let nText = T.pack (show n) @@ -217,9 +280,41 @@ plotControlsScript = const search = document.getElementById('plot-search'); const masterSelect = document.getElementById('master-commits'); const startYAtZero = document.getElementById('start-y-at-zero'); + const statusEl = document.getElementById('plot-status'); const config = ${plotlyConfigJson}; + const dataEl = document.getElementById('perf-plot-data'); + const model = JSON.parse((dataEl && dataEl.textContent) || '{}'); + const branchLabels = model.branchLabels || []; + const branchSeries = new Map(model.branch || []); + const fetchUrl = model.fetchUrl || null; + let masterLabels = model.masterLabels || []; + let masterSeries = new Map(model.master || []); + // Fewer master commits than requested means there are no more to fetch. + let masterExhausted = masterLabels.length < masterShow(); + // Bumped whenever the plotted points change; a chart drawn at an older + // version is redrawn when it is next visible. + let dataVersion = 0; + let fetchToken = 0; + const charts = new Map(); + const drawQueue = []; + let drawScheduled = false; const traceVisibility = new Map(); const singleClickTimers = new Map(); + document.querySelectorAll('.benchmark-plot').forEach((el) => { + charts.set(el.id, { + el: el, + traces: JSON.parse(el.getAttribute('data-traces') || '[]'), + layout: JSON.parse(el.getAttribute('data-layout') || '{}'), + visible: false, + queued: false, + plotted: false, + drawnVersion: -1, + drawnYMode: null + }); + }); + function setStatus(text) { + if (statusEl) statusEl.textContent = text; + } function applySearch() { if (!search) return; const q = (search.value || '').trim().toLowerCase(); @@ -233,12 +328,8 @@ plotControlsScript = 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 yMode() { + return (!startYAtZero || startYAtZero.checked) ? 'tozero' : 'normal'; } function ensureVisibility(chartId, traceCount) { let vis = traceVisibility.get(chartId); @@ -257,34 +348,126 @@ plotControlsScript = }); } function applyVisibility(chartEl) { - const count = (chartEl.data && chartEl.data.length) || 0; - if (!count) return Promise.resolve(); - const vis = ensureVisibility(chartEl.id, count); + const state = charts.get(chartEl.id); + if (!state) return; + const vis = ensureVisibility(chartEl.id, state.traces.length); syncLegendUI(chartEl); - return Plotly.restyle(chartEl, {visible: vis.slice()}); + if (state.plotted) Plotly.restyle(chartEl, {visible: vis.slice()}); + } + function pointsFor(series, key, start, count) { + const pts = series.get(key) || []; + const out = []; + for (let i = start; i < start + count; i++) out.push(pts[i] || null); + return out; } - 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') || '{}'); - layout.yaxis = layout.yaxis || {}; - layout.yaxis.rangemode = (!startYAtZero || startYAtZero.checked) ? 'tozero' : 'normal'; - 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); - 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')); - Promise.resolve(plotted).then(finish); + function buildPlot(state) { + const shown = Math.min(masterShow(), masterLabels.length); + const start = masterLabels.length - shown; + const labels = masterLabels.slice(start).concat(branchLabels); + const vis = ensureVisibility(state.el.id, state.traces.length); + const data = state.traces.map((trace, i) => { + const pts = pointsFor(masterSeries, trace.key, start, shown) + .concat(pointsFor(branchSeries, trace.key, 0, branchLabels.length)); + return { + x: labels, + y: pts.map((p) => p ? p[0] : null), + type: 'scatter', + mode: 'lines+markers', + name: trace.name, + visible: vis[i], + line: {color: trace.color, width: 2}, + marker: {size: 7, color: trace.color}, + error_y: {type: 'data', array: pts.map((p) => p ? 2 * p[1] : null), visible: true} + }; + }); + const layout = Object.assign({}, state.layout, { + xaxis: Object.assign({}, state.layout.xaxis, {categoryarray: labels}), + yaxis: Object.assign({}, state.layout.yaxis, {rangemode: yMode()}) + }); + return {data: data, layout: layout, shown: shown}; + } + function draw(state) { + state.queued = false; + if (!state.visible) return; + const mode = yMode(); + if (state.plotted && state.drawnVersion === dataVersion) { + if (state.drawnYMode !== mode) { + state.drawnYMode = mode; + Plotly.relayout(state.el, {'yaxis.rangemode': mode, 'yaxis.autorange': true}); + } + return; + } + const plot = buildPlot(state); + state.el.setAttribute('data-shown-master', String(plot.shown)); + if (state.plotted) { + Plotly.react(state.el, plot.data, plot.layout, config); + } else { + Plotly.newPlot(state.el, plot.data, plot.layout, config); + } + state.plotted = true; + state.drawnVersion = dataVersion; + state.drawnYMode = mode; + syncLegendUI(state.el); + } + // Draw queued charts in animation frames with a time budget, so the page + // stays responsive while several charts come into view at once. + function scheduleDraw(state) { + if (state.queued) return; + state.queued = true; + drawQueue.push(state); + if (!drawScheduled) { + drawScheduled = true; + requestAnimationFrame(drainDrawQueue); + } + } + function drainDrawQueue() { + drawScheduled = false; + const deadline = performance.now() + 30; + while (drawQueue.length && performance.now() < deadline) draw(drawQueue.shift()); + if (drawQueue.length) { + drawScheduled = true; + requestAnimationFrame(drainDrawQueue); + } + } + function refreshVisiblePlots() { + charts.forEach((state) => { + if (state.visible) scheduleDraw(state); }); } + function loadMaster(count) { + const token = ++fetchToken; + setStatus('Loading ' + count + ' master commits...'); + fetch(fetchUrl + '?limit=' + count, {headers: {Accept: 'application/json'}}) + .then((response) => { + if (!response.ok) throw new Error('HTTP ' + response.status); + return response.json(); + }) + .then((result) => { + if (token !== fetchToken) return; + masterLabels = result.masterLabels || []; + masterSeries = new Map(result.master || []); + masterExhausted = masterLabels.length < count; + setStatus(''); + dataVersion++; + refreshVisiblePlots(); + }) + .catch((err) => { + if (token === fetchToken) setStatus('Could not load master commits: ' + err.message); + }); + } + function onMasterChange() { + const count = masterShow(); + if (fetchUrl && !masterExhausted && count > masterLabels.length) { + loadMaster(count); + return; + } + dataVersion++; + refreshVisiblePlots(); + } function isolateTrace(chartEl, onlyIdx) { - const count = (chartEl.data && chartEl.data.length) || 0; - const vis = ensureVisibility(chartEl.id, count); + const state = charts.get(chartEl.id); + if (!state) return; + const vis = ensureVisibility(chartEl.id, state.traces.length); for (let i = 0; i < vis.length; i++) vis[i] = i === onlyIdx; applyVisibility(chartEl); } @@ -307,76 +490,61 @@ plotControlsScript = 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); + const state = charts.get(chartEl.id); + if (!state) return; + const vis = ensureVisibility(chartEl.id, state.traces.length); vis[traceIdx] = !vis[traceIdx]; applyVisibility(chartEl); }, 280)); } }); + // Charts hidden by the search box never intersect, so they are not drawn. + const observer = new IntersectionObserver((entries) => { + entries.forEach((entry) => { + const state = charts.get(entry.target.id); + if (!state) return; + state.visible = entry.isIntersecting; + if (state.visible) scheduleDraw(state); + }); + }, {rootMargin: '400px 0px'}); + charts.forEach((state) => observer.observe(state.el)); if (search) search.addEventListener('input', applySearch); - if (masterSelect) masterSelect.addEventListener('change', redrawPlots); - if (startYAtZero) startYAtZero.addEventListener('change', redrawPlots); + if (masterSelect) masterSelect.addEventListener('change', onMasterChange); + if (startYAtZero) startYAtZero.addEventListener('change', refreshVisiblePlots); applySearch(); - redrawPlots(); })(); |] -makePlotlyConfig :: - Prim.MetricLabel -> - [Text] -> - [(Set Prim.GeneralFactor, [Value], [Value])] -> - (Value, Value) -makePlotlyConfig metricName labels dataSets = - (toJSON traces, layout) - where - traces = - [ object - [ "x" .= labels, - "y" .= series, - "type" .= ("scatter" :: Text), - "mode" .= ("lines+markers" :: Text), - "name" .= factorsSmall factors, - "line" .= object ["color" .= color, "width" .= (2 :: Int)], - "marker" .= object ["size" .= (7 :: Int), "color" .= color], - "error_y" - .= object - [ "type" .= ("data" :: Text), - "array" .= errors, - "visible" .= True - ] - ] - | ((factors, series, errors), color) <- zip dataSets $ cycle plotColors - ] - layout = - object - [ "title" - .= object - [ "text" .= metricText metricName, - "font" .= object ["family" .= ("monospace" :: Text), "size" .= (16 :: Int)] - ], - "xaxis" - .= object - [ "title" .= ("" :: Text), - "type" .= ("category" :: Text), - "categoryorder" .= ("array" :: Text), - "categoryarray" .= labels, - "tickangle" .= (-30 :: Int), - "automargin" .= True, - "tickfont" .= object ["family" .= ("monospace" :: Text), "color" .= ("#111111" :: Text)] - ], - "yaxis" - .= object - [ "title" .= metricText metricName, - "rangemode" .= ("tozero" :: Text), - "automargin" .= True, - "tickfont" .= object ["family" .= ("monospace" :: Text)] - ], - "font" .= object ["family" .= ("monospace" :: Text)], - "hovermode" .= ("x unified" :: Text), - "showlegend" .= False, - "margin" .= object ["t" .= (40 :: Int), "b" .= (56 :: Int), "l" .= (64 :: Int), "r" .= (40 :: Int)] - ] +-- | The script fills in @xaxis.categoryarray@ and @yaxis.rangemode@ from the +-- controls. +plotLayout :: Prim.MetricLabel -> Value +plotLayout metricName = + object + [ "title" + .= object + [ "text" .= metricText metricName, + "font" .= object ["family" .= ("monospace" :: Text), "size" .= (16 :: Int)] + ], + "xaxis" + .= object + [ "title" .= ("" :: Text), + "type" .= ("category" :: Text), + "categoryorder" .= ("array" :: Text), + "tickangle" .= (-30 :: Int), + "automargin" .= True, + "tickfont" .= object ["family" .= ("monospace" :: Text), "color" .= ("#111111" :: Text)] + ], + "yaxis" + .= object + [ "title" .= metricText metricName, + "automargin" .= True, + "tickfont" .= object ["family" .= ("monospace" :: Text)] + ], + "font" .= object ["family" .= ("monospace" :: Text)], + "hovermode" .= ("x unified" :: Text), + "showlegend" .= False, + "margin" .= object ["t" .= (40 :: Int), "b" .= (56 :: Int), "l" .= (64 :: Int), "r" .= (40 :: Int)] + ] plotColors :: [Text] plotColors = T.words "#4394E5 #87BB62 #876FD4 #F5921B #1f77b4 #ff7f0e #2ca02c #d62728" diff --git a/src/Perf/Web/Routes.hs b/src/Perf/Web/Routes.hs index 86fc9b3..72463ef 100644 --- a/src/Perf/Web/Routes.hs +++ b/src/Perf/Web/Routes.hs @@ -57,23 +57,29 @@ getBranchR name = do mmaxGraph <- fmap (>>= (RIO.readMaybe @Int . T.unpack)) $ lookupGetParam "limit" let maxGraph :: Int = fromMaybe 28 $ mmaxGraph isMaster = name == "master" - let masterLimit = if isMaster then maxMasterCommits else maxMasterCommitsOnBranch - mplotData <- db $ loadBranchPlotData name maxGraph masterLimit + -- The plots start with the default master window; the page fetches more + -- from MasterSeriesR when asked. + mplotData <- db $ loadBranchPlotData name maxGraph (defaultMasterShown isMaster) + tableCommits <- + if isMaster + then db $ loadBranchCommits "master" maxMasterCommits + else pure $ maybe [] (.tableCommitEntities) mplotData lucid do + url <- asks (.url) defaultLayout_ branch.branchName do for_ mplotData \plotData -> generalizeHtmlT $ generateCommitPlotsWith (MasterComparisonEnabled plotData.masterCommits) + (Just (url MasterSeriesR)) plotData.branchCommits plotData.benchmarks h1_ "Commits" table_ do - let commitsNewestFirst = maybe [] (reverse . (.tableCommitEntities)) mplotData + let commitsNewestFirst = reverse tableCommits 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 td_ $ small_ $ @@ -241,6 +247,18 @@ getBranchCommitR branch hash = do Nothing -> notFound Just {} -> getCommitR hash +-- | The most recent @?limit=N@ master commits as plot series, for branch pages +-- that show more master commits than they were rendered with. +getMasterSeriesR :: Handler Value +getMasterSeriesR = do + mlimit <- fmap (>>= (RIO.readMaybe @Int . T.unpack)) $ lookupGetParam "limit" + let limit = max 1 $ min maxMasterCommits $ fromMaybe (defaultMasterShown True) mlimit + (commits, benchmarks) <- db do + entities <- loadBranchCommits "master" limit + benchmarks <- maybe (pure Map.empty) materializeCommits $ NonEmpty.nonEmpty entities + pure (map entityVal entities, benchmarks) + pure $ masterSeriesJson commits benchmarks + postReceiverR :: Handler () postReceiverR = do token <- fmap (.token) getYesod