2019-10-14 20:24:14 +02:00
|
|
|
;;; Guix Data Service -- Information about Guix over time
|
|
|
|
|
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
|
|
|
|
|
;;;
|
|
|
|
|
;;; This program is free software: you can redistribute it and/or
|
|
|
|
|
;;; modify it under the terms of the GNU Affero General Public License
|
|
|
|
|
;;; as published by the Free Software Foundation, either version 3 of
|
|
|
|
|
;;; the License, or (at your option) any later version.
|
|
|
|
|
;;;
|
|
|
|
|
;;; This program is distributed in the hope that it will be useful,
|
|
|
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
|
;;; Affero General Public License for more details.
|
|
|
|
|
;;;
|
|
|
|
|
;;; You should have received a copy of the GNU Affero General Public
|
|
|
|
|
;;; License along with this program. If not, see
|
|
|
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
|
|
(define-module (guix-data-service web compare html)
|
|
|
|
|
#:use-module (srfi srfi-1)
|
2020-11-21 22:00:40 +01:00
|
|
|
#:use-module (srfi srfi-19)
|
2019-10-14 20:24:14 +02:00
|
|
|
#:use-module (ice-9 match)
|
|
|
|
|
#:use-module (ice-9 vlist)
|
2019-11-21 00:03:50 +01:00
|
|
|
#:use-module (texinfo)
|
|
|
|
|
#:use-module (texinfo html)
|
2019-10-14 20:24:14 +02:00
|
|
|
#:use-module (guix-data-service web query-parameters)
|
2020-10-31 16:55:11 +01:00
|
|
|
#:use-module (guix-data-service web html-utils)
|
2019-10-14 20:24:14 +02:00
|
|
|
#:use-module (guix-data-service web view html)
|
|
|
|
|
#:export (compare
|
2019-11-14 21:57:21 +01:00
|
|
|
compare/derivation
|
2020-10-31 14:52:08 +01:00
|
|
|
compare/package-derivations
|
|
|
|
|
compare-by-datetime/package-derivations
|
2019-10-14 20:24:14 +02:00
|
|
|
compare/packages
|
|
|
|
|
compare-invalid-parameters))
|
|
|
|
|
|
2020-11-21 21:25:26 +01:00
|
|
|
(define (compare-form-controls-for-mode mode query-parameters)
|
|
|
|
|
(cond
|
|
|
|
|
((eq? mode 'revision)
|
|
|
|
|
(list
|
|
|
|
|
(form-horizontal-control
|
|
|
|
|
"Base commit" query-parameters
|
|
|
|
|
#:required? #t
|
|
|
|
|
#:help-text "The commit to use as the basis for the comparison."
|
|
|
|
|
#:font-family "monospace")
|
|
|
|
|
(form-horizontal-control
|
|
|
|
|
"Target commit" query-parameters
|
|
|
|
|
#:required? #t
|
|
|
|
|
#:help-text "The commit to compare against the base commit."
|
|
|
|
|
#:font-family "monospace")))
|
|
|
|
|
((eq? mode 'datetime)
|
|
|
|
|
(list
|
|
|
|
|
(form-horizontal-control
|
|
|
|
|
"Base branch" query-parameters
|
|
|
|
|
#:required? #t
|
|
|
|
|
#:help-text "The branch to compare from."
|
|
|
|
|
#:font-family "monospace")
|
|
|
|
|
(form-horizontal-control
|
|
|
|
|
"Base datetime" query-parameters
|
|
|
|
|
#:help-text "The date and time to compare from."
|
|
|
|
|
#:font-family "monospace")
|
|
|
|
|
(form-horizontal-control
|
|
|
|
|
"Target branch" query-parameters
|
|
|
|
|
#:required? #t
|
|
|
|
|
#:help-text "The branch to compare to."
|
|
|
|
|
#:font-family "monospace")
|
|
|
|
|
(form-horizontal-control
|
|
|
|
|
"Target datetime" query-parameters
|
|
|
|
|
#:help-text "The date and time to compare to."
|
|
|
|
|
#:font-family "monospace")))
|
|
|
|
|
(else
|
|
|
|
|
'())))
|
|
|
|
|
|
2019-10-14 20:24:14 +02:00
|
|
|
(define (compare query-parameters
|
2020-11-21 19:37:19 +01:00
|
|
|
mode
|
2019-10-14 20:24:14 +02:00
|
|
|
cgit-url-bases
|
|
|
|
|
new-packages
|
|
|
|
|
removed-packages
|
|
|
|
|
version-changes
|
2019-11-21 00:03:50 +01:00
|
|
|
lint-warnings-data
|
2020-05-28 23:00:10 +02:00
|
|
|
lint-warnings-locale-options
|
2019-11-21 00:03:50 +01:00
|
|
|
channel-news-data)
|
2020-11-21 19:37:19 +01:00
|
|
|
(define invalid-query?
|
|
|
|
|
(any-invalid-query-parameters? query-parameters))
|
|
|
|
|
|
2019-10-14 20:24:14 +02:00
|
|
|
(define base-commit
|
|
|
|
|
(assq-ref query-parameters 'base_commit))
|
|
|
|
|
|
|
|
|
|
(define target-commit
|
|
|
|
|
(assq-ref query-parameters 'target_commit))
|
|
|
|
|
|
2020-05-28 23:00:10 +02:00
|
|
|
(define locale
|
|
|
|
|
(assq-ref query-parameters 'locale))
|
|
|
|
|
|
2019-10-14 20:24:14 +02:00
|
|
|
(define query-params
|
2020-11-21 19:37:19 +01:00
|
|
|
(unless invalid-query?
|
2020-11-21 21:10:46 +01:00
|
|
|
(query-parameters->string query-parameters)))
|
2019-10-14 20:24:14 +02:00
|
|
|
|
|
|
|
|
(layout
|
|
|
|
|
#:body
|
|
|
|
|
`(,(header)
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "container"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
2020-11-21 19:37:19 +01:00
|
|
|
(@ (class "col-sm-7"))
|
|
|
|
|
,@(if invalid-query?
|
|
|
|
|
`((h1 "Compare"))
|
|
|
|
|
`((h1 "Comparing "
|
|
|
|
|
(a (@ (href ,(string-append "/revision/" base-commit)))
|
|
|
|
|
(samp ,(string-take base-commit 8) "…"))
|
|
|
|
|
" and "
|
|
|
|
|
(a (@ (href ,(string-append "/revision/" target-commit)))
|
|
|
|
|
(samp ,(string-take target-commit 8) "…")))
|
|
|
|
|
,@(if (apply string=? cgit-url-bases)
|
|
|
|
|
`((a (@ (href ,(string-append
|
|
|
|
|
(first cgit-url-bases)
|
|
|
|
|
"log/?qt=range&q="
|
|
|
|
|
base-commit ".." target-commit)))
|
|
|
|
|
"(View cgit)"))
|
|
|
|
|
'()))))
|
2019-10-14 20:24:14 +02:00
|
|
|
(div
|
2020-11-21 19:37:19 +01:00
|
|
|
(@ (class "col-sm-5"))
|
2019-10-14 20:24:14 +02:00
|
|
|
(div
|
2020-11-21 19:37:19 +01:00
|
|
|
(@ (class "btn-group btn-group-lg")
|
|
|
|
|
(style "margin-top: 1.3rem; margin-bottom: 0.5rem;")
|
2019-10-14 20:24:14 +02:00
|
|
|
(role "group"))
|
2020-11-21 19:37:19 +01:00
|
|
|
(a (@ (class ,(string-append
|
|
|
|
|
"btn btn-default btn-lg"
|
|
|
|
|
(if (eq? mode 'revision)
|
|
|
|
|
" disabled"
|
|
|
|
|
"")))
|
|
|
|
|
(href "/compare"))
|
|
|
|
|
"Compare revisions")
|
|
|
|
|
(a (@ (class ,(string-append
|
|
|
|
|
"btn btn-default btn-lg"
|
|
|
|
|
(if (eq? mode 'datetime)
|
|
|
|
|
" disabled"
|
|
|
|
|
"")))
|
|
|
|
|
(href "/compare-by-datetime"))
|
|
|
|
|
"Compare by datetime"))))
|
2020-05-28 23:00:10 +02:00
|
|
|
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-md-12"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "well"))
|
|
|
|
|
(form
|
|
|
|
|
(@ (method "get")
|
|
|
|
|
(action "")
|
|
|
|
|
(style "padding-bottom: 0")
|
|
|
|
|
(class "form-horizontal"))
|
2020-11-21 21:25:26 +01:00
|
|
|
,@(compare-form-controls-for-mode mode query-parameters)
|
2020-05-28 23:00:10 +02:00
|
|
|
,(form-horizontal-control
|
|
|
|
|
"Locale" query-parameters
|
|
|
|
|
#:name "locale"
|
|
|
|
|
#:allow-selecting-multiple-options #f
|
|
|
|
|
#:options lint-warnings-locale-options
|
|
|
|
|
#:help-text "Language")
|
|
|
|
|
(div (@ (class "form-group form-group-lg"))
|
|
|
|
|
(div (@ (class "col-sm-offset-2 col-sm-10"))
|
|
|
|
|
(button (@ (type "submit")
|
|
|
|
|
(class "btn btn-lg btn-primary"))
|
|
|
|
|
"Update results")))))))
|
|
|
|
|
|
2020-11-21 19:37:19 +01:00
|
|
|
,@(if
|
|
|
|
|
invalid-query?
|
|
|
|
|
'()
|
|
|
|
|
`((div
|
|
|
|
|
(@ (class "row") (style "clear: left;"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-6"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "btn-group btn-group-lg")
|
|
|
|
|
(role "group"))
|
|
|
|
|
(a (@ (class "btn btn-default")
|
2020-11-21 21:10:46 +01:00
|
|
|
(href ,(string-append
|
|
|
|
|
"/"
|
|
|
|
|
(cond
|
|
|
|
|
((eq? mode 'revision) "compare")
|
|
|
|
|
((eq? mode 'datetime) "compare-by-datetime"))
|
|
|
|
|
"/packages?"
|
|
|
|
|
query-params)))
|
2020-11-21 19:37:19 +01:00
|
|
|
"Compare packages")
|
|
|
|
|
(a (@ (class "btn btn-default")
|
2020-11-21 21:10:46 +01:00
|
|
|
(href ,(string-append
|
|
|
|
|
"/"
|
|
|
|
|
(cond
|
|
|
|
|
((eq? mode 'revision) "compare")
|
|
|
|
|
((eq? mode 'datetime) "compare-by-datetime"))
|
|
|
|
|
"/package-derivations?"
|
|
|
|
|
query-params)))
|
2020-11-21 19:37:19 +01:00
|
|
|
"Compare package derivations")))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-6"))
|
|
|
|
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
|
|
|
|
(href ,(string-append
|
2020-11-21 21:10:46 +01:00
|
|
|
"/compare.json?" query-params)))
|
2020-11-21 19:37:19 +01:00
|
|
|
"View JSON")))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h3 (@ (style "clear: both;"))
|
|
|
|
|
"News entries")
|
|
|
|
|
,(if (null? channel-news-data)
|
|
|
|
|
"No news entry changes"
|
|
|
|
|
(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((commit tag title-text body-text change)
|
|
|
|
|
`(div
|
|
|
|
|
(h4 ,@(if (null? commit)
|
|
|
|
|
'()
|
|
|
|
|
`(("Commit: " (samp ,commit))))
|
|
|
|
|
,@(if (null? tag)
|
|
|
|
|
'()
|
|
|
|
|
`(("Tag: " ,tag))))
|
|
|
|
|
(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th (@ (class "col-sm-1")) "")
|
|
|
|
|
(th (@ (class "col-sm-1")) "Language")
|
|
|
|
|
(th (@ (class "col-sm-3")) "Title")
|
|
|
|
|
(th (@ (class "col-sm-7")) "Body"))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(let ((languages
|
|
|
|
|
(sort
|
|
|
|
|
(delete-duplicates
|
|
|
|
|
(append (map car title-text)
|
|
|
|
|
(map car body-text)))
|
|
|
|
|
string<?)))
|
|
|
|
|
(map (lambda (lang index)
|
|
|
|
|
`(tr
|
|
|
|
|
,@(if (eq? index 0)
|
|
|
|
|
`((td (@ (rowspan ,(length languages)))
|
|
|
|
|
,(case change
|
|
|
|
|
((new) "New")
|
|
|
|
|
((removed) "Removed")
|
|
|
|
|
((changed) "Changed"))))
|
|
|
|
|
'())
|
|
|
|
|
(td ,lang)
|
|
|
|
|
(td ,(stexi->shtml
|
|
|
|
|
(texi-fragment->stexi
|
|
|
|
|
(assoc-ref title-text lang))))
|
|
|
|
|
(td ,
|
|
|
|
|
(stexi->shtml
|
|
|
|
|
(texi-fragment->stexi
|
|
|
|
|
(assoc-ref body-text lang))))))
|
|
|
|
|
languages
|
|
|
|
|
(iota (length languages))))))))))
|
|
|
|
|
channel-news-data))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h3 "New packages")
|
|
|
|
|
,(if (null? new-packages)
|
|
|
|
|
'(p "No new packages")
|
|
|
|
|
`(table
|
2019-11-21 00:03:50 +01:00
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
2020-11-21 19:37:19 +01:00
|
|
|
(th (@ (class "col-md-4")) "Name")
|
|
|
|
|
(th (@ (class "col-md-4")) "Version")
|
|
|
|
|
(th (@ (class "col-md-4")) "")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((('name . name)
|
|
|
|
|
('version . version))
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td ,version)
|
|
|
|
|
(td (@ (class "text-right"))
|
|
|
|
|
(a (@ (href ,(string-append
|
|
|
|
|
"/revision/" target-commit
|
|
|
|
|
"/package/" name "/" version)))
|
|
|
|
|
"More information")))))
|
|
|
|
|
new-packages))))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h3 "Removed packages")
|
|
|
|
|
,(if (null? removed-packages)
|
|
|
|
|
'(p "No removed packages")
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th (@ (class "col-md-4")) "Name")
|
|
|
|
|
(th (@ (class "col-md-4")) "Version")
|
|
|
|
|
(th (@ (class "col-md-4")) "")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((('name . name)
|
|
|
|
|
('version . version))
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td ,version)
|
|
|
|
|
(td (@ (class "text-right"))
|
|
|
|
|
(a (@ (href ,(string-append
|
|
|
|
|
"/revision/" base-commit
|
|
|
|
|
"/package/" name "/" version)))
|
|
|
|
|
"More information")))))
|
|
|
|
|
removed-packages))))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h3 "Version changes")
|
|
|
|
|
,(if
|
|
|
|
|
(null? version-changes)
|
|
|
|
|
'(p "No version changes")
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th (@ (class "col-md-3")) "Name")
|
|
|
|
|
(th (@ (class "col-md-9")) "Versions")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((name . versions)
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td
|
|
|
|
|
(ul
|
|
|
|
|
(@ (class "list-unstyled"))
|
|
|
|
|
,@(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((type . versions)
|
|
|
|
|
`(li (@ (class ,(if (eq? type 'base)
|
|
|
|
|
"text-danger"
|
|
|
|
|
"text-success")))
|
|
|
|
|
(ul
|
|
|
|
|
(@ (class "list-inline")
|
|
|
|
|
(style "display: inline-block;"))
|
|
|
|
|
,@(map
|
|
|
|
|
(lambda (version)
|
|
|
|
|
`(li (a (@ (href
|
|
|
|
|
,(string-append
|
|
|
|
|
"/revision/"
|
|
|
|
|
(if (eq? type 'base)
|
|
|
|
|
base-commit
|
|
|
|
|
target-commit)
|
|
|
|
|
"/package/"
|
|
|
|
|
name "/" version)))
|
|
|
|
|
,version)))
|
|
|
|
|
(vector->list versions)))
|
|
|
|
|
,(if (eq? type 'base)
|
|
|
|
|
" (old)"
|
|
|
|
|
" (new)"))))
|
|
|
|
|
versions))))))
|
|
|
|
|
version-changes))))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h2 "Lint warnings")
|
|
|
|
|
,@(if
|
|
|
|
|
(null? lint-warnings-data)
|
|
|
|
|
'((p "No lint warning changes"))
|
|
|
|
|
(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
(((package-name package-version) . warnings)
|
|
|
|
|
`((h4 ,package-name " (version: " ,package-version ")")
|
|
|
|
|
(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "")
|
|
|
|
|
(th "Linter")
|
|
|
|
|
(th "Message")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(map (match-lambda
|
|
|
|
|
((lint-checker-name
|
|
|
|
|
message
|
|
|
|
|
lint-checker-description
|
|
|
|
|
lint-checker-network-dependent
|
|
|
|
|
file line column-number ;; TODO Maybe use the location?
|
|
|
|
|
change)
|
2019-10-14 20:24:14 +02:00
|
|
|
|
2020-11-21 19:37:19 +01:00
|
|
|
`(tr
|
|
|
|
|
(td (@ (class ,(if (string=? change "new")
|
|
|
|
|
"text-danger"
|
|
|
|
|
"text-success"))
|
|
|
|
|
(style "font-weight: bold"))
|
|
|
|
|
,(if (string=? change "new")
|
|
|
|
|
"New warning"
|
|
|
|
|
"Resolved warning"))
|
|
|
|
|
(td (span (@ (style "font-family: monospace; display: block;"))
|
|
|
|
|
,lint-checker-name)
|
|
|
|
|
(p (@ (style "font-size: small; margin: 6px 0 0px;"))
|
|
|
|
|
,lint-checker-description))
|
|
|
|
|
(td ,message))))
|
|
|
|
|
warnings))))))
|
|
|
|
|
lint-warnings-data))))))))))
|
2019-10-14 20:24:14 +02:00
|
|
|
|
2019-11-14 21:57:21 +01:00
|
|
|
(define (compare/derivation query-parameters data)
|
|
|
|
|
(define base
|
|
|
|
|
'(span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
|
|
|
|
|
(style "font-size: 1.5em; padding-right: 0.4em;"))))
|
|
|
|
|
|
|
|
|
|
(define target
|
|
|
|
|
'(span (@ (class "text-success glyphicon glyphicon-plus pull-left")
|
|
|
|
|
(style "font-size: 1.5em; padding-right: 0.4em;"))))
|
|
|
|
|
|
|
|
|
|
(layout
|
|
|
|
|
#:body
|
|
|
|
|
`(,(header)
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "container"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(h1 ,@(let ((base-commit (assq-ref query-parameters 'base_commit))
|
|
|
|
|
(target-commit (assq-ref query-parameters 'target_commit)))
|
|
|
|
|
(if (every string? (list base-commit target-commit))
|
|
|
|
|
`("Comparing "
|
2020-10-09 20:29:38 +02:00
|
|
|
(a (@ (href ,(string-append "/revision/" base-commit)))
|
|
|
|
|
(samp ,(string-take base-commit 8) "…"))
|
2019-11-14 21:57:21 +01:00
|
|
|
" and "
|
2020-10-09 20:29:38 +02:00
|
|
|
(a (@ (href ,(string-append "/revision/" target-commit)))
|
|
|
|
|
(samp ,(string-take target-commit 8) "…")))
|
2019-11-14 21:57:21 +01:00
|
|
|
'("Comparing derivations")))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-md-12"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "well"))
|
|
|
|
|
(form
|
|
|
|
|
(@ (method "get")
|
|
|
|
|
(action "")
|
|
|
|
|
(class "form-horizontal"))
|
|
|
|
|
,(form-horizontal-control
|
|
|
|
|
"Base derivation" query-parameters
|
|
|
|
|
#:required? #t
|
|
|
|
|
#:help-text "The derivation to use as the basis for the comparison."
|
|
|
|
|
#:font-family "monospace")
|
|
|
|
|
,(form-horizontal-control
|
|
|
|
|
"Target derivation" query-parameters
|
|
|
|
|
#:required? #t
|
|
|
|
|
#:help-text "The derivation to compare against the base commit."
|
|
|
|
|
#:font-family "monospace")
|
|
|
|
|
(div (@ (class "form-group form-group-lg"))
|
|
|
|
|
(div (@ (class "col-sm-offset-2 col-sm-10"))
|
|
|
|
|
(button (@ (type "submit")
|
|
|
|
|
(class "btn btn-lg btn-primary"))
|
|
|
|
|
"Update results")))
|
|
|
|
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
|
|
|
|
(href ,(let ((query-parameter-string
|
|
|
|
|
(query-parameters->string query-parameters)))
|
|
|
|
|
(string-append
|
|
|
|
|
"/compare/derivation.json"
|
|
|
|
|
(if (string-null? query-parameter-string)
|
|
|
|
|
""
|
|
|
|
|
(string-append "?" query-parameter-string))))))
|
|
|
|
|
"View JSON")))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h2 "Outputs")
|
|
|
|
|
,@(let ((outputs (assq-ref data 'outputs)))
|
|
|
|
|
`((table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "")
|
|
|
|
|
(th "Name")
|
|
|
|
|
(th "Path")
|
|
|
|
|
(th "Hash algorithm")
|
|
|
|
|
(th "Hash")
|
|
|
|
|
(th "Recursive")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(let ((base-outputs (assq-ref outputs 'base))
|
|
|
|
|
(target-outputs (assq-ref outputs 'target))
|
|
|
|
|
(common-outputs (assq-ref outputs 'common)))
|
|
|
|
|
(append-map
|
|
|
|
|
(lambda (label items)
|
|
|
|
|
(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((name path hash-algorithm hash recursive)
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,label)
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td (a (@ (href ,path))
|
|
|
|
|
,(display-store-item path)))
|
|
|
|
|
(td ,hash-algorithm)
|
|
|
|
|
(td ,hash)
|
|
|
|
|
(td ,recursive))))
|
|
|
|
|
(or items '())))
|
|
|
|
|
(list base target "Common")
|
|
|
|
|
(list (assq-ref outputs 'base)
|
|
|
|
|
(assq-ref outputs 'target)
|
|
|
|
|
(assq-ref outputs 'common))))))))
|
|
|
|
|
(h2 "Inputs")
|
|
|
|
|
,@(let ((inputs (assq-ref data 'inputs)))
|
|
|
|
|
`((table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "")
|
|
|
|
|
(th "Derivation")
|
|
|
|
|
(th "Outputs")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(append-map
|
|
|
|
|
(lambda (label items)
|
|
|
|
|
(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((derivation outputs)
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,label)
|
|
|
|
|
(td (a (@ (href ,derivation))
|
|
|
|
|
,(display-store-item derivation)))
|
|
|
|
|
(td ,outputs))))
|
|
|
|
|
(or items '())))
|
|
|
|
|
(list base target)
|
|
|
|
|
(list (assq-ref inputs 'base)
|
|
|
|
|
(assq-ref inputs 'target)))))))
|
|
|
|
|
(p "Common inputs are omitted.")
|
|
|
|
|
(h2 "Sources")
|
|
|
|
|
,@(let ((sources (assq-ref data 'sources)))
|
|
|
|
|
`((table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "")
|
|
|
|
|
(th "Derivation")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(append-map
|
|
|
|
|
(lambda (label items)
|
|
|
|
|
(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((file)
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,label)
|
|
|
|
|
(td (a (@ (href ,file))
|
|
|
|
|
,(display-store-item file))))))
|
|
|
|
|
(or items '())))
|
|
|
|
|
(list base target "Common")
|
|
|
|
|
(list (assq-ref sources 'base)
|
|
|
|
|
(assq-ref sources 'target)
|
|
|
|
|
(assq-ref sources 'common)))))))
|
|
|
|
|
(h2 "System")
|
|
|
|
|
,@(let ((system (assq-ref data 'system)))
|
|
|
|
|
(let ((common-system (assq-ref system 'common)))
|
|
|
|
|
(if common-system
|
|
|
|
|
(list common-system)
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "")
|
|
|
|
|
(th "System")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(let ((base-system (assq-ref system 'base))
|
|
|
|
|
(target-system (assq-ref system 'target)))
|
|
|
|
|
`((tr
|
|
|
|
|
(td ,base)
|
|
|
|
|
(td ,base-system))
|
|
|
|
|
(tr
|
|
|
|
|
(td ,target)
|
|
|
|
|
(td ,target-system)))))))))
|
|
|
|
|
(h2 "Builder and arguments")
|
|
|
|
|
,(let ((builder (assq-ref data 'builder))
|
|
|
|
|
(arguments (assq-ref data 'arguments)))
|
|
|
|
|
(let ((common-builder (assq-ref builder 'common))
|
|
|
|
|
(common-args (assq-ref arguments 'common)))
|
|
|
|
|
(if (and common-builder
|
|
|
|
|
common-args)
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(th "Builder")
|
|
|
|
|
(th "Arguments"))
|
|
|
|
|
(tbody
|
|
|
|
|
(tr
|
2019-11-14 22:20:17 +01:00
|
|
|
(td ,(display-possible-store-item common-builder))
|
2019-11-14 21:57:21 +01:00
|
|
|
(td (ol
|
|
|
|
|
,@(map (lambda (arg)
|
2019-11-14 22:20:17 +01:00
|
|
|
`(li ,(display-possible-store-item arg)))
|
2019-11-14 21:57:21 +01:00
|
|
|
common-args))))))
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "")
|
|
|
|
|
(th "Builder")
|
|
|
|
|
(th "Arguments")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(let ((base-builder (assq-ref builder 'base))
|
|
|
|
|
(target-builder (assq-ref builder 'target))
|
|
|
|
|
(base-args (assq-ref arguments 'base))
|
|
|
|
|
(target-args (assq-ref arguments 'target)))
|
|
|
|
|
`((tr
|
|
|
|
|
(td ,base)
|
2019-11-14 22:20:17 +01:00
|
|
|
(td ,(display-possible-store-item
|
|
|
|
|
(or base-builder
|
|
|
|
|
common-builder)))
|
2019-11-14 21:57:21 +01:00
|
|
|
(td (ol
|
|
|
|
|
,@(map (lambda (arg)
|
2019-11-14 22:20:17 +01:00
|
|
|
`(li ,(display-possible-store-item arg)))
|
2019-11-14 21:57:21 +01:00
|
|
|
(or common-args
|
|
|
|
|
base-args)))))
|
|
|
|
|
(tr
|
|
|
|
|
(td ,target)
|
2019-11-14 22:20:17 +01:00
|
|
|
(td ,(display-possible-store-item
|
|
|
|
|
(or target-builder
|
|
|
|
|
common-builder)))
|
2019-11-14 21:57:21 +01:00
|
|
|
(td (ol
|
|
|
|
|
,@(map (lambda (arg)
|
2019-11-14 22:20:17 +01:00
|
|
|
`(li ,(display-possible-store-item arg)))
|
2019-11-14 21:57:21 +01:00
|
|
|
(or common-args
|
|
|
|
|
target-args))))))))))))
|
|
|
|
|
(h2 "Environment variables")
|
|
|
|
|
,(let ((environment-variables (assq-ref data 'environment-variables)))
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(th "Name"))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(append-map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((name . values)
|
|
|
|
|
(let ((common-value (assq-ref values 'common)))
|
|
|
|
|
(if common-value
|
|
|
|
|
`((tr
|
|
|
|
|
(td ,name)
|
2019-11-14 22:20:17 +01:00
|
|
|
(td ,(display-possible-store-item common-value))))
|
2019-11-14 21:57:21 +01:00
|
|
|
(let ((base-value (assq-ref values 'base))
|
|
|
|
|
(target-value (assq-ref values 'target)))
|
|
|
|
|
(if (and base-value target-value)
|
|
|
|
|
`((tr
|
|
|
|
|
(td (@ (rowspan 2))
|
|
|
|
|
,name)
|
2019-11-14 22:20:17 +01:00
|
|
|
(td ,base ,(display-possible-store-item
|
|
|
|
|
base-value)))
|
2019-11-14 21:57:21 +01:00
|
|
|
(tr
|
2019-11-14 22:20:17 +01:00
|
|
|
(td ,target ,(display-possible-store-item
|
|
|
|
|
target-value))))
|
2019-11-14 21:57:21 +01:00
|
|
|
`((tr
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td ,@(if base-value
|
2019-11-14 22:20:17 +01:00
|
|
|
(list base
|
|
|
|
|
(display-possible-store-item
|
|
|
|
|
base-value))
|
|
|
|
|
(list target
|
|
|
|
|
(display-possible-store-item
|
|
|
|
|
target-value))))))))))))
|
2019-11-14 21:57:21 +01:00
|
|
|
environment-variables))))))))))
|
|
|
|
|
|
2020-11-21 22:00:40 +01:00
|
|
|
(define* (compare/package-derivations query-parameters
|
|
|
|
|
mode
|
|
|
|
|
valid-systems
|
|
|
|
|
valid-targets
|
|
|
|
|
valid-build-statuses
|
|
|
|
|
build-server-urls
|
|
|
|
|
derivation-changes
|
|
|
|
|
#:optional
|
|
|
|
|
base-revision-details
|
|
|
|
|
target-revision-details)
|
2019-10-14 20:24:14 +02:00
|
|
|
(layout
|
|
|
|
|
#:body
|
|
|
|
|
`(,(header)
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "container"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
2020-11-21 22:00:40 +01:00
|
|
|
,@(cond
|
|
|
|
|
((any-invalid-query-parameters? query-parameters)
|
|
|
|
|
'((h3 "Comparing package derivations")))
|
|
|
|
|
((eq? mode 'revision)
|
|
|
|
|
(let ((base-commit (assq-ref query-parameters 'base_commit))
|
|
|
|
|
(target-commit (assq-ref query-parameters 'target_commit)))
|
|
|
|
|
`((h3
|
|
|
|
|
(a (@ (href ,(string-append
|
|
|
|
|
"/compare?base_commit="
|
|
|
|
|
base-commit
|
|
|
|
|
"&target_commit="
|
|
|
|
|
target-commit)))
|
|
|
|
|
"Comparing "
|
|
|
|
|
(samp ,(string-take base-commit 8) "…")
|
|
|
|
|
" and "
|
|
|
|
|
(samp ,(string-take target-commit 8) "…"))))))
|
|
|
|
|
((eq? mode 'datetime)
|
|
|
|
|
(let ((base-branch (assq-ref query-parameters 'base_branch))
|
|
|
|
|
(base-datetime (assq-ref query-parameters 'base_datetime))
|
|
|
|
|
(target-branch (assq-ref query-parameters 'target_branch))
|
|
|
|
|
(target-datetime (assq-ref query-parameters 'target_datetime)))
|
|
|
|
|
`((h3
|
|
|
|
|
(a (@ (href ,(string-append
|
|
|
|
|
"/compare-by-datetime?"
|
|
|
|
|
(query-parameters->string
|
|
|
|
|
(filter (match-lambda
|
|
|
|
|
((key . _)
|
|
|
|
|
(member key '(base_branch
|
|
|
|
|
base_datetime
|
|
|
|
|
target_branch
|
|
|
|
|
target_datetime))))
|
|
|
|
|
query-parameters)))))
|
|
|
|
|
"Comparing "
|
|
|
|
|
(br)
|
|
|
|
|
(samp (*ENTITY* nbsp) (*ENTITY* nbsp)
|
|
|
|
|
,base-branch
|
|
|
|
|
,@(map (lambda _ '(*ENTITY* nbsp))
|
|
|
|
|
(iota (max
|
|
|
|
|
0
|
|
|
|
|
(- (string-length target-branch)
|
|
|
|
|
(string-length base-branch))))))
|
|
|
|
|
" at " ,(date->string base-datetime "~1 ~3")
|
|
|
|
|
" to "
|
|
|
|
|
(br)
|
|
|
|
|
(samp (*ENTITY* nbsp) (*ENTITY* nbsp)
|
|
|
|
|
,target-branch
|
|
|
|
|
,@(map (lambda _ '(*ENTITY* nbsp))
|
|
|
|
|
(iota (max 0
|
|
|
|
|
(- (string-length base-branch)
|
|
|
|
|
(string-length target-branch))))))
|
|
|
|
|
" at " ,(date->string target-datetime "~1 ~3"))))))))
|
2019-10-14 20:24:14 +02:00
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-md-12"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "well"))
|
|
|
|
|
(form
|
|
|
|
|
(@ (method "get")
|
|
|
|
|
(action "")
|
|
|
|
|
(class "form-horizontal"))
|
2020-11-21 21:29:14 +01:00
|
|
|
,@(compare-form-controls-for-mode mode query-parameters)
|
2020-11-19 22:02:47 +01:00
|
|
|
,(form-horizontal-control
|
|
|
|
|
"Build change" query-parameters
|
|
|
|
|
#:options '(("(none specified)" . "")
|
|
|
|
|
("Broken" . "broken")
|
|
|
|
|
("Fixed" . "fixed")
|
|
|
|
|
("Still working" . "still-working")
|
|
|
|
|
("Still failing" . "still-failing")
|
|
|
|
|
("Unknown" . "unknown"))
|
|
|
|
|
#:help-text '("Filter by the changes to the builds:"
|
|
|
|
|
(dl
|
|
|
|
|
(@ (class "dl-horizontal"))
|
|
|
|
|
(dt "Broken")
|
|
|
|
|
(dd
|
|
|
|
|
"There was a successful build against the base
|
|
|
|
|
derivation, but no successful build for the target derivation, and there's at
|
|
|
|
|
least one failed build.")
|
|
|
|
|
(dt "Fixed")
|
|
|
|
|
(dd
|
|
|
|
|
"No successful build for the base derivation and
|
|
|
|
|
at least one failed build, plus at least one successful build for the target
|
|
|
|
|
derivation")
|
|
|
|
|
(dt "Still working")
|
|
|
|
|
(dd
|
|
|
|
|
"At least one successful build for both the base
|
|
|
|
|
and target derivations")
|
|
|
|
|
(dt "Still broken")
|
|
|
|
|
(dd
|
|
|
|
|
"No successful builds and at least one failed builds for both the base and target derivations")
|
|
|
|
|
(dt "Unknown")
|
|
|
|
|
(dd
|
|
|
|
|
"No base and target derivation to compare, or not
|
2020-11-19 22:46:47 +01:00
|
|
|
enough builds to determine a change")))
|
2020-11-19 22:02:47 +01:00
|
|
|
#:allow-selecting-multiple-options #f)
|
2020-11-20 20:33:16 +01:00
|
|
|
,(form-horizontal-control
|
|
|
|
|
"After name" query-parameters
|
|
|
|
|
#:help-text
|
|
|
|
|
"List packages that are alphabetically after the given name.")
|
|
|
|
|
,(form-horizontal-control
|
|
|
|
|
"Limit results" query-parameters
|
|
|
|
|
#:help-text "The maximum number of results to return.")
|
|
|
|
|
,(form-horizontal-control
|
|
|
|
|
"All results" query-parameters
|
|
|
|
|
#:type "checkbox"
|
|
|
|
|
#:help-text "Return all results.")
|
2019-10-14 20:24:14 +02:00
|
|
|
(div (@ (class "form-group form-group-lg"))
|
|
|
|
|
(div (@ (class "col-sm-offset-2 col-sm-10"))
|
|
|
|
|
(button (@ (type "submit")
|
|
|
|
|
(class "btn btn-lg btn-primary"))
|
|
|
|
|
"Update results")))
|
|
|
|
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
|
|
|
|
(href ,(let ((query-parameter-string
|
|
|
|
|
(query-parameters->string query-parameters)))
|
|
|
|
|
(string-append
|
2020-10-23 13:47:43 +02:00
|
|
|
"/compare/package-derivations.json"
|
2019-10-14 20:24:14 +02:00
|
|
|
(if (string-null? query-parameter-string)
|
|
|
|
|
""
|
|
|
|
|
(string-append "?" query-parameter-string))))))
|
|
|
|
|
"View JSON")))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
2020-11-20 20:37:12 +01:00
|
|
|
(h1 "Package derivation changes")
|
2019-10-14 20:24:14 +02:00
|
|
|
,(if
|
|
|
|
|
(null? derivation-changes)
|
|
|
|
|
'(p "No derivation changes")
|
|
|
|
|
`(table
|
|
|
|
|
(@ (class "table")
|
|
|
|
|
(style "table-layout: fixed;"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th "Name")
|
|
|
|
|
(th "Version")
|
|
|
|
|
(th "System")
|
|
|
|
|
(th "Target")
|
2020-10-31 16:55:11 +01:00
|
|
|
(th (@ (class "col-xs-5")) "Derivations (with build statuses)")
|
2019-11-14 21:57:38 +01:00
|
|
|
(th "")))
|
2019-10-14 20:24:14 +02:00
|
|
|
(tbody
|
|
|
|
|
,@(append-map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((('name . name)
|
|
|
|
|
('version . version)
|
|
|
|
|
('base . base-derivations)
|
|
|
|
|
('target . target-derivations))
|
|
|
|
|
(let* ((system-and-versions
|
|
|
|
|
(delete-duplicates
|
|
|
|
|
(append (map (lambda (details)
|
|
|
|
|
(cons (assq-ref details 'system)
|
|
|
|
|
(assq-ref details 'target)))
|
|
|
|
|
(vector->list base-derivations))
|
|
|
|
|
(map (lambda (details)
|
|
|
|
|
(cons (assq-ref details 'system)
|
|
|
|
|
(assq-ref details 'target)))
|
|
|
|
|
(vector->list target-derivations)))))
|
|
|
|
|
(data-columns
|
|
|
|
|
(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((system . target)
|
2020-10-31 16:55:11 +01:00
|
|
|
(let* ((base-entry
|
|
|
|
|
(find (lambda (details)
|
|
|
|
|
(and (string=? (assq-ref details 'system) system)
|
|
|
|
|
(string=? (assq-ref details 'target) target)))
|
|
|
|
|
(vector->list base-derivations)))
|
|
|
|
|
(base-derivation-file-name
|
|
|
|
|
(assq-ref base-entry 'derivation-file-name))
|
|
|
|
|
(base-builds
|
|
|
|
|
(assq-ref base-entry 'builds))
|
|
|
|
|
(target-entry
|
|
|
|
|
(find (lambda (details)
|
|
|
|
|
(and (string=? (assq-ref details 'system) system)
|
|
|
|
|
(string=? (assq-ref details 'target) target)))
|
|
|
|
|
(vector->list target-derivations)))
|
|
|
|
|
(target-derivation-file-name
|
|
|
|
|
(assq-ref target-entry 'derivation-file-name))
|
|
|
|
|
(target-builds
|
|
|
|
|
(assq-ref target-entry 'builds)))
|
2019-10-14 20:24:14 +02:00
|
|
|
`((td (samp (@ (style "white-space: nowrap;"))
|
|
|
|
|
,system))
|
|
|
|
|
(td (samp (@ (style "white-space: nowrap;"))
|
|
|
|
|
,target))
|
|
|
|
|
(td ,@(if base-derivation-file-name
|
|
|
|
|
`((a (@ (style "display: block;")
|
|
|
|
|
(href ,base-derivation-file-name))
|
|
|
|
|
(span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
|
|
|
|
|
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
2020-10-31 16:55:11 +01:00
|
|
|
,@(build-statuses->build-status-labels
|
|
|
|
|
(vector->list base-builds))
|
2019-10-14 20:24:14 +02:00
|
|
|
,(display-store-item-short base-derivation-file-name)))
|
|
|
|
|
'())
|
|
|
|
|
,@(if target-derivation-file-name
|
|
|
|
|
`((a (@ (style "display: block; clear: left;")
|
|
|
|
|
(href ,target-derivation-file-name))
|
|
|
|
|
(span (@ (class "text-success glyphicon glyphicon-plus pull-left")
|
|
|
|
|
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
2020-10-31 16:55:11 +01:00
|
|
|
,@(build-statuses->build-status-labels
|
|
|
|
|
(vector->list target-builds))
|
|
|
|
|
,(display-store-item-short target-derivation-file-name)))
|
2019-11-14 21:57:38 +01:00
|
|
|
'()))
|
|
|
|
|
(td (@ (style "vertical-align: middle;"))
|
|
|
|
|
,@(if (and base-derivation-file-name
|
|
|
|
|
target-derivation-file-name)
|
|
|
|
|
`((a (@ (class "btn btn-sm btn-default")
|
|
|
|
|
(title "Compare")
|
|
|
|
|
(href
|
|
|
|
|
,(string-append
|
|
|
|
|
"/compare/derivation?"
|
|
|
|
|
"base_derivation="
|
|
|
|
|
base-derivation-file-name
|
|
|
|
|
"&target_derivation="
|
|
|
|
|
target-derivation-file-name)))
|
|
|
|
|
"⇕ Compare"))
|
2019-10-14 20:24:14 +02:00
|
|
|
'()))))))
|
|
|
|
|
system-and-versions)))
|
|
|
|
|
|
|
|
|
|
`((tr (td (@ (rowspan , (length system-and-versions)))
|
|
|
|
|
,name)
|
|
|
|
|
(td (@ (rowspan , (length system-and-versions)))
|
|
|
|
|
,version)
|
|
|
|
|
,@(car data-columns))
|
|
|
|
|
,@(map (lambda (data-row)
|
|
|
|
|
`(tr ,data-row))
|
|
|
|
|
(cdr data-columns))))))
|
|
|
|
|
(vector->list derivation-changes)))))))))))
|
|
|
|
|
|
|
|
|
|
(define (compare/packages query-parameters
|
|
|
|
|
base-packages-vhash
|
|
|
|
|
target-packages-vhash)
|
|
|
|
|
(define base-commit
|
|
|
|
|
(assq-ref query-parameters 'base_commit))
|
|
|
|
|
|
|
|
|
|
(define target-commit
|
|
|
|
|
(assq-ref query-parameters 'target_commit))
|
|
|
|
|
|
|
|
|
|
(define query-params
|
|
|
|
|
(string-append "?base_commit=" base-commit
|
|
|
|
|
"&target_commit=" target-commit))
|
|
|
|
|
|
|
|
|
|
(layout
|
|
|
|
|
#:body
|
|
|
|
|
`(,(header)
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "container"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h1 "Comparing "
|
2020-10-09 20:29:38 +02:00
|
|
|
(a (@ (href ,(string-append "/revision/" base-commit)))
|
|
|
|
|
(samp ,(string-take base-commit 8) "…"))
|
2019-10-14 20:24:14 +02:00
|
|
|
" and "
|
2020-10-09 20:29:38 +02:00
|
|
|
(a (@ (href ,(string-append "/revision/" target-commit)))
|
|
|
|
|
(samp ,(string-take target-commit 8) "…")))
|
2019-10-14 20:24:14 +02:00
|
|
|
(a (@ (class "btn btn-default btn-lg")
|
|
|
|
|
(href ,(string-append
|
|
|
|
|
"/compare/packages.json" query-params)))
|
|
|
|
|
"View JSON")))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h3 "Base ("
|
|
|
|
|
(samp ,base-commit)
|
|
|
|
|
")")
|
|
|
|
|
(p "Packages found in the base revision.")
|
|
|
|
|
(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th (@ (class "col-md-4")) "Name")
|
|
|
|
|
(th (@ (class "col-md-4")) "Version")
|
|
|
|
|
(th (@ (class "col-md-4")) "")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((name version)
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td ,version)
|
|
|
|
|
(td (@ (class "text-right"))
|
|
|
|
|
(a (@ (href ,(string-append
|
|
|
|
|
"/revision/" base-commit
|
|
|
|
|
"/package/" name "/" version)))
|
|
|
|
|
"More information")))))
|
|
|
|
|
(delete-duplicates
|
|
|
|
|
(map (lambda (data)
|
|
|
|
|
(take data 2))
|
|
|
|
|
(vlist->list base-packages-vhash))))))))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "row"))
|
|
|
|
|
(div
|
|
|
|
|
(@ (class "col-sm-12"))
|
|
|
|
|
(h3 "Target ("
|
|
|
|
|
(samp ,target-commit)
|
|
|
|
|
")")
|
|
|
|
|
(p "Packages found in the target revision.")
|
|
|
|
|
(table
|
|
|
|
|
(@ (class "table"))
|
|
|
|
|
(thead
|
|
|
|
|
(tr
|
|
|
|
|
(th (@ (class "col-md-4")) "Name")
|
|
|
|
|
(th (@ (class "col-md-4")) "Version")
|
|
|
|
|
(th (@ (class "col-md-4")) "")))
|
|
|
|
|
(tbody
|
|
|
|
|
,@(map
|
|
|
|
|
(match-lambda
|
|
|
|
|
((name version)
|
|
|
|
|
`(tr
|
|
|
|
|
(td ,name)
|
|
|
|
|
(td ,version)
|
|
|
|
|
(td (@ (class "text-right"))
|
|
|
|
|
(a (@ (href ,(string-append
|
|
|
|
|
"/revision/" target-commit
|
|
|
|
|
"/package/" name "/" version)))
|
|
|
|
|
"More information")))))
|
|
|
|
|
(delete-duplicates
|
|
|
|
|
(map (lambda (data)
|
|
|
|
|
(take data 2))
|
|
|
|
|
(vlist->list target-packages-vhash))))))))))))
|
