gipeda 0.1.0.2 → 0.1.1
raw patch · 17 files changed
+934/−161 lines, 17 filesdep +conduit-combinatorsdep +extradep +gitlibdep ~aeson
Dependencies added: conduit-combinators, extra, gitlib, gitlib-libgit2, scientific, tagged
Dependency ranges changed: aeson
Files
- README.md +33/−6
- gipeda.cabal +17/−6
- install-jslibs.sh +10/−2
- site/index.html +222/−22
- site/js/gipeda.js +261/−20
- src/BenchmarkSettings.hs +11/−6
- src/Data/Text/Binary.hs +19/−0
- src/Development/Shake/Gitlib.hs +112/−0
- src/GraphReport.hs +15/−10
- src/GraphSummaries.hs +34/−0
- src/IndexReport.hs +0/−19
- src/JsonSettings.hs +5/−17
- src/ReadResult.hs +4/−3
- src/ReportTypes.hs +51/−8
- src/RevReport.hs +2/−2
- src/Shake.hs +129/−37
- src/gipeda.hs +9/−3
README.md view
@@ -4,7 +4,7 @@ What is gipeda? --------------- -Gitpeda is a a tool that presents data from your program’s benchmark suite (or+Gipeda is a a tool that presents data from your program’s benchmark suite (or any other source), with nice tables and shiny graphs. @@ -22,17 +22,21 @@ Do you want to see it live? Check out these: - * [Demo page], visualizing fairly boring stuff about gipedia itself.+ * [Demo page], visualizing fairly boring stuff about gipeda itself. * [GHC’s gipeda installation]. -[Demo page]: http://nomeata.github.io/gipeda/-[GHC’s gipeda installation]: https://perf.haskell.org/+[Demo page]: http://perf.haskell.org/gipeda+[GHC’s gipeda installation]: https://perf.haskell.org/ghc Setting it up ------------- - * Clone gipedia somewhere, possibly directly into your webspace.+ * Clone gipeda somewhere, possibly directly into your webspace. * Install a Haskell compiler, including the `cablal` tool.+ * Install a few packages++ apt-get install git unzip libfile-slurp-perl libipc-run-perl+ * Install the dependencies: cabal install --only-dependencies@@ -83,7 +87,7 @@ pull` or, if it is a bare clone, `git -C repository fetch origin "+refs/heads/*:refs/heads/*" --prune`. -Using gipedia+Using gipeda ------------- Finally, you simply point your browser to the `site/index.html`. The page@@ -92,6 +96,29 @@ the `=`. To host this on a webserver, just put the `site/` directory in your webspace.++Hacking on gipeda+-----------------++Gipeda doesn't do much; it mostly assembles the data and creates nice reports.+The rough pipeline is as follows:++ * Directory `logs/` contains project-specific data per git commit that has+ been benchmarked. gipeda will run `log2csv` on these files to generate the+ files in `site/out/results`. `logs` may be a normal directory, or (for disk+ space efficiency) a bare git repository. This step is optional.+ * Directory `site/out/results` contains one csv file per git commit. The+ format is simple, as there are two columns: benchmark name and a numerical+ value.+ * From these files, gipeda generates a number of JSON files, some per commit+ (`report`, `summaries`), some global (`settings`, `latest-summaries`).++ A crucial idea here is that these JSON files are all but fragments of a+ theoretical global JSON document. In other words: You could combine them+ (using a naive JSON object merge) and there would be no conflicts, and the+ result could be used by the client as well.+ * The client (`site/index.html` and `site/js/gipeda.js`) is a fairly standard+ HTML+JS application using jquery, bootstrap, handlebars. Bugs, Code, Contact -------------------
gipeda.cabal view
@@ -1,9 +1,9 @@ name: gipeda-version: 0.1.0.2+version: 0.1.1 category: Development synopsis: Git Performance Dashboard description:- Gitpeda is a a tool that presents data from your program’s benchmark suite+ Gipeda is a a tool that presents data from your program’s benchmark suite (or any other source), with nice tables and shiny graphs. . So it is up to you whether you have a polling shell script loop, a post-commit@@ -46,7 +46,6 @@ BenchmarksInCSV, BenchNames, GraphReport,- IndexReport, JsonSettings, JsonUtils, ParentMap,@@ -56,8 +55,12 @@ RevReport, Shake, Summary,- WithLatestLogs+ GraphSummaries,+ WithLatestLogs,+ Development.Shake.Gitlib,+ Data.Text.Binary + build-depends: base >= 4.6 && <4.9, bytestring >= 0.10 && <0.11,@@ -71,12 +74,20 @@ vector >= 0.10 && <0.11, cassava >= 0.4 && <0.5, yaml >= 0.8 && <0.9,- aeson >= 0.7 && <0.9+ aeson >= 0.7 && <0.10,+ scientific >= 0.3 && <0.4,+ gitlib >= 3.1 && <3.2,+ gitlib-libgit2,+ tagged >= 0.7 && <0.9,+ extra >= 1 && <1.2, + -- https://github.com/jwiegley/gitlib/issues/46+ conduit-combinators < 1+ hs-source-dirs: src default-language: Haskell2010 source-repository head type: git- location: https://github.com/nomeat/gipeda+ location: https://github.com/nomeata/gipeda
install-jslibs.sh view
@@ -12,6 +12,12 @@ wget -c http://builds.handlebarsjs.com.s3.amazonaws.com/handlebars-v2.0.0.js test -e jquery-1.11.2.min.js || wget -c http://code.jquery.com/jquery-1.11.2.min.js+test -d jquery-ui || {+ wget -c http://jqueryui.com/resources/download/jquery-ui-1.11.4.zip+ unzip jquery-ui-1.11.4.zip+ mv jquery-ui-1.11.4 jquery-ui+ rm -f jquery-ui-1.11.4.zip+ } test -e jquery.timeago.js || wget -c http://timeago.yarp.com/jquery.timeago.js test -d flot || {@@ -23,7 +29,9 @@ mkdir bootstrap cd bootstrap wget -c https://github.com/twbs/bootstrap/releases/download/v3.3.1/bootstrap-3.3.1-dist.zip- unzip bootstrap-3.3.1-dist.zip - rm -f bootstrap-3.3.1-dist.zip + unzip bootstrap-3.3.1-dist.zip+ rm -f bootstrap-3.3.1-dist.zip cd .. }+test -e naturalSort.j ||+ wget -c https://raw.githubusercontent.com/overset/javascript-natural-sort/master/naturalSort.js
site/index.html view
@@ -11,6 +11,9 @@ <script type="text/javascript" src="js/handlebars-v2.0.0.js"></script> <script src="js/jquery-1.11.2.min.js"></script> <script src="js/jquery.timeago.js"></script>+<script src="js/jquery-ui/jquery-ui.min.js"></script>+<script src="js/naturalSort.js"></script>+<link rel="stylesheet" href="js/jquery-ui/jquery-ui.min.css"> <script src="js/flot/jquery.flot.min.js"></script> <script src="js/flot/jquery.flot.resize.min.js"></script>@@ -57,7 +60,7 @@ border-collapse:collapse; }-.summary-row-collapsed + .summary-row td {+.summary-table .summary-row-collapsed + .summary-row td { border-top: 4px dotted #DDD; }@@ -110,18 +113,24 @@ <div class="navbar-header pull-right"> <p class="navbar-text nav-loading pull-left">Loading data...</p> + <div class="navbar-text nav-compare" role="group">+ <a id="go-to-compare" href="#" class="navbar-link">+ <code>+ <span title="Drop a revision id to compare two revisions" id="compare-from">???????</span>..<span title="Drop a revision id to compare two revisions" id="compare-to">???????</span>+ </code>+ </a>+ </div>+ <ul class="nav pull-left"> <li class="pull-left"> <div class="btn-group" role="group"> <button type="button" class="btn btn-default navbar-btn active benchSelector" id="show-improvements" title="Show improvements">- <!-- <span class="glyphicon glyphicon-plus text-success"></span> --> <span class="text-success" style="font-weight:bold">+</span> </button> <button type="button" class="btn btn-default navbar-btn benchSelector" id="show-boring" title="Show unchanged"> <span style="font-weight:bold">=</span> </button> <button type="button" class="btn btn-default navbar-btn active benchSelector" id="show-regressions" title="Show regressions">- <!-- <span class="glyphicon glyphicon-minus text-warning"></span> --> <span class="text-warning" style="font-weight:bold">-</span> </button> </div>@@ -147,19 +156,26 @@ </nav> </script> +<script id="rev-id" type="text/x-handlebars-template">+ <code data-rev="{{hash}}" class="rev-draggable">{{shortRev hash}}</code>+</script>++ <script id="summary-icons" type="text/x-handlebars-template">- <span title="number of benchmarks">+ <span title="{{id summaryDesc}}">+ <span> {{totalCount}} <span class="glyphicon glyphicon-stats"></span> </span>- <span title="number of improvements"> + <span> {{improvementCount}} <span class="glyphicon glyphicon-plus text-success"></span> </span>- <span title="number of regressions">+ <span> {{regressionCount}} <span class="glyphicon glyphicon-minus text-warning"></span> </span>+ </span> </script> <script id="summary-list" type="text/x-handlebars-template">@@ -178,7 +194,7 @@ </td> <td class="col-md-1"> <a href="{{revisionLink hash}}">- <code>{{shortRev hash}}</code>+ {{> rev-id hash=hash}} </a> </td> <td class="col-md-7">@@ -193,8 +209,53 @@ </table> </script> +<script id="tags" type="text/x-handlebars-template">+ <h2>Tags</h2>+ <table class="table tag-table">+ {{#each_unnaturally tags}}+ {{#with (lookup ../revisions this)}}+ {{#with this.summary}}+ <tr class="tag-row">+ <td class="col-md-2 text-right">+ <abbrv class="timeago" title="{{ iso8601 this.gitDate }}">{{ humanDate this.gitDate}}</abbrv>+ </td>+ <td class="col-md-1">+ <a href="{{revisionLink hash}}">+ {{> rev-id hash=hash}}+ </a>+ </td>+ <td class="col-md-2">+ <strong>{{ @key }}</strong>+ </td>+ <td class="col-md-7">+ {{ gitSubject }}+ </td>+ </tr>+ {{/with}}+ {{else}}+ <tr+ title="This tag has not been benchmarked yet"+ class="tag-row">+ <td class="col-md-2 text-right">+ </td>+ <td class="col-md-1">+ {{> rev-id hash=this}}+ </td>+ <td class="col-md-2">+ {{ @key }}+ </td>+ <td class="col-md-7 text-right">+ </td>+ </tr>+ {{/with}}+ {{/each_unnaturally}}+ </table>+</script>+ <script id="revTooltip" type="text/x-handlebars-template">- <a href="{{revisionLink hash}}"><code>{{shortRev hash}}</code></a>:+ <a href="{{revisionLink hash}}">+ {{> rev-id hash=hash}}+ </a>: {{ value }}<br/> {{ humanDate gitDate}}<br/> {{ gitSubject }}</br>@@ -207,9 +268,10 @@ <h1>Benchmarks</h1> </div> <div class="container">+ {{> nothing }} <div class="panel-group" role="tablist"> {{#each benchGroups}}- <div class="panel panel-default">+ <div class="panel panel-default graph-list-panel"> <div class="panel-heading" role="tab" id="heading-{{@index}}"> <h4 class="panel-title"> <a class="accordion-toggle" data-toggle="collapse" href="#table-{{@index}}">@@ -228,13 +290,32 @@ </thead> <tbody> {{#each groupMembers}}- <tr>- <td class="benchmark-name">- {{this}}- <a class="graph-link" title="Graphs" href="{{graphLink this}}">- <span class="glyphicon glyphicon-signal"/>- </a>- </td>+ <tr class="+ summary-row+ {{#with (lookup ../../graphSummaries this)}}+ {{#if improvements}}summary-improvement{{/if}}+ {{#if regressions}}summary-regression{{/if}}+ {{/with}}+ "+ >+ <td class="benchmark-name">+ {{this}}+ <a class="graph-link" title="Graphs" href="{{graphLink this}}">+ <span class="glyphicon glyphicon-signal"/>+ </a>+ </td>+ <td class="col-md-2 text-right">+ {{#with (lookup ../../graphSummaries this)}}+ <span>+ {{improvements}}+ <span class="glyphicon glyphicon-plus text-success"></span>+ </span>+ <span>+ {{regressions}}+ <span class="glyphicon glyphicon-minus text-warning"></span>+ </span>+ {{/with}}+ </td> </tr> {{/each}} </tbody>@@ -252,6 +333,7 @@ <div class="container"> <h1>Recent commits</h1> {{> summary-list (recentCommits revisions)}}+ {{> tags }} </div> <div class="container"> <p class="text-center">@@ -265,6 +347,7 @@ <div class="container"> <h1>All commits</h1> {{> summary-list (allCommits revisions)}}+ {{> tags }} </div> </script> @@ -281,12 +364,16 @@ </h2> <p> {{#if rev.summary.parents}}- Displaying changes since: + Displaying changes since: {{#with (lookup rev.summary.parents 0)}}- <a href="{{revisionLink this}}"><code>{{shortRev this}}</code></a> – + <a href="{{revisionLink this}}">+ {{> rev-id hash=this}}+ </a> – <a href="{{diffLink this ../rev.summary.hash}}">View diff</a> {{/with}} –- <a href="{{logLink rev.summary.hash}}">View buildlog</a> –+ {{#logLink rev.summary.hash }}+ <a href="{{link}}">View buildlog</a> –+ {{/logLink}} {{> summary-icons rev.summary.stats }} {{else}} No parent commit found.@@ -319,10 +406,11 @@ <table class="table table-condensed benchmark-table"> <thead> <tr>- <th class="col-md-6">Benchmark name</th>+ <th class="col-md-5">Benchmark name</th> <th class="col-md-2 text-right">previous</th>- <th class="col-md-2 text-right"></th>- <th class="col-md-2 text-right">value</th>+ <th class="col-md-2 text-right">change</th>+ <th class="col-md-2 text-right">now</th>+ <th class="col-md-1 text-left"></th> </tr> </thead> <tbody>@@ -337,6 +425,7 @@ <td class="text-right">{{previous}}</td> <td class="text-right">{{change}}</td> <td class="text-right">{{value}}</td>+ <td class="text-left">{{unit}}</td> </tr> {{/each}} </tbody>@@ -357,6 +446,117 @@ <h2>{{benchName}}</h2> <div id="benchChart" style="width:100%; height:400px">+ </div>++</script>++<script id="compare" type="text/x-handlebars-template">+ {{> nav}}++ <div class="container">+ <div class="row">+ <div class="col-md-6 col-md-push-6">+ {{#if rev1.summary}}{{#if rev2.summary}}+ <h2>+ Comparing+ {{> rev-id hash=rev1.summary.hash}}..{{> rev-id hash=rev2.summary.hash}}+ </h2>+ <p>+ Parents:+ {{#each rev1.summary.parents}}+ <a href="{{compareLink this ../rev2.summary.hash}}">{{shortRev this}}</a>+ {{/each}}</br>+ <a href="{{revisionLink rev1.summary.hash}}">{{> rev-id hash=rev1.summary.hash}}</a> <abbrv class="timeago" title="{{ iso8601 gitDate }}">{{ humanDate rev1.summary.gitDate}}</abbrv>:<br/>+ <strong>{{ rev1.summary.gitSubject }}</strong><br/>+ {{#logLink rev1.summary.hash }}+ <a href="{{link}}">buildlog</a>+ {{/logLink}}+ </p>+ <p class="text-center">+ ⁞<br/>+ <a href="{{diffLink rev1.summary.hash rev2.summary.hash}}">View diff</a><br/>+ ⁞+ </p>+ <p>+ Parents:+ {{#each rev2.summary.parents}}+ <a href="{{compareLink ../rev1.summary.hash this}}">{{shortRev this}}</a>+ {{/each}}</br>+ <a href="{{revisionLink rev2.summary.hash}}">{{> rev-id hash=rev2.summary.hash}}</a> <abbrv class="timeago" title="{{ iso8601 gitDate }}">{{ humanDate rev2.summary.gitDate}}</abbrv>:<br/>+ <strong>{{ rev2.summary.gitSubject }}</strong><br/>+ {{#logLink rev2.summary.hash }}+ <a href="{{link}}">buildlog</a>+ {{/logLink}}+ </p>+ {{/if}} {{/if}}+ </div>++ <div class="col-md-6 col-md-pull-6">+ {{> nothing }}+ <div class="panel-group" role="tablist">+ {{#each groups}}+ <div class="panel panel-default bench-panel">+ <div class="panel-heading" role="tab" id="heading-{{@index}}">+ <h4 class="panel-title">+ <a class="accordion-toggle" data-toggle="collapse" href="#table-{{@index}}">+ {{groupName}}+ <span class="stats pull-right">+ {{> summary-icons groupStats}}+ <span class="indicator-toggled glyphicon glyphicon-chevron-down text-grey"/>+ <span class="indicator-untoggled glyphicon glyphicon-chevron-right text-grey"/>+ </span>+ </a>+ </h4>+ </div>++ <div id="table-{{@index}}" class="panel-collapse collapse in" role="tabpanel">+ <div class="panel-body">+ <table class="table table-condensed benchmark-table">+ <thead>+ <tr>+ <th class="col-md-5">Benchmark name</th>+ <th class="col-md-2 text-right">previous</th>+ <th class="col-md-2 text-right">change</th>+ <th class="col-md-2 text-right">now</th>+ <th class="col-md-1 text-right"></th>+ </tr>+ </thead>+ <tbody>+ {{#each benchResults}}+ <tr class="row-result row-{{changeType}}">+ <td class="benchmark-name">+ {{name}}+ <a class="graph-link" title="Graphs" href="{{graphLink name ../../rev1.summary.hash ../../rev2.summary.hash}}">+ <span class="glyphicon glyphicon-signal"/>+ </a>+ </td>+ <td class="text-right">{{previous}}</td>+ <td class="text-right">{{change}}</td>+ <td class="text-right">{{value}}</td>+ <td class="text-left">{{unit}}</td>+ </tr>+ {{/each}}+ </tbody>+ </table>+ </div>+ </div> + </div>+ {{/each}}+ </div>+ </div>+ </div>+</script>++<script id="graph" type="text/x-handlebars-template">+ {{> nav}}++ <div class="container">+ <h2>{{benchName}}</h2>++ <div id="benchChart" style="width:100%; height:400px">+ </div>++ <p><button id="loadMore">Load older revisions</button></p> </div> </script>
site/js/gipeda.js view
@@ -12,7 +12,11 @@ boring: false, regressions: true, },- collapsedGroups: [true, false, false, false]+ collapsedGroups: [true, false, false, false],+ compare: {+ from: null,+ to: null,+ } }; // Signals@@ -24,7 +28,7 @@ // Routes var routes = {- index: + index: { regex: /^$/, download: ['out/latest-summaries.json'], url: function () {return ""},@@ -36,7 +40,7 @@ }, graphIndex: { regex: /^graphs$/,- download: ['out/benchNames.json'],+ download: ['out/benchNames.json', 'out/graph-summaries.json'], url: function () {return "graphs"}, }, revision:@@ -47,6 +51,17 @@ }, url: function (hash) { return "revision/" + hash; }, },+ compare:+ { regex: /^compare\/([a-f0-9]+)\/([a-f0-9]+)$/,+ viewData: function (match) { return { hash1: match[1], hash2: match[2] }; },+ download: function () {+ return ['out/benchNames.json',+ 'out/reports/' + viewData.hash1 + '.json',+ 'out/reports/' + viewData.hash2 + '.json'+ ];+ },+ url: function (hash1, hash2) { return "compare/" + hash1 + "/" + hash2; },+ }, graph: { regex: /^graph\/(.*)$/, viewData: function (match, options) {@@ -129,13 +144,13 @@ var templates = {}; $(function () {- var template_ids = ["revision", "index", "complete", "graphIndex", "graph", "revTooltip"];+ var template_ids = ["revision", "compare", "index", "complete", "graphIndex", "graph", "revTooltip"]; template_ids.forEach(function(id) { var source = $("#" + id).html(); templates[id] = Handlebars.compile(source); }); - var partials_ids = ["nav", "summary-icons", "summary-list", "nothing"];+ var partials_ids = ["nav", "summary-icons", "summary-list", "rev-id", "nothing", "tags"]; partials_ids.forEach(function(id) { var source = $("#" + id).html(); Handlebars.registerPartial(id, source);@@ -147,18 +162,26 @@ if (!hash) { return "#"; } return "#" + routes.revision.url(hash); });-Handlebars.registerHelper('graphLink', function(benchName, hl) {- if (hl) {- return "#" + routes.graph.url(benchName,[hl]);- } else {- return "#" + routes.graph.url(benchName);- }+Handlebars.registerHelper('compareLink', function(hash1,hash2) {+ if (!hash1) { return "#"; }+ if (!hash2) { return "#"; }+ return "#" + routes.compare.url(hash1,hash2); });+Handlebars.registerHelper('graphLink', function(benchName, hl1, hl2) {+ hls = [];+ if (hl1 && typeof(hl1) == 'string') {hls.push(hl1)};+ if (hl2 && typeof(hl2) == 'string') {hls.push(hl2)};+ return "#" + routes.graph.url(benchName,hls);+}); Handlebars.registerHelper('diffLink', function(rev1, rev2) {- return data.settings.cgitLink + "/commitdiff/" + rev2+ return Handlebars.compile(data.settings.diffLink)({base: rev1, rev: rev2}); });-Handlebars.registerHelper('logLink', function(rev) {- return Handlebars.compile(data.settings.logLink)({rev:rev});+Handlebars.registerHelper('logLink', function(rev, options) {+ if (data.settings.logLink) {+ var link = Handlebars.compile(data.settings.logLink)({rev: rev});+ $.extend(this,{link:link});+ return options.fn(this);+ } }); Handlebars.registerHelper('indexLink', function() { return "#" + routes.index.url();@@ -180,16 +203,48 @@ return rev.substr(0,7); } Handlebars.registerHelper('shortRev', shortRev);+Handlebars.registerHelper('id', function (text) {+ if (text) {+ lines = text.split(/\r?\n/);+ return new Handlebars.SafeString(lines.map(Handlebars.escapeExpression).join(' '))+ }+}); Handlebars.registerHelper('iso8601', function(timestamp) { if (!timestamp) { return '' };- return new Date(timestamp*1000).toISOString(); + return new Date(timestamp*1000).toISOString(); }); Handlebars.registerHelper('humanDate', function(timestamp) { return new Date(timestamp*1000).toString(); });+// inspired by http://stackoverflow.com/a/17935019/946226+Handlebars.registerHelper('each_naturally', function(context,options){+ var output = '';+ if (context) {+ console.log(context);+ var keys = jQuery.map(context, function(v,k) {return k});+ var sorted_keys = keys.sort(naturalSort);+ sorted_keys.map(function (k,i) {+ output += options.fn(context[k], {data: {key: k, index: i}});+ });+ }+ return output;+});+Handlebars.registerHelper('each_unnaturally', function(context,options){+ var output = '';+ if (context) {+ console.log(context);+ var keys = jQuery.map(context, function(v,k) {return k});+ var sorted_keys = keys.sort(naturalSort).reverse();+ sorted_keys.map(function (k,i) {+ output += options.fn(context[k], {data: {key: k, index: i}});+ });+ }+ return output;+}); // We cache everything var jsonSeen = {};+var jsonFetching = {}; function getJSON(url, callback, options) { var opts = { block: true,@@ -198,16 +253,25 @@ if (jsonSeen[url]) { console.log("Not fetching "+url+" again."); if (callback) callback();+ } else if (jsonFetching[url]) {+ console.log("Already fetching "+url+".");+ if (callback) jsonFetching[url].push(callback); } else { console.log("Fetching "+url+".");+ jsonFetching[url] = [];+ if (callback) jsonFetching[url].push(callback); $.ajax(url, { success: function (newdata) { console.log("Fetched "+url+"."); jsonSeen[url] = true; $.extend(true, data, newdata); dataChanged.dispatch();- if (callback) callback();+ $.each(jsonFetching[url], function (i,c) {c()});+ delete jsonFetching[url]; },+ error: function (e) {+ console.log("Failure fetching "+url,e);+ }, cache: false, dataType: 'json', });@@ -225,6 +289,102 @@ } } +function benchmark_name_matches(pattern, name) {+ if (pattern[pattern.length-1] == "*") {+ return pattern.substr(0, pattern.length-1) == name.substr(0, pattern.length-1);+ } else {+ return pattern == name;+ }+}++// The following logic should be kept in sync with BenchmarkSettings.hs+function setting_for(name) {+ var benchSettings = {+ smallerIsBetter: true,+ unit: "",+ type: "integral",+ group: "",+ threshold: 3,+ important: true+ };++ data.settings.benchmarks.map(function (s) {+ if (benchmark_name_matches(s.match, name)) {+ $.extend(benchSettings, s);+ }+ })++ return benchSettings;+}+++// The following logic should be kept in sync with toResult in ReportTypes.hs+function compareResults (res1, res2) {+ if (!res1 && !res2) { return };++ name = res1? res1.name : res2.name;+ s = setting_for(name);++ res = {+ name: name,+ previous: res1 ? res1.value : null,+ value: res2 ? res2.value : null,+ unit: s.unit,+ important: s.important,+ changeType: "Boring",+ change: "foobar",+ };++ if (res1 && res2){+ if (s.type == "integral" || s.type == "float"){+ if (res1.value == 0 && res2.value == 0) {+ res.change = "=";+ } else if (res1.value == 0) {+ res.change = "+ ∞";+ res.changeType = "Improvement";+ } else {+ var perc = 100.0 * (res2.value - res1.value) / res1.value;+ var percS = Math.round (perc * 100.0) / 100;+ if (Math.abs(perc) < 0.01) {+ res.change = "=";+ } else if (perc >= 0) {+ res.change = "+ " + percS + "%";+ } else {+ res.change = "- " + (-percS) + "%";+ }++ if (Math.abs(perc) >= s.threshold) {+ if (perc >= 0) {+ s.changeType = "Improvement";+ } else {+ s.changeType = "Regression";+ }+ }+ }+ } else if (s.type == "small integral") {+ if (res1.value == res2.value) {+ res.change = "=";+ } else if (res2.value > res1.value) {+ res.change = "+" + (res2.value - res1.value);+ res.changeType = "Improvement";+ } else if (res1.value > res2.value) {+ res.change = "-" + (res1.value - res2.value);+ res.changeType = "Regression";+ }+ }++ if (s.smallerIsBetter) {+ if (res.changeType == "Improvement") {+ res.changeType = "Regression";+ } else if (res.changeType == "Regression") {+ res.changeType = "Improvement";+ }+ }+ }++ return res;+}+ // Some views require the data to be prepared in ways that are // too complicated for the template, so lets do it here. dataViewPrepare = {@@ -250,8 +410,64 @@ groups : groups, }; },+ 'compare': function (data, viewData) {+ if (!data.benchGroups || !data.revisions) return {};+ var hash1 = viewData.hash1;+ var hash2 = viewData.hash2;+ var rev1 = data.revisions[hash1];+ var rev2 = data.revisions[hash2];+ if (!rev1) return {};+ if (!rev1.benchResults) return {};+ if (!rev2) return {};+ if (!rev2.benchResults) return {};++ var groups = data.benchGroups.map(function (group) {+ var benchmarks = group.groupMembers.map(function (bn) {+ var r1 = rev1.benchResults[bn];+ var r2 = rev2.benchResults[bn];+ return compareResults(r1,r2);+ }).filter(function (br) {return br});+ return {+ groupName: group.groupName,+ benchResults: benchmarks,+ groupStats: groupStats(benchmarks),+ };+ });+ return {+ rev1 : rev1,+ rev2 : rev2,+ groups : groups,+ };+ }, } +function remember_from_to() {+ settings.compare.from = $('#compare-from').data('rev');+ settings.compare.to = $('#compare-to').data('rev');+}++function recall_from_to() {+ if (settings.compare.from) {+ $('#compare-from').data('rev', settings.compare.from);+ $('#compare-from').text(shortRev(settings.compare.from));+ }+ if (settings.compare.to) {+ $('#compare-to').data('rev', settings.compare.to);+ $('#compare-to').text(shortRev(settings.compare.to));+ }+ $('#go-to-compare').attr('href',current_compare_link());+}++function current_compare_link () {+ var rev1 = settings.compare.from;+ var rev2 = settings.compare.to;+ if (rev1 && rev2) {+ return "#" + routes.compare.url(rev1, rev2);+ } else {+ return 'javascript:alert("Please drag two revisions here to compare them")';+ }+}+ function load_template () { console.log('Rebuilding page'); var context = {};@@ -267,15 +483,33 @@ updateCollapsedGroups(); $('abbrv.timeago').timeago(); + // Code to implement the compare-revision-drag'n'drop interface+ $('.rev-draggable').draggable({+ revert: true,+ revertDuration: 0,+ });+ $('#compare-from, #compare-to').droppable({+ accept: ".rev-draggable",+ activeClass: "ui-state-highlight",+ hoverClass: "ui-state-active",+ drop: function( event, ui ) {+ $( this ).text(ui.draggable.text());+ $( this ).data('rev',ui.draggable.data('rev'));+ remember_from_to();+ $('#go-to-compare').attr('href',current_compare_link());+ }+ });+ recall_from_to();+ if ($('#benchChart').length) {- setupChart();+ setupChart(); } } viewChanged.add(load_template); dataChanged.add(load_template); function setupChart () {- + var commits = commitsFrom(data.revisions, data.latest, data.settings.limitRecent); var benchName = viewData.benchName; @@ -355,7 +589,7 @@ if ($("#tooltip").data('rev') != rev) { $("#tooltip")- .html(shortRev(rev))+ .html(shortRev(rev)) .data('rev',rev) .html(templates.revTooltip(tooltipContext)) .fadeIn(200)@@ -435,8 +669,15 @@ $('tr.summary-row.summary-improvement') .removeClass('summary-row-collapsed'); }- $('tr.summary-row').first()+ // Always show first entry in the history+ $('.summary-table tr.summary-row').first() .removeClass('summary-row-collapsed');++ $('.graph-list-panel').show().each(function() {+ if ($(this).has('tr.summary-row:visible').length == 0) {+ $(this).hide();+ }+ }); updateNothingToSee(); };
src/BenchmarkSettings.hs view
@@ -27,12 +27,13 @@ , numberType :: NumberType , group :: String , threshold :: Double+ , important :: Bool } deriving (Show, Generic) instance ToJSON BenchSettings defaultBenchSettings :: BenchSettings-defaultBenchSettings = BenchSettings True "" IntegralNT "" 3+defaultBenchSettings = BenchSettings True "" IntegralNT "" 3 True newtype S = S { unS :: BenchName -> BenchSettings } newtype SM = SM (BenchName -> (BenchSettings -> BenchSettings))@@ -62,13 +63,15 @@ mg <- o .:? "group" ms <- o .:? "smallerIsBetter" mth <- o .:? "threshold"- return $ SM $ \n b -> + mi <- o .:? "important"+ return $ SM $ \n b -> if n `matches` m then b { numberType = fromMaybe (numberType b) mt , unit = fromMaybe (unit b) mu , group = fromMaybe (group b) mg , smallerIsBetter = fromMaybe (smallerIsBetter b) ms , threshold = fromMaybe (threshold b) mth+ , important = fromMaybe (important b) mi } else b parseJSON _ = mzero@@ -81,20 +84,22 @@ data Settings = Settings { title :: String- , cgitLink :: String- , logLink :: String+ , diffLink :: String+ , logLink :: Maybe String , limitRecent :: Integer , start :: String+ , interestingTags :: Maybe String , benchSettings :: BenchName -> BenchSettings } instance FromJSON Settings where parseJSON (Object v) = Settings <$> v .: "title"- <*> v .: "cgitLink"- <*> v .: "logLink"+ <*> v .: "diffLink"+ <*> v .:? "logLink" <*> v .: "limitRecent" <*> v .: "start"+ <*> v .:? "interestingTags" <*> (unS <$> v.: "benchmarks") parseJSON _ = mzero
+ src/Data/Text/Binary.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE CPP #-}+module Data.Text.Binary where++#if MIN_VERSION_text(1,2,1)+#else++import Development.Shake.Classes++import Data.Text+import Data.Text.Encoding+import Data.Functor++-- I do not want a new dependency just for these, so this is copied from text-binary+instance Binary Text where+ put = put . encodeUtf8+ get = decodeUtf8 <$> get+#endif++
+ src/Development/Shake/Gitlib.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}+module Development.Shake.Gitlib+ ( defaultRuleGitLib+ , getGitReference+ , getGitContents+ , doesGitFileExist+ , readGitFile+ ) where++import System.IO+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Functor+import Data.Maybe+++import Development.Shake+import Development.Shake.Rule+import Development.Shake.Classes++import Data.Text.Binary++import Git+import Git.Libgit2+import Data.Tagged++type RepoPath = FilePath++newtype GetGitReferenceQ = GetGitReferenceQ (RepoPath, RefName)+ deriving (Typeable,Eq,Hashable,Binary,NFData,Show)++newtype GitSHA = GitSHA T.Text+ deriving (Typeable,Eq,Hashable,Binary,NFData,Show)++newtype GetGitFileRefQ = GetGitFileRefQ (RepoPath, RefName, FilePath)+ deriving (Typeable,Eq,Hashable,Binary,NFData,Show)++instance Rule GetGitReferenceQ GitSHA where+ storedValue _ (GetGitReferenceQ (repoPath, name)) = do+ Just . GitSHA <$> getGitReference' repoPath name++instance Rule GetGitFileRefQ (Maybe T.Text) where+ storedValue _ (GetGitFileRefQ (repoPath, name, filename)) = do+ ref' <- getGitReference' repoPath name+ Just <$> getGitFileRef' repoPath ref' filename++getGitReference :: RepoPath -> String -> Action String+getGitReference repoPath refName = do+ GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, T.pack refName)+ return $ T.unpack ref'++getGitContents :: RepoPath -> Action [FilePath]+getGitContents repoPath = do+ GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, "HEAD")+ liftIO $ withRepository lgFactory repoPath $ do+ ref <- parseOid ref'+ commit <- lookupCommit (Tagged ref)+ tree <- lookupTree (commitTree commit)+ entries <- listTreeEntries tree+ return $ map (BS.unpack . fst) entries++-- Will also look through annotated tags+getGitReference' :: RepoPath -> RefName -> IO T.Text+{- This fails (https://github.com/jwiegley/gitlib/issues/49), so use command+ - line git instead.+getGitReference' repoPath refName = do+ withRepository lgFactory repoPath $ do+ Just ref <- resolveReference refName+ o <- lookupObject ref+ r <- case o of+ TagObj t -> do+ return $ renderObjOid $ tagCommit t+ _ -> return $ renderOid ref+ return $ renderOid ref+-}+getGitReference' repoPath refName = do+ T.pack . concat . lines . fromStdout <$> cmd ["git", "-C", repoPath, "rev-parse", T.unpack refName++"^{commit}"]++getGitFileRef' :: RepoPath -> T.Text -> FilePath -> IO (Maybe T.Text)+getGitFileRef' repoPath ref' fn = do+ withRepository lgFactory repoPath $ do+ ref <- parseOid ref'+ commit <- lookupCommit (Tagged ref)+ tree <- lookupTree (commitTree commit)+ entry <- treeEntry tree (BS.pack fn)+ case entry of+ Just (BlobEntry ref _) -> return $ Just $ renderObjOid ref+ _ -> return Nothing++doesGitFileExist :: RepoPath -> FilePath -> Action Bool+doesGitFileExist repoPath fn = do+ res <- apply1 $ GetGitFileRefQ (repoPath, "HEAD", fn)+ return $ isJust (res :: Maybe T.Text)++readGitFile :: FilePath -> FilePath -> Action BS.ByteString+readGitFile repoPath fn = do+ res <- apply1 $ GetGitFileRefQ (repoPath, "HEAD", fn)+ case res of+ Nothing -> fail "readGitFile: File does not exist"+ Just ref' -> liftIO $ withRepository lgFactory repoPath $ do+ ref <- parseOid ref'+ catBlob (Tagged ref)++defaultRuleGitLib :: Rules ()+defaultRuleGitLib = do+ rule $ \(GetGitReferenceQ (repoPath, refName)) -> Just $ liftIO $+ GitSHA <$> getGitReference' repoPath refName+ rule $ \(GetGitFileRefQ (repoPath, refName, fn)) -> Just $ do+ GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, "HEAD")+ liftIO $ getGitFileRef' repoPath ref' fn+
src/GraphReport.hs view
@@ -7,6 +7,8 @@ import qualified Data.Text as T import Data.Aeson import GHC.Generics+import Data.Maybe+import Data.Functor import Paths import ReadResult@@ -18,19 +20,22 @@ settings <- S.readSettings "settings.yaml" g <- forM revs $ \rev -> do- m <- readCSV rev- let v = M.lookup bench m- return $ T.pack rev .= object- [ "benchResults" .= object- [ T.pack bench .= object- [ "value" .= v ]- ]- ]+ json <- BS.readFile (reportOf rev)+ rep <- case eitherDecode json of+ Left e -> fail e+ Right rep -> return rep+ case M.lookup bench (benchResults (rep !!! "revisions" !!! rev)) of+ Nothing -> return Nothing+ Just result -> return $ Just $ T.pack rev .= object+ [ "benchResults" .= object+ [ T.pack bench .= benchResultToGraphPoint result ]+ ] let doc = object- [ "revisions" .= object g+ [ "revisions" .= object (catMaybes g) , "benchmarkSettings" .= object [ T.pack bench .= toJSON (S.benchSettings settings bench) ] ] BS.putStr (encode doc)- + where+ m !!! k = m M.! T.pack k
+ src/GraphSummaries.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+module GraphSummaries where++import qualified Data.ByteString.Lazy as BS+import Data.Aeson+import Data.Aeson.Types+import Control.Monad+import qualified Data.Text as T+import qualified Data.Map as M++import Paths+import JsonUtils+import ReportTypes+import ReadResult++graphSummaries :: [BenchName] -> IO ()+graphSummaries benchNames = do+ g <- forM benchNames $ \bName -> do+ json <- BS.readFile (graphFile bName)+ graph <- case eitherDecode json of+ Left e -> fail e+ Right rep -> return rep+ let gps = either (error.show) id . flip parseEither graph $ \obj -> do+ revs <- obj .: "revisions"+ forM (M.elems (revs :: M.Map T.Text Object)) $ \rev -> do+ results <- rev .: "benchResults"+ result <- results .: T.pack bName+ parseJSON result+ return $ T.pack bName .= object+ [ T.pack "improvements" .= length [ () | gp <- gps, gpChangeType gp == Improvement ]+ , T.pack "regressions" .= length [ () | gp <- gps, gpChangeType gp == Regression]+ ]+ let o = object [ "graphSummaries" .= object g ]+ BS.putStr $ encode o
− src/IndexReport.hs
@@ -1,19 +0,0 @@-module IndexReport where--import qualified Data.ByteString.Lazy as BS-import Data.Aeson-import Control.Monad--import Paths-import JsonUtils---indexReportsMain :: [FilePath] -> IO ()-indexReportsMain revs = do- g <- forM revs $ \rev -> do- json <- BS.readFile (summaryOf rev)- case eitherDecode json of- Left e -> fail e- Right rep -> return (rep :: Value)-- BS.putStr (encode (merges g))
src/JsonSettings.hs view
@@ -2,25 +2,13 @@ module JsonSettings where +import Data.Yaml import Data.Aeson import qualified Data.ByteString.Lazy as BS--import BenchmarkSettings as S+import Data.Functor jsonSettingsMain :: IO () jsonSettingsMain = do- Settings {..} <- S.readSettings "settings.yaml"- let o = object- [ "settings" .= object- [ "title" .= title- , "cgitLink" .= cgitLink- , "logLink" .= logLink- , "limitRecent" .= limitRecent- ]- ]- BS.putStr (encode o)---- -+ s <- either (error.show) id <$> decodeFileEither "settings.yaml"+ let o = object [ "settings" .= (s :: Object) ]+ BS.putStr (Data.Aeson.encode o)
src/ReadResult.hs view
@@ -12,6 +12,7 @@ import Data.Aeson hiding (decode) import GHC.Generics import Data.Char+import Data.Scientific import Paths @@ -24,11 +25,11 @@ type ResultMap = M.Map String BenchValue -instance ToJSON BenchValue where +instance ToJSON BenchValue where toJSON (F d) = toJSON d toJSON (I i) = toJSON i-instance FromJSON BenchValue where - parseJSON o = (I <$> parseJSON o) <|> (F <$> parseJSON o)+instance FromJSON BenchValue where+ parseJSON o = either F I . floatingOrInteger <$> parseJSON o instance FromField BenchValue where parseField s = (I <$> parseField s) <|> (F <$> parseField s)
src/ReportTypes.hs view
@@ -4,9 +4,11 @@ import qualified Data.Map as M import Data.Aeson+import Data.Aeson.Types import GHC.Generics import Text.Printf import Data.List+import Data.Char import Paths import ReadResult@@ -14,7 +16,7 @@ data ClientSettings = ClientSettings { title :: String- , cgitLink :: String+ , diffLink :: String , logLink :: String } deriving (Generic)@@ -46,15 +48,18 @@ { totalCount :: Int , improvementCount :: Int , regressionCount :: Int+ , summaryDesc :: String } deriving (Show, Generic) instance ToJSON SummaryStats instance FromJSON SummaryStats +{- sumStats :: [SummaryStats] -> SummaryStats sumStats = foldl' go (SummaryStats 0 0 0) where go (SummaryStats a b c) (SummaryStats a' b' c') = SummaryStats (a + a') (b + b') (c + c')+-} data Summary = Summary { hash :: Hash@@ -78,7 +83,7 @@ instance FromJSON RevReport data ChangeType = Improvement | Boring | Regression- deriving (Generic)+ deriving (Eq, Generic) instance ToJSON ChangeType instance FromJSON ChangeType @@ -97,11 +102,32 @@ , change :: String , changeType :: ChangeType , unit :: String+ , important :: Bool } deriving (Generic)-instance ToJSON BenchResult-instance FromJSON BenchResult+instance ToJSON BenchResult where+ toJSON = genericToJSON defaultOptions+instance FromJSON BenchResult where+ parseJSON = genericParseJSON defaultOptions +-- A smaller BenchResult+data GraphPoint = GraphPoint+ { gpValue :: BenchValue+ , gpChangeType :: ChangeType+ }+ deriving (Generic)+instance ToJSON GraphPoint where+ toJSON = genericToJSON (defaultOptions { fieldLabelModifier = fixup })+instance FromJSON GraphPoint where+ parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = fixup })++fixup ('g':'p':c:cs) = toLower c : cs++benchResultToGraphPoint (BenchResult {..}) = GraphPoint+ { gpValue = value+ , gpChangeType = changeType+ }+ invertChangeType :: ChangeType -> ChangeType invertChangeType Improvement = Regression invertChangeType Boring = Boring@@ -146,8 +172,9 @@ explain :: S.BenchSettings -> BenchValue -> BenchValue -> (String, ChangeType) explain s@(S.numberType -> S.SmallIntegralNT) (I i1) (I i2) = explainSmallInt s i1 i2 explain s@(S.numberType -> S.IntegralNT) (I i1) (I i2) = explainInt s i1 i2-explain s@(S.numberType -> S.FloatingNT) v1 v2 = explainFloat s (toFloat v1) (toFloat v2)-explain _ _ _ = noExplanation+-- Treat everything else as Floats, so that we do something sensible+-- even if the user did not set the numberType correctly:+explain s v1 v2 = explainFloat s (toFloat v1) (toFloat v2) toResult :: S.BenchSettings -> String -> BenchValue -> Maybe BenchValue -> BenchResult toResult s name value prev = BenchResult@@ -157,6 +184,7 @@ , change = change , changeType = changeType , unit = S.unit s+ , important = S.important s } where (change, changeType') =@@ -169,10 +197,25 @@ toSummaryStats :: [BenchResult] -> SummaryStats toSummaryStats res = SummaryStats { totalCount = length res- , improvementCount = length [ () | BenchResult { changeType = Improvement } <- res ]- , regressionCount = length [ () | BenchResult { changeType = Regression } <- res ]+ , improvementCount = length+ [ ()+ | BenchResult { changeType = Improvement, important = True } <- res+ ]+ , regressionCount = length+ [ ()+ | BenchResult { changeType = Regression, important = True } <- res+ ]+ , summaryDesc = andMore 5+ [ name r ++ ": " ++ change r+ | r <- res, important r, changeType r `elem` [Improvement, Regression]+ ] } +andMore :: Int -> [String] -> String+andMore _ [] = "–"+andMore n xs = intercalate "\n" (take n xs) ++ rest+ where rest | length xs > n = "\nand " ++ show (length xs - n) ++ " more"+ | otherwise = "" {- toGroup :: String -> [BenchResult] -> BenchGroup
src/RevReport.hs view
@@ -20,10 +20,10 @@ thisM <- readCSV this parentM <- case parents of- p:_ -> readCSV (head parents)+ p:_ -> readCSV p _ -> return M.empty - log <- case parents of + log <- case parents of p:_ -> fromStdout <$> git ["log", p ++ ".."++ this] _ -> fromStdout <$> git ["show", "-s", this]
src/Shake.hs view
@@ -1,20 +1,29 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, NondecreasingIndentation #-} module Shake where import Prelude hiding ((*>)) -import Development.Shake+import Development.Shake hiding (withTempFile) import Development.Shake.FilePath import Development.Shake.Classes import Control.Monad import qualified Data.Map as M import Data.Functor import Data.List+import System.IO.Extra (newTempFile)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified System.Directory+import Data.Aeson+import qualified Data.Text as T +import Development.Shake.Gitlib+ import Paths hiding (Hash) import ParentMap import BenchmarksInCSV import qualified BenchmarkSettings as S+import JsonUtils {- Global settings -} cGRAPH_HISTORY :: Integer@@ -42,29 +51,52 @@ need existing return existing -findPred, findPredOrSelf :: ParentMap -> Hash -> Action (Maybe Hash)-findPredOrSelf m h = do- ex <- doesFileExist (logsOf h)+doesLogExist :: LogSource -> Hash -> Action Bool+doesLogExist BareGit hash = doesGitFileExist "logs" (hash <.> "log")+doesLogExist FileSystem hash = doesFileExist (logsOf hash)+doesLogExist NoLogs hash = doesFileExist (resultsOf hash)++findPred, findPredOrSelf :: LogSource -> ParentMap -> Hash -> Action (Maybe Hash)+findPredOrSelf logSource m h = do+ ex <- doesLogExist logSource h if ex then return (Just h)- else findPred m h-findPred m h = case M.lookup h m of - Just h' -> findPredOrSelf m h'+ else findPred logSource m h+findPred logSource m h = case M.lookup h m of+ Just h' -> findPredOrSelf logSource m h' Nothing -> return Nothing -findRecent :: ParentMap -> Integer -> FilePath -> Action [FilePath]-findRecent _ 0 _ = return []-findRecent m n h = do- pM <- findPred m h+findRecent :: LogSource -> ParentMap -> Integer -> FilePath -> Action [FilePath]+findRecent _ _ 0 _ = return []+findRecent logSource m n h = do+ pM <- findPred logSource m h (h:) <$> case pM of Nothing -> return []- Just p -> findRecent m (n-1) p+ Just p -> findRecent logSource m (n-1) p newtype LimitRecent = LimitRecent () deriving (Show,Typeable,Eq,Hashable,Binary,NFData) +data LogSource = FileSystem | BareGit | NoLogs deriving Show++determineLogSource :: IO LogSource+determineLogSource = do+ haveLogs <- System.Directory.doesDirectoryExist "logs"+ if haveLogs+ then do+ Stdout s <- cmd "git -C logs rev-parse --is-bare-repository"+ if s == "true\n"+ then return BareGit+ else return FileSystem+ else return NoLogs+ shakeMain :: IO ()-shakeMain = shakeArgs shakeOptions $ do+shakeMain = do+ logSource <- determineLogSource+ print logSource + shakeArgs shakeOptions $ do+ defaultRuleGitLib+ {- "gipeda" *> \out -> do sources <- getDirectoryFiles "src" ["*.hs"]@@ -81,7 +113,7 @@ range <- gitRange Stdout range <- git "log" ["--format=%H",range] let hashes = words range- withLogs <- filterM (doesFileExist . logsOf) hashes+ withLogs <- filterM (doesLogExist logSource) hashes need $ map reportOf withLogs want ["reports"] @@ -89,7 +121,7 @@ range <- gitRange Stdout range <- git "log" ["--format=%H",range] let hashes = words range- withLogs <- filterM (doesFileExist . logsOf) hashes+ withLogs <- filterM (doesLogExist logSource) hashes need $ map summaryOf withLogs want ["summaries"] @@ -97,8 +129,8 @@ alwaysRerun Stdout stdout <- git "rev-parse" ["master"] writeFileChanged out stdout- + "site/out/history.csv" *> \out -> do range <- gitRange Stdout stdout <- git "log" ["--format=%H;%P",range]@@ -109,19 +141,31 @@ orderOnly ["site/out/history.csv"] liftIO $ ssvFileToMap "site/out/history.csv" let history = history' ()- let pred h = do { hist <- history; findPred hist h }- let predOrSelf h = do { hist <- history; findPredOrSelf hist h }- let recent n h = do { hist <- history; findRecent hist n h }+ let pred h = do { hist <- history; findPred logSource hist h }+ let predOrSelf h = do { hist <- history; findPredOrSelf logSource hist h }+ let recent n h = do { hist <- history; findRecent logSource hist n h } "site/out/latest.txt" *> \ out -> do [head] <- readFileLines "site/out/head.txt" latestM <- predOrSelf head case latestM of- Just latest -> + Just latest -> writeFileChanged out latest- Nothing -> + Nothing -> fail "Head has no parent with logs?" + "site/out/tags.txt" *> \ out -> do+ alwaysRerun++ need ["settings.yaml"]+ s <- liftIO $ S.readSettings "settings.yaml"+ case S.interestingTags s of+ Nothing ->+ writeFileChanged out ""+ Just pattern -> do+ Stdout tags <- git "tag" ["-l", pattern]+ writeFileChanged out tags+ "graphs" ~> do [latest] <- readFileLines "site/out/latest.txt" need [resultsOf latest]@@ -129,11 +173,22 @@ need (map graphFile b) want ["graphs"] - "site/out/results/*.csv" *> \out -> do- let hash = takeBaseName out- need [logsOf hash]- Stdout csv <- cmd "./log2csv" (logsOf hash)- writeFile' out csv+ case logSource of+ BareGit ->+ "site/out/results/*.csv" *> \out -> do+ let hash = takeBaseName out+ withTempFile $ \fn -> do+ log <- readGitFile "logs" (hash <.> "log")+ liftIO $ BS.writeFile fn log+ Stdout csv <- cmd "./log2csv" fn+ writeFile' out csv+ FileSystem ->+ "site/out/results/*.csv" *> \out -> do+ let hash = takeBaseName out+ need [logsOf hash]+ Stdout csv <- cmd "./log2csv" (logsOf hash)+ writeFile' out csv+ NoLogs -> return () "site/out/graphs//*.json" *> \out -> do let bench = dropDirectory1 (dropDirectory1 (dropDirectory1 (dropExtension out)))@@ -141,7 +196,7 @@ [latest] <- readFileLines "site/out/latest.txt" limitRecent <- getLimitRecent (LimitRecent ()) r <- recent limitRecent latest- need (map resultsOf r)+ need (map reportOf r) Stdout json <- self "GraphReport" (bench : r) writeFile' out json@@ -165,13 +220,38 @@ "site/out/latest-summaries.json" *> \out -> do [latest] <- readFileLines "site/out/latest.txt"- r <- recent cGRAPH_HISTORY latest- need (map summaryOf r)+ recentCommits <- recent cGRAPH_HISTORY latest - Stdout json <- self "IndexReport" r- writeFile' out json+ tags <- readFileLines "site/out/tags.txt"+ tagsAndHashes <- forM tags $ \t -> do+ h <- getGitReference "repository" ("refs/tags/" ++ t)+ return $ (t, h)+ let o = object [ T.pack "tags" .= object [ (T.pack t .= h) | (t,h) <- tagsAndHashes ]]+ liftIO $ LBS.writeFile out (encode o)+ tagCommits <- filterM (doesLogExist logSource) (map snd tagsAndHashes)++ let revs = nub $ recentCommits ++ tagCommits++ need $ map summaryOf revs++ g <- forM revs $ \rev -> do+ json <- liftIO $ LBS.readFile (summaryOf rev)+ case eitherDecode json of+ Left e -> fail e+ Right rep -> return (rep :: Value)+ liftIO $ LBS.writeFile out (encode (merges (o:g))) want ["site/out/latest-summaries.json"] + "site/out/graph-summaries.json" *> \out -> do+ [latest] <- readFileLines "site/out/latest.txt"+ need [resultsOf latest]+ b <- liftIO $ benchmarksInCSVFile (resultsOf latest)+ need (map graphFile b)++ Stdout json <- self "GraphSummaries" b+ writeFile' out json+ want ["site/out/graph-summaries.json"]+ "site/out/benchNames.json" *> \out -> do [latest] <- readFileLines "site/out/latest.txt" need [resultsOf latest]@@ -182,18 +262,21 @@ Stdout json <- self "BenchNames" (nub b) writeFile' out json want ["site/out/benchNames.json"]- "site/out/all-summaries.json" *> \out -> do range <- gitRange Stdout range <- git "log" ["--format=%H",range] let hashes = words range- withLogs <- filterM (doesFileExist . logsOf) hashes- need (map summaryOf withLogs)+ revs <- filterM (doesLogExist logSource) hashes+ need (map summaryOf revs) - Stdout json <- self "IndexReport" withLogs- writeFile' out json+ g <- forM revs $ \rev -> do+ json <- liftIO $ LBS.readFile (summaryOf rev)+ case eitherDecode json of+ Left e -> fail e+ Right rep -> return (rep :: Value)+ liftIO $ LBS.writeFile out (encode (merges g)) want ["site/out/all-summaries.json"] "site/out/settings.json" *> \out -> do@@ -206,3 +289,12 @@ phony "clean" $ do removeFilesAfter "site/out" ["//*"] ++-- | Create a temporary file in the temporary directory. The file will be deleted+-- after the action completes (provided the file is not still open).+-- The 'FilePath' will not have any file extension, will exist, and will be zero bytes long.+-- If you require a file with a specific name, use 'withTempDir'.+withTempFile :: (FilePath -> Action a) -> Action a+withTempFile act = do+ (file, del) <- liftIO newTempFile+ act file `actionFinally` del
src/gipeda.hs view
@@ -8,10 +8,12 @@ import RevReport import WithLatestLogs import Summary-import IndexReport import GraphReport import BenchNames+import GraphSummaries +import GHC.IO.Encoding+ {- We want to build everything into one executable, bit still treat it as multiple tools. Hence the main function@@ -20,19 +22,23 @@ main :: IO () main = do+ + -- Make us locale-independent + setLocaleEncoding utf8+ args <- getArgs ex <- doesFileExist "settings.yaml" unless ex $ do- hPutStr stderr "Please run this from the same directory as the settings.yaml file."+ hPutStr stderr "Please run this from the same directory as the settings.yaml file.\n" case args of - "IndexReport":opts -> indexReportsMain opts "JsonSettings":_ -> jsonSettingsMain "Summary":opts -> summaryMain opts "RevReport":opts -> revReportMain opts "GraphReport":opts -> graphReportMain opts "WithLatestLogs":opts -> withLatestLogsMain opts "BenchNames":opts -> benchNamesMain opts+ "GraphSummaries":opts -> graphSummaries opts _ -> shakeMain -- shake will take the arguments from getArgs