diff options
author | Christopher Baines <mail@cbaines.net> | 2019-03-06 22:59:27 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-03-06 22:59:27 +0000 |
commit | b0eaf9cf7a8a60a7a2a4df2f44815e20ccc4720d (patch) | |
tree | ead9307b2ccb568b038fc16d237b2b43df81d66c /guix-data-service | |
parent | e656b0967be7fa9753edd498ce225b74073b87af (diff) | |
download | data-service-b0eaf9cf7a8a60a7a2a4df2f44815e20ccc4720d.tar data-service-b0eaf9cf7a8a60a7a2a4df2f44815e20ccc4720d.tar.gz |
Add a few new pages
For showing more information about builds, revisions and derivations.
Diffstat (limited to 'guix-data-service')
-rw-r--r-- | guix-data-service/model/package.scm | 15 | ||||
-rw-r--r-- | guix-data-service/web/controller.scm | 15 | ||||
-rw-r--r-- | guix-data-service/web/view/html.scm | 101 |
3 files changed, 131 insertions, 0 deletions
diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index c90fb04..b5a38fa 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -6,6 +6,7 @@ #:use-module (guix inferior) #:use-module (guix-data-service model utils) #:export (select-existing-package-entries + select-packages-in-revision insert-into-package-entries inferior-packages->package-ids)) @@ -28,6 +29,20 @@ "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) (string-append "INSERT INTO packages " "(name, version, package_metadata_id, derivation_id) VALUES " diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 145cc01..7297dc4 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -28,6 +28,8 @@ #:use-module (squee) #:use-module (guix-data-service comparison) #: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 web render) #:use-module (guix-data-service web util) @@ -204,6 +206,19 @@ (apply render-html (index (most-recent-n-guix-revisions conn 10) (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") (with-base-and-target-commits request conn diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index d998c79..81d4bec 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -24,6 +24,9 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:export (index + view-revision + view-builds + view-derivation compare compare/derivations compare/packages @@ -164,6 +167,104 @@ (td ,source)))) 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 target-commit new-packages |