From 2a3ee20a9973657b9cf0b4514ad42e3414d6b57e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 24 Nov 2019 20:42:37 +0000 Subject: Extract the builds page in to it's own set of modules To allow for expanding it, without cluttering the root controller. --- Makefile.am | 2 + guix-data-service/web/build/controller.scm | 40 +++++++++++++++ guix-data-service/web/build/html.scm | 80 ++++++++++++++++++++++++++++++ guix-data-service/web/controller.scm | 5 +- guix-data-service/web/view/html.scm | 58 ---------------------- 5 files changed, 124 insertions(+), 61 deletions(-) create mode 100644 guix-data-service/web/build/controller.scm create mode 100644 guix-data-service/web/build/html.scm diff --git a/Makefile.am b/Makefile.am index 55083fd..9737b0b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -94,6 +94,8 @@ SOURCES = \ guix-data-service/web/compare/controller.scm \ guix-data-service/web/compare/html.scm \ guix-data-service/web/controller.scm \ + guix-data-service/web/build/controller.scm \ + guix-data-service/web/build/html.scm \ guix-data-service/web/build-server/controller.scm \ guix-data-service/web/jobs/controller.scm \ guix-data-service/web/jobs/html.scm \ diff --git a/guix-data-service/web/build/controller.scm b/guix-data-service/web/build/controller.scm new file mode 100644 index 0000000..413f381 --- /dev/null +++ b/guix-data-service/web/build/controller.scm @@ -0,0 +1,40 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(define-module (guix-data-service web build controller) + #:use-module (ice-9 match) + #:use-module (guix-data-service web render) + #:use-module (guix-data-service web query-parameters) + #:use-module (guix-data-service model build) + #:use-module (guix-data-service web build html) + #:export (build-controller)) + +(define (build-controller request + method-and-path-components + mime-types + body + conn) + (match method-and-path-components + (('GET "builds") + (render-builds mime-types + conn)) + (_ #f))) + +(define (render-builds mime-types conn) + (render-html + #:sxml (view-builds (select-build-stats conn) + (select-builds-with-context conn)))) diff --git a/guix-data-service/web/build/html.scm b/guix-data-service/web/build/html.scm new file mode 100644 index 0000000..61382aa --- /dev/null +++ b/guix-data-service/web/build/html.scm @@ -0,0 +1,80 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(define-module (guix-data-service web build html) + #:use-module (ice-9 match) + #:use-module (guix-data-service web query-parameters) + #:use-module (guix-data-service web view html) + #:export (view-builds)) + +(define (view-builds stats builds) + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (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 ,(build-status-span status)) + (td ,count)))) + stats))))) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (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 + timestamp status) + `(tr + (td (@ (class "text-center")) + ,(build-status-span status)) + (td (a (@ (href ,derivation-file-name)) + ,(display-store-item-short derivation-file-name))) + (td ,timestamp) + (td (a (@ (href ,(simple-format + #f "~Abuild/~A" + build-server-url + (string-drop + derivation-file-name + (string-length "/gnu/store/"))))) + "View build on " ,build-server-url))))) + builds))))))))) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 745537d..4397577 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -52,6 +52,7 @@ #:use-module (guix-data-service web sxml) #:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web util) + #:use-module (guix-data-service web build controller) #:use-module (guix-data-service web revision controller) #:use-module (guix-data-service web jobs controller) #:use-module (guix-data-service web view html) @@ -269,9 +270,7 @@ conn (first git-repository-details)))) (all-git-repositories conn))))) (('GET "builds") - (render-html - #:sxml (view-builds (select-build-stats conn) - (select-builds-with-context conn)))) + (delegate-to build-controller)) (('GET "statistics") (render-html #:sxml (view-statistics (count-guix-revisions conn) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index c514f4f..487954f 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -345,64 +345,6 @@ "No information yet"))))))))) branches-with-most-recent-commits)))) -(define (view-builds stats builds) - (layout - #:body - `(,(header) - (div - (@ (class "container")) - (div - (@ (class "row")) - (div - (@ (class "col-sm-12")) - (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 ,(build-status-span status)) - (td ,count)))) - stats))))) - (div - (@ (class "row")) - (div - (@ (class "col-sm-12")) - (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 - timestamp status) - `(tr - (td (@ (class "text-center")) - ,(build-status-span status)) - (td (a (@ (href ,derivation-file-name)) - ,(display-store-item-short derivation-file-name))) - (td ,timestamp) - (td (a (@ (href ,(simple-format - #f "~Abuild/~A" - build-server-url - (string-drop - derivation-file-name - (string-length "/gnu/store/"))))) - "View build on " ,build-server-url))))) - builds))))))))) - (define (build-status-value->display-string value) (assoc-ref '(("scheduled" . "Scheduled") -- cgit v1.2.3