Move the derivations off the compare page
To the compare/derivations page. Previously, the compare/derivations page was comparing more than the derivations, notably the package metadata. This change avoids that, and also reduces the information overload on the compare page.
This commit is contained in:
parent
bb02511607
commit
d07e3d9ba8
2 changed files with 78 additions and 163 deletions
|
|
@ -358,9 +358,6 @@
|
||||||
target-packages-vhash))
|
target-packages-vhash))
|
||||||
(version-changes
|
(version-changes
|
||||||
(package-data-version-changes base-packages-vhash
|
(package-data-version-changes base-packages-vhash
|
||||||
target-packages-vhash))
|
|
||||||
(derivation-changes
|
|
||||||
(package-data-derivation-changes base-packages-vhash
|
|
||||||
target-packages-vhash)))
|
target-packages-vhash)))
|
||||||
(case (most-appropriate-mime-type
|
(case (most-appropriate-mime-type
|
||||||
'(application/json text/html)
|
'(application/json text/html)
|
||||||
|
|
@ -369,8 +366,7 @@
|
||||||
(render-json
|
(render-json
|
||||||
`((new-packages . ,(list->vector new-packages))
|
`((new-packages . ,(list->vector new-packages))
|
||||||
(removed-packages . ,(list->vector removed-packages))
|
(removed-packages . ,(list->vector removed-packages))
|
||||||
(version-changes . ,version-changes)
|
(version-changes . ,(list->vector version-changes)))
|
||||||
(derivation-changes . ,derivation-changes))
|
|
||||||
#:extra-headers http-headers-for-unchanging-content))
|
#:extra-headers http-headers-for-unchanging-content))
|
||||||
(else
|
(else
|
||||||
(render-html
|
(render-html
|
||||||
|
|
@ -378,8 +374,7 @@
|
||||||
target-commit
|
target-commit
|
||||||
new-packages
|
new-packages
|
||||||
removed-packages
|
removed-packages
|
||||||
version-changes
|
version-changes)
|
||||||
derivation-changes)
|
|
||||||
#:extra-headers http-headers-for-unchanging-content))))))
|
#:extra-headers http-headers-for-unchanging-content))))))
|
||||||
|
|
||||||
(define (render-compare/derivations mime-types
|
(define (render-compare/derivations mime-types
|
||||||
|
|
@ -409,7 +404,6 @@
|
||||||
query-parameters
|
query-parameters
|
||||||
(valid-systems conn)
|
(valid-systems conn)
|
||||||
build-status-strings
|
build-status-strings
|
||||||
'()
|
|
||||||
'()))))
|
'()))))
|
||||||
|
|
||||||
(let ((base-commit (assq-ref query-parameters 'base_commit))
|
(let ((base-commit (assq-ref query-parameters 'base_commit))
|
||||||
|
|
@ -423,33 +417,15 @@
|
||||||
(package-differences-data conn
|
(package-differences-data conn
|
||||||
(commit->revision-id conn base-commit)
|
(commit->revision-id conn base-commit)
|
||||||
(commit->revision-id conn target-commit)))))
|
(commit->revision-id conn target-commit)))))
|
||||||
(let ((base-derivations
|
(let ((derivation-changes
|
||||||
(package-data-vhash->derivations-and-build-status
|
(package-data-derivation-changes base-packages-vhash
|
||||||
conn
|
target-packages-vhash)))
|
||||||
base-packages-vhash
|
|
||||||
systems
|
|
||||||
targets
|
|
||||||
build-statuses))
|
|
||||||
(target-derivations
|
|
||||||
(package-data-vhash->derivations-and-build-status
|
|
||||||
conn
|
|
||||||
target-packages-vhash
|
|
||||||
systems
|
|
||||||
targets
|
|
||||||
build-statuses)))
|
|
||||||
(case (most-appropriate-mime-type
|
(case (most-appropriate-mime-type
|
||||||
'(application/json text/html)
|
'(application/json text/html)
|
||||||
mime-types)
|
mime-types)
|
||||||
((application/json)
|
((application/json)
|
||||||
(render-json
|
(render-json
|
||||||
`((base . ((commit . ,base-commit)
|
derivation-changes
|
||||||
(derivations . ,(list->vector
|
|
||||||
(derivations->alist
|
|
||||||
base-derivations)))))
|
|
||||||
(target . ((commit . ,target-commit)
|
|
||||||
(derivations . ,(list->vector
|
|
||||||
(derivations->alist
|
|
||||||
target-derivations))))))
|
|
||||||
#:extra-headers http-headers-for-unchanging-content))
|
#:extra-headers http-headers-for-unchanging-content))
|
||||||
(else
|
(else
|
||||||
(render-html
|
(render-html
|
||||||
|
|
@ -457,8 +433,7 @@
|
||||||
query-parameters
|
query-parameters
|
||||||
(valid-systems conn)
|
(valid-systems conn)
|
||||||
build-status-strings
|
build-status-strings
|
||||||
base-derivations
|
derivation-changes)
|
||||||
target-derivations)
|
|
||||||
#:extra-headers http-headers-for-unchanging-content))))))))
|
#:extra-headers http-headers-for-unchanging-content))))))))
|
||||||
|
|
||||||
(define (render-compare/packages mime-types
|
(define (render-compare/packages mime-types
|
||||||
|
|
|
||||||
|
|
@ -1095,8 +1095,7 @@
|
||||||
target-commit
|
target-commit
|
||||||
new-packages
|
new-packages
|
||||||
removed-packages
|
removed-packages
|
||||||
version-changes
|
version-changes)
|
||||||
derivation-changes)
|
|
||||||
(define query-params
|
(define query-params
|
||||||
(string-append "?base_commit=" base-commit
|
(string-append "?base_commit=" base-commit
|
||||||
"&target_commit=" target-commit))
|
"&target_commit=" target-commit))
|
||||||
|
|
@ -1210,7 +1209,75 @@
|
||||||
" (old)"
|
" (old)"
|
||||||
" (new)"))))
|
" (new)"))))
|
||||||
versions))))))
|
versions))))))
|
||||||
version-changes))))))
|
version-changes))))))))))
|
||||||
|
|
||||||
|
(define (compare/derivations query-parameters
|
||||||
|
valid-systems
|
||||||
|
valid-build-statuses
|
||||||
|
derivation-changes)
|
||||||
|
(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 "
|
||||||
|
(samp ,(string-take base-commit 8) "…")
|
||||||
|
" and "
|
||||||
|
(samp ,(string-take target-commit 8) "…"))
|
||||||
|
'("Comparing derivations")))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-12"))
|
||||||
|
(div
|
||||||
|
(@ (class "well"))
|
||||||
|
(form
|
||||||
|
(@ (method "get")
|
||||||
|
(action "")
|
||||||
|
(class "form-horizontal"))
|
||||||
|
,(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")
|
||||||
|
,(form-horizontal-control
|
||||||
|
"System" query-parameters
|
||||||
|
#:options valid-systems
|
||||||
|
#:help-text "Only include derivations for this system."
|
||||||
|
#:font-family "monospace")
|
||||||
|
,(form-horizontal-control
|
||||||
|
"Target" query-parameters
|
||||||
|
#:options valid-systems
|
||||||
|
#:help-text "Only include derivations that are build for this system."
|
||||||
|
#:font-family "monospace")
|
||||||
|
,(form-horizontal-control
|
||||||
|
"Build status" query-parameters
|
||||||
|
#:options valid-build-statuses
|
||||||
|
#:help-text "Only include derivations which have this build status.")
|
||||||
|
(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/derivations.json"
|
||||||
|
(if (string-null? query-parameter-string)
|
||||||
|
""
|
||||||
|
(string-append "?" query-parameter-string))))))
|
||||||
|
"View JSON")))))
|
||||||
(div
|
(div
|
||||||
(@ (class "row"))
|
(@ (class "row"))
|
||||||
(div
|
(div
|
||||||
|
|
@ -1292,133 +1359,6 @@
|
||||||
(cdr data-columns))))))
|
(cdr data-columns))))))
|
||||||
(vector->list derivation-changes)))))))))))
|
(vector->list derivation-changes)))))))))))
|
||||||
|
|
||||||
(define (compare/derivations query-parameters
|
|
||||||
valid-systems
|
|
||||||
valid-build-statuses
|
|
||||||
base-derivations
|
|
||||||
target-derivations)
|
|
||||||
(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 "
|
|
||||||
(samp ,(string-take base-commit 8) "…")
|
|
||||||
" and "
|
|
||||||
(samp ,(string-take target-commit 8) "…"))
|
|
||||||
'("Comparing derivations")))))
|
|
||||||
(div
|
|
||||||
(@ (class "row"))
|
|
||||||
(div
|
|
||||||
(@ (class "col-md-12"))
|
|
||||||
(div
|
|
||||||
(@ (class "well"))
|
|
||||||
(form
|
|
||||||
(@ (method "get")
|
|
||||||
(action "")
|
|
||||||
(class "form-horizontal"))
|
|
||||||
,(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")
|
|
||||||
,(form-horizontal-control
|
|
||||||
"System" query-parameters
|
|
||||||
#:options valid-systems
|
|
||||||
#:help-text "Only include derivations for this system."
|
|
||||||
#:font-family "monospace")
|
|
||||||
,(form-horizontal-control
|
|
||||||
"Target" query-parameters
|
|
||||||
#:options valid-systems
|
|
||||||
#:help-text "Only include derivations that are build for this system."
|
|
||||||
#:font-family "monospace")
|
|
||||||
,(form-horizontal-control
|
|
||||||
"Build status" query-parameters
|
|
||||||
#:options valid-build-statuses
|
|
||||||
#:help-text "Only include derivations which have this build status.")
|
|
||||||
(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/derivations.json"
|
|
||||||
(if (string-null? query-parameter-string)
|
|
||||||
""
|
|
||||||
(string-append "?" query-parameter-string))))))
|
|
||||||
"View JSON")))))
|
|
||||||
(div
|
|
||||||
(@ (class "row"))
|
|
||||||
(div
|
|
||||||
(@ (class "col-sm-12"))
|
|
||||||
(h3 "Base"
|
|
||||||
,@(let ((base-commit (assq-ref query-parameters 'base_commit)))
|
|
||||||
(if (string? base-commit)
|
|
||||||
`(" (" (samp ,base-commit) ")")
|
|
||||||
'())))
|
|
||||||
(p "Derivations found only in the base revision.")
|
|
||||||
(table
|
|
||||||
(@ (class "table"))
|
|
||||||
(thead
|
|
||||||
(tr
|
|
||||||
(th (@ (class "col-md-6")) "File Name")
|
|
||||||
(th (@ (class "col-md-2")) "System")
|
|
||||||
(th (@ (class "col-md-2")) "Target")
|
|
||||||
(th (@ (class "col-md-4")) "Build status")))
|
|
||||||
(tbody
|
|
||||||
,@(map
|
|
||||||
(match-lambda
|
|
||||||
((file-name system target build-status)
|
|
||||||
`(tr
|
|
||||||
(td (a (@ (href ,file-name))
|
|
||||||
,(display-store-item-short file-name)))
|
|
||||||
(td (samp ,system))
|
|
||||||
(td (samp ,target))
|
|
||||||
(td ,(build-status-span build-status)))))
|
|
||||||
base-derivations)))))
|
|
||||||
(div
|
|
||||||
(@ (class "row"))
|
|
||||||
(div
|
|
||||||
(@ (class "col-sm-12"))
|
|
||||||
(h3 "Target"
|
|
||||||
,@(let ((target-commit (assq-ref query-parameters 'target_commit)))
|
|
||||||
(if (string? target-commit)
|
|
||||||
`(" (" (samp ,target-commit) ")")
|
|
||||||
'())))
|
|
||||||
(p "Derivations found only in the target revision.")
|
|
||||||
(table
|
|
||||||
(@ (class "table"))
|
|
||||||
(thead
|
|
||||||
(tr
|
|
||||||
(th (@ (class "col-md-8")) "File Name")
|
|
||||||
(th (@ (class "col-md-2")) "System")
|
|
||||||
(th (@ (class "col-md-2")) "Target")
|
|
||||||
(th (@ (class "col-md-4")) "Build status")))
|
|
||||||
(tbody
|
|
||||||
,@(map
|
|
||||||
(match-lambda
|
|
||||||
((file-name system target build-status)
|
|
||||||
`(tr
|
|
||||||
(td (a (@ (href ,file-name))
|
|
||||||
,(display-store-item-short file-name)))
|
|
||||||
(td (samp ,system))
|
|
||||||
(td (samp ,target))
|
|
||||||
(td ,(build-status-span build-status)))))
|
|
||||||
target-derivations)))))))))
|
|
||||||
|
|
||||||
(define (compare/packages base-commit
|
(define (compare/packages base-commit
|
||||||
target-commit
|
target-commit
|
||||||
base-packages-vhash
|
base-packages-vhash
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue