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
3 changed files with 89 additions and 7 deletions
|
@ -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))
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue