Extract the builds page in to it's own set of modules

To allow for expanding it, without cluttering the root controller.

5 files changed, 124 insertions, 61 deletions

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 <mail@cbaines.net>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+(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 <mail@cbaines.net>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+(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")