diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index bd09d49..3fc6215 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -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)) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 0d6e2e1..5591488 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -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)))) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 019aa49..6af3142 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -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