cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add a page to show system tests for a revision

Browse source
This commit is contained in:
Christopher Baines 2020-02-03 09:58:02 +01:00
parent 00d9664714
commit 19630014a3
3 changed files with 177 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

75
guix-data-service/web/revision/html.scm
View file

@ -35,6 +35,7 @@
view-revision-packages
view-revision-derivations
view-revision-derivation-outputs
view-revision-system-tests
view-revision-builds
view-revision-lint-warnings
unknown-revision))
@ -648,6 +649,80 @@
"Next page")))
'())))))
(define* (view-revision-system-tests commit-hash
system-tests
git-repositories
#: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 "System tests")
(table
(@ (class "table"))
(thead
(tr
(th "Name")
(th "Description")
(th "Location")
(th "Derivation")
(th "Build status")))
(tbody
,@(map
(match-lambda
((name description
file line column-number
derivation-file-name
builds)
`(tr
(td ,name)
(td
,(stexi->shtml
(texi-fragment->stexi description)))
(td ,@(map
(match-lambda
((id label url cgit-url-base)
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
`(a (@ (href
,(string-append
cgit-url-base "tree/"
file "?id=" commit-hash
"#n" (number->string line))))
,file
" (line: " ,line
", column: " ,column-number ")")
'())))
git-repositories))
(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))))
(peek builds))))))
system-tests)))))))))
(define* (view-revision-package-reproducibility revision-commit-hash
output-consistency)
(layout