mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add a new page comparing the derivations of two revisions
This commit is contained in:
parent
a5cc703e18
commit
e68142cf91
|
@ -7,7 +7,7 @@
|
||||||
#:use-module (guix-data-service model derivation)
|
#:use-module (guix-data-service model derivation)
|
||||||
#:export (package-data->package-data-vhashes
|
#:export (package-data->package-data-vhashes
|
||||||
package-differences-data
|
package-differences-data
|
||||||
package-data-vhashes->derivations
|
package-data-vhash->derivations
|
||||||
package-data-vhashes->new-packages
|
package-data-vhashes->new-packages
|
||||||
package-data-vhashes->removed-packages
|
package-data-vhashes->removed-packages
|
||||||
package-data-version-changes
|
package-data-version-changes
|
||||||
|
@ -47,9 +47,7 @@ ORDER BY base_packages.name, base_packages.version, target_packages.name, target
|
||||||
(list vlist-null vlist-null)
|
(list vlist-null vlist-null)
|
||||||
package-data)))
|
package-data)))
|
||||||
|
|
||||||
(define (package-data-vhashes->derivations conn
|
(define (package-data-vhash->derivations conn packages-vhash)
|
||||||
base-packages-vhash
|
|
||||||
target-packages-vhash)
|
|
||||||
(define (vhash->derivation-ids vhash)
|
(define (vhash->derivation-ids vhash)
|
||||||
(vhash-fold (lambda (key value result)
|
(vhash-fold (lambda (key value result)
|
||||||
(cons (third value)
|
(cons (third value)
|
||||||
|
@ -58,9 +56,7 @@ ORDER BY base_packages.name, base_packages.version, target_packages.name, target
|
||||||
vhash))
|
vhash))
|
||||||
|
|
||||||
(let* ((derivation-ids
|
(let* ((derivation-ids
|
||||||
(delete-duplicates
|
(vhash->derivation-ids packages-vhash))
|
||||||
(append (vhash->derivation-ids base-packages-vhash)
|
|
||||||
(vhash->derivation-ids target-packages-vhash))))
|
|
||||||
(derivation-data
|
(derivation-data
|
||||||
(select-derivations-by-id conn derivation-ids)))
|
(select-derivations-by-id conn derivation-ids)))
|
||||||
derivation-data))
|
derivation-data))
|
||||||
|
|
|
@ -100,5 +100,42 @@
|
||||||
removed-packages
|
removed-packages
|
||||||
version-changes
|
version-changes
|
||||||
other-changes)))))))))
|
other-changes)))))))))
|
||||||
|
((GET "compare" "derivations")
|
||||||
|
(let ((base-commit (-> request
|
||||||
|
request-uri
|
||||||
|
uri-query
|
||||||
|
parse-query-string
|
||||||
|
(cut assoc-ref <> "base_commit")))
|
||||||
|
(target-commit (-> request
|
||||||
|
request-uri
|
||||||
|
uri-query
|
||||||
|
parse-query-string
|
||||||
|
(cut assoc-ref <> "target_commit"))))
|
||||||
|
(let ((base-revision-id (commit->revision-id conn base-commit))
|
||||||
|
(target-revision-id (commit->revision-id conn target-commit)))
|
||||||
|
(cond
|
||||||
|
((eq? base-revision-id #f)
|
||||||
|
(apply render-html
|
||||||
|
(compare-unknown-commit base-commit)))
|
||||||
|
((eq? target-revision-id #f)
|
||||||
|
(apply render-html
|
||||||
|
(compare-unknown-commit target-commit)))
|
||||||
|
(else
|
||||||
|
(let-values
|
||||||
|
(((base-packages-vhash target-packages-vhash)
|
||||||
|
(package-data->package-data-vhashes
|
||||||
|
(package-differences-data conn
|
||||||
|
base-revision-id
|
||||||
|
target-revision-id))))
|
||||||
|
(apply render-html
|
||||||
|
(compare/derivations
|
||||||
|
base-commit
|
||||||
|
target-commit
|
||||||
|
(package-data-vhash->derivations
|
||||||
|
conn
|
||||||
|
base-packages-vhash)
|
||||||
|
(package-data-vhash->derivations
|
||||||
|
conn
|
||||||
|
target-packages-vhash)))))))))
|
||||||
((GET path ...)
|
((GET path ...)
|
||||||
(render-static-asset request))))
|
(render-static-asset request))))
|
||||||
|
|
|
@ -24,6 +24,7 @@
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:export (index
|
#:export (index
|
||||||
compare
|
compare
|
||||||
|
compare/derivations
|
||||||
compare-unknown-commit
|
compare-unknown-commit
|
||||||
error-page))
|
error-page))
|
||||||
|
|
||||||
|
@ -226,6 +227,54 @@
|
||||||
(td ,version))))
|
(td ,version))))
|
||||||
other-changes)))))))))
|
other-changes)))))))))
|
||||||
|
|
||||||
|
(define (compare/derivations base-commit
|
||||||
|
target-commit
|
||||||
|
base-derivations
|
||||||
|
target-derivations)
|
||||||
|
(layout
|
||||||
|
#:extra-headers
|
||||||
|
'((cache-control . ((max-age . 60))))
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container"))
|
||||||
|
(h1 "Comparing "
|
||||||
|
(samp ,(string-take base-commit 8) "…")
|
||||||
|
" and "
|
||||||
|
(samp ,(string-take target-commit 8) "…"))
|
||||||
|
(h3 "Base ("
|
||||||
|
(samp ,base-commit)
|
||||||
|
")")
|
||||||
|
(p "Derivations found only in the base revision.")
|
||||||
|
(table
|
||||||
|
(@ (class "table"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-md-12")) "File Name")))
|
||||||
|
(tbody
|
||||||
|
,@(map
|
||||||
|
(match-lambda
|
||||||
|
((id file-name)
|
||||||
|
`(tr
|
||||||
|
(td ,file-name))))
|
||||||
|
base-derivations)))
|
||||||
|
(h3 "Target ("
|
||||||
|
(samp ,target-commit)
|
||||||
|
")")
|
||||||
|
(p "Derivations found only in the target revision.")
|
||||||
|
(table
|
||||||
|
(@ (class "table"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-md-12")) "File Name")))
|
||||||
|
(tbody
|
||||||
|
,@(map
|
||||||
|
(match-lambda
|
||||||
|
((id file-name)
|
||||||
|
`(tr
|
||||||
|
(td ,file-name))))
|
||||||
|
target-derivations)))))))
|
||||||
|
|
||||||
(define (compare-unknown-commit commit)
|
(define (compare-unknown-commit commit)
|
||||||
(layout
|
(layout
|
||||||
#:body
|
#:body
|
||||||
|
|
Loading…
Reference in a new issue