Extract the builds page in to it's own set of modules
To allow for expanding it, without cluttering the root controller.
This commit is contained in:
parent
33ecb7448e
commit
2a3ee20a99
5 changed files with 124 additions and 61 deletions
|
|
@ -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 \
|
||||
|
|
|
|||
40
guix-data-service/web/build/controller.scm
Normal file
40
guix-data-service/web/build/controller.scm
Normal file
|
|
@ -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))))
|
||||
80
guix-data-service/web/build/html.scm
Normal file
80
guix-data-service/web/build/html.scm
Normal file
|
|
@ -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)))))))))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue