guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add a new page comparing the derivations of two revisions

This commit is contained in:
Christopher Baines 2019-02-24 15:38:08 +00:00
parent a5cc703e18
commit e68142cf91
No known key found for this signature in database
GPG Key ID: 5E28A33B0B84F577
3 changed files with 89 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
guix-data-service/comparison.scm
View File

@ -7,7 +7,7 @@
#:use-module (guix-data-service model derivation)
#:export (package-data->package-data-vhashes
package-differences-data
package-data-vhashes->derivations
package-data-vhash->derivations
package-data-vhashes->new-packages
package-data-vhashes->removed-packages
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)
package-data)))
(define (package-data-vhashes->derivations conn
base-packages-vhash
target-packages-vhash)
(define (package-data-vhash->derivations conn packages-vhash)
(define (vhash->derivation-ids vhash)
(vhash-fold (lambda (key value result)
(cons (third value)
@ -58,9 +56,7 @@ ORDER BY base_packages.name, base_packages.version, target_packages.name, target
vhash))
(let* ((derivation-ids
(delete-duplicates
(append (vhash->derivation-ids base-packages-vhash)
(vhash->derivation-ids target-packages-vhash))))
(vhash->derivation-ids packages-vhash))
(derivation-data
(select-derivations-by-id conn derivation-ids)))
derivation-data))

37
guix-data-service/web/controller.scm
View File

@ -100,5 +100,42 @@
removed-packages
version-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 ...)
(render-static-asset request))))

49
guix-data-service/web/view/html.scm
View File

@ -24,6 +24,7 @@
#:use-module (srfi srfi-19)
#:export (index
compare
compare/derivations
compare-unknown-commit
error-page))
@ -226,6 +227,54 @@
(td ,version))))
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)
(layout
#:body