Add a page for channel instance derivations

This commit is contained in:
Christopher Baines 2020-02-12 08:37:57 +00:00
parent 7306df0a0f
commit 5cf186e5b1
2 changed files with 88 additions and 0 deletions

View file

@ -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

View file

@ -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