diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-02-24 15:38:08 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-02-24 15:38:08 +0000 |
| commit | e68142cf910b7a12b2eadda0c973de4541a47a29 (patch) | |
| tree | 1cc76f68ea9e2a02a32fec416f73d6e11f57bfac /guix-data-service/web | |
| parent | a5cc703e18b249fa2d10b8952bb489d20752f836 (diff) | |
| download | data-service-e68142cf910b7a12b2eadda0c973de4541a47a29.tar data-service-e68142cf910b7a12b2eadda0c973de4541a47a29.tar.gz | |
Add a new page comparing the derivations of two revisions
Diffstat (limited to 'guix-data-service/web')
| -rw-r--r-- | guix-data-service/web/controller.scm | 37 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 49 |
2 files changed, 86 insertions, 0 deletions
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 |