mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add a few new pages
For showing more information about builds, revisions and derivations.
This commit is contained in:
parent
e656b0967b
commit
b0eaf9cf7a
3 changed files with 131 additions and 0 deletions
|
@ -6,6 +6,7 @@
|
||||||
#:use-module (guix inferior)
|
#:use-module (guix inferior)
|
||||||
#:use-module (guix-data-service model utils)
|
#:use-module (guix-data-service model utils)
|
||||||
#:export (select-existing-package-entries
|
#:export (select-existing-package-entries
|
||||||
|
select-packages-in-revision
|
||||||
insert-into-package-entries
|
insert-into-package-entries
|
||||||
inferior-packages->package-ids))
|
inferior-packages->package-ids))
|
||||||
|
|
||||||
|
@ -28,6 +29,20 @@
|
||||||
"packages.derivation_id = vals.derivation_id"
|
"packages.derivation_id = vals.derivation_id"
|
||||||
";"))
|
";"))
|
||||||
|
|
||||||
|
(define (select-packages-in-revision conn commit-hash)
|
||||||
|
(define query
|
||||||
|
(string-append
|
||||||
|
"SELECT packages.name, packages.version, packages.derivation_id "
|
||||||
|
"FROM packages "
|
||||||
|
"INNER JOIN guix_revision_packages"
|
||||||
|
" ON packages.id = guix_revision_packages.package_id "
|
||||||
|
"INNER JOIN guix_revisions"
|
||||||
|
" ON guix_revision_packages.revision_id = guix_revisions.id "
|
||||||
|
"WHERE guix_revisions.commit = $1 "
|
||||||
|
"ORDER BY packages.name, packages.version"))
|
||||||
|
|
||||||
|
(exec-query conn query (list commit-hash)))
|
||||||
|
|
||||||
(define (insert-into-package-entries package-entries)
|
(define (insert-into-package-entries package-entries)
|
||||||
(string-append "INSERT INTO packages "
|
(string-append "INSERT INTO packages "
|
||||||
"(name, version, package_metadata_id, derivation_id) VALUES "
|
"(name, version, package_metadata_id, derivation_id) VALUES "
|
||||||
|
|
|
@ -28,6 +28,8 @@
|
||||||
#:use-module (squee)
|
#:use-module (squee)
|
||||||
#:use-module (guix-data-service comparison)
|
#:use-module (guix-data-service comparison)
|
||||||
#:use-module (guix-data-service model guix-revision)
|
#:use-module (guix-data-service model guix-revision)
|
||||||
|
#:use-module (guix-data-service model package)
|
||||||
|
#:use-module (guix-data-service model build)
|
||||||
#:use-module (guix-data-service jobs load-new-guix-revision)
|
#:use-module (guix-data-service jobs load-new-guix-revision)
|
||||||
#:use-module (guix-data-service web render)
|
#:use-module (guix-data-service web render)
|
||||||
#:use-module (guix-data-service web util)
|
#:use-module (guix-data-service web util)
|
||||||
|
@ -204,6 +206,19 @@
|
||||||
(apply render-html (index
|
(apply render-html (index
|
||||||
(most-recent-n-guix-revisions conn 10)
|
(most-recent-n-guix-revisions conn 10)
|
||||||
(most-recent-n-load-new-guix-revision-jobs conn 1000))))
|
(most-recent-n-load-new-guix-revision-jobs conn 1000))))
|
||||||
|
((GET "builds")
|
||||||
|
(apply render-html
|
||||||
|
(view-builds (select-build-stats conn)
|
||||||
|
(select-builds-with-context conn))))
|
||||||
|
((GET "revision" commit-hash)
|
||||||
|
(apply render-html
|
||||||
|
(view-revision commit-hash
|
||||||
|
(select-packages-in-revision conn
|
||||||
|
commit-hash))))
|
||||||
|
((GET "derivation" derivation-file-name ...)
|
||||||
|
(apply render-html
|
||||||
|
(view-derivation (string-append
|
||||||
|
"/" (string-join derivation-file-name "/")))))
|
||||||
((GET "compare")
|
((GET "compare")
|
||||||
(with-base-and-target-commits
|
(with-base-and-target-commits
|
||||||
request conn
|
request conn
|
||||||
|
|
|
@ -24,6 +24,9 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:export (index
|
#:export (index
|
||||||
|
view-revision
|
||||||
|
view-builds
|
||||||
|
view-derivation
|
||||||
compare
|
compare
|
||||||
compare/derivations
|
compare/derivations
|
||||||
compare/packages
|
compare/packages
|
||||||
|
@ -164,6 +167,104 @@
|
||||||
(td ,source))))
|
(td ,source))))
|
||||||
queued-guix-revisions)))))))))
|
queued-guix-revisions)))))))))
|
||||||
|
|
||||||
|
(define (view-revision commit-hash packages)
|
||||||
|
(layout
|
||||||
|
#:extra-headers
|
||||||
|
'((cache-control . ((max-age . 60))))
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container"))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(h1 "Revision " (samp ,commit-hash)))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(h3 "Packages")
|
||||||
|
(table
|
||||||
|
(@ (class "table"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-md-3")) "Name")
|
||||||
|
(th (@ (class "col-md-9")) "Version")))
|
||||||
|
(tbody
|
||||||
|
,@(map
|
||||||
|
(match-lambda
|
||||||
|
((name version rest ...)
|
||||||
|
`(tr
|
||||||
|
(td ,name)
|
||||||
|
(td ,version))))
|
||||||
|
packages))))))))
|
||||||
|
|
||||||
|
(define (view-builds stats builds)
|
||||||
|
(layout
|
||||||
|
#:extra-headers
|
||||||
|
'((cache-control . ((max-age . 60))))
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container"))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(h1 "Builds")
|
||||||
|
(table
|
||||||
|
(@ (class "table"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-md-2")) "Status")
|
||||||
|
(th (@ (class "col-md-2")) "Count")))
|
||||||
|
(tbody
|
||||||
|
,@(map
|
||||||
|
(match-lambda
|
||||||
|
((status count)
|
||||||
|
`(tr
|
||||||
|
(td ,status)
|
||||||
|
(td ,count))))
|
||||||
|
stats))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(table
|
||||||
|
(@ (class "table"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-xs-2")) "Status")
|
||||||
|
(th (@ (class "col-xs-9")) "Derivation")
|
||||||
|
(th (@ (class "col-xs-1")) "Started at")
|
||||||
|
(th (@ (class "col-xs-1")) "Finished at")
|
||||||
|
(th (@ (class "col-xs-1")) "")))
|
||||||
|
(tbody
|
||||||
|
,@(map
|
||||||
|
(match-lambda
|
||||||
|
((build-id build-server-url derivation-file-name
|
||||||
|
status-fetched-at starttime stoptime status)
|
||||||
|
`(tr
|
||||||
|
(td (@ (class ,(cond
|
||||||
|
((string=? status "succeeded")
|
||||||
|
"bg-success")
|
||||||
|
((string=? status "failed")
|
||||||
|
"bg-danger")
|
||||||
|
(else ""))))
|
||||||
|
,status)
|
||||||
|
(td ,derivation-file-name)
|
||||||
|
(td ,starttime)
|
||||||
|
(td ,stoptime)
|
||||||
|
(td (a (@ (href ,(simple-format
|
||||||
|
#f "~Abuild/~A" build-server-url build-id)))
|
||||||
|
"View build on " ,build-server-url)))))
|
||||||
|
builds))))))))
|
||||||
|
|
||||||
|
(define (view-derivation derivation-file-name)
|
||||||
|
(layout
|
||||||
|
#:extra-headers
|
||||||
|
'((cache-control . ((max-age . 60))))
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container"))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(h1 "Derivation " (samp ,derivation-file-name)))))))
|
||||||
|
|
||||||
(define (compare base-commit
|
(define (compare base-commit
|
||||||
target-commit
|
target-commit
|
||||||
new-packages
|
new-packages
|
||||||
|
|
Loading…
Reference in a new issue