diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/web/revision/controller.scm | 37 | ||||
| -rw-r--r-- | guix-data-service/web/revision/html.scm | 51 |
2 files changed, 88 insertions, 0 deletions
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index 4dda08c..0815356 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -34,6 +34,7 @@ #:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-status) #:use-module (guix-data-service model channel-news) + #:use-module (guix-data-service model channel-instance) #:use-module (guix-data-service model package) #:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-repository) @@ -225,6 +226,15 @@ (render-unknown-revision mime-types conn commit-hash))) + (('GET "revision" commit-hash "channel-instances") + (if (guix-commit-exists? conn commit-hash) + (render-revision-channel-instances mime-types + conn + commit-hash + #:path-base path) + (render-unknown-revision mime-types + conn + commit-hash))) (('GET "revision" commit-hash "package-reproducibility") (if (guix-commit-exists? conn commit-hash) (render-revision-package-reproduciblity mime-types @@ -378,6 +388,33 @@ #:header-text header-text #:header-link header-link)))))) +(define* (render-revision-channel-instances mime-types + conn + commit-hash + #:key + (path-base "/revision/") + (header-text + `("Revision " (samp ,commit-hash))) + (header-link + (string-append "/revision/" + commit-hash))) + (let ((channel-instances + (select-channel-instances-for-guix-revision conn commit-hash))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + '())) ; TODO + (else + (render-html + #:sxml (view-revision-channel-instances + commit-hash + channel-instances + #:path-base path-base + #:header-text header-text + #:header-link header-link)))))) + (define* (render-revision-package-reproduciblity mime-types conn commit-hash diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm index 959205d..c8a0672 100644 --- a/guix-data-service/web/revision/html.scm +++ b/guix-data-service/web/revision/html.scm @@ -36,6 +36,7 @@ view-revision-derivations view-revision-derivation-outputs view-revision-system-tests + view-revision-channel-instances view-revision-builds view-revision-lint-warnings unknown-revision)) @@ -723,6 +724,56 @@ builds))))) system-tests))))))))) +(define* (view-revision-channel-instances commit-hash + channel-instances + #:key (path-base "/revision/") + header-text header-link) + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (h3 (a (@ (style "white-space: nowrap;") + (href ,header-link)) + ,@header-text)))) + (div + (@ (class "row")) + (div + (@ (class "col-md-12")) + (h1 "Channel instances") + (table + (@ (class "table")) + (thead + (tr + (th "System") + (th "Derivation") + (th "Build status"))) + (tbody + ,@(map + (match-lambda + ((system derivation-file-name builds) + `(tr + (td (@ (style "font-family: monospace;")) + ,system) + (td (a (@ (href ,derivation-file-name)) + ,(display-store-item-short derivation-file-name))) + (td ,@(map + (lambda (build) + (let ((build-server-id + (assoc-ref build "build_server_id"))) + `(a (@ (href + ,(simple-format + #f "/build-server/~A/build?derivation_file_name=~A" + build-server-id + derivation-file-name))) + ,(build-status-alist->build-icon build)))) + builds))))) + channel-instances))))))))) + (define* (view-revision-package-reproducibility revision-commit-hash output-consistency) (layout |