guix-cuirass/src/cuirass/templates.scm

2308 lines
100 KiB
Scheme
Raw Normal View History

;;; templates.scm -- HTTP API
;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
;;; Copyright © 2018, 2019, 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
2021-03-22 18:31:41 +01:00
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Cuirass 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 General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(define-module (cuirass templates)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (json)
#:use-module (web uri)
2021-03-03 15:25:04 +01:00
#:use-module (guix channels)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix progress)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
#:use-module ((guix store) #:hide (build))
#:use-module ((guix utils) #:select (string-replace-substring
version>?))
#:use-module (cuirass config)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
#:use-module (cuirass database)
#:use-module (cuirass remote)
2021-03-03 15:25:04 +01:00
#:use-module (cuirass specification)
#:export (html-page
specifications-table
specification-edit
evaluation-info-table
build-eval-table
build-search-results-table
build-details
evaluation-build-table
running-builds-table
global-metrics-content
2021-02-08 12:25:47 +01:00
workers-status
machine-status
evaluation-dashboard
pretty-build-log
badge-svg
javascript-licenses))
(define (completed? status)
(or (= (build-status succeeded) status)
(= (build-status failed) status)
(= (build-status failed-dependency) status)))
(define (completed-with-logs? status)
(or (= (build-status succeeded) status)
(= (build-status failed) status)))
(define (navigation-items navigation)
(match navigation
(() '())
((item . rest)
(cons `(li (@ (class "nav-item"))
(a (@ (class "nav-link" ,(if (null? rest) " active" ""))
(href ,(assq-ref item #:link)))
,(assq-ref item #:name)))
(navigation-items rest)))))
(define (search-form query)
`(form (@ (id "search")
(class "form-inline")
(action "/search"))
(div
(@ (class "input-group")
(role "search"))
(label (@ (for "query")
(class "sr-only"))
"Search for builds")
(input (@ (type "text")
(class "form-control")
(id "query")
(name "query")
(aria-describedby "search-hints")
,(if query
`(value ,query)
'(placeholder "search for builds"))))
(span (@ (class "input-group-append"))
(button
(@ (type "submit")
(class "btn btn-primary"))
"Search")))
(div
(@ (id "search-hints"))
(p "You can limit the search results with the following keywords:")
(ul
(li (code "spec")
", a " (em "specification") " such as " (code "master"))
(li (code "system")
", a build for the given " (em "target system")
" such as " (code "x86_64-linux"))
(li (code "status")
", to limit the results to builds with the given status. "
"This should be one of "
(code "success") ", "
(code "failed") ", "
(code "failed-dependency") ", "
(code "failed-other") ", or "
(code "canceled") "."))
(p "For example, the following query will list successful builds of
the " (code "master") " specification for the " (code "i686-linux") "
system whose names start with " (code "guile-") ":" (br)
(code "spec:master system:i686-linux status:success guile-")))))
(define* (html-page title body navigation
#:optional query
#:key (margin? #t))
"Return HTML page with given TITLE and BODY."
`(html (@ (lang "en"))
(head
(meta (@ (charset "utf-8")))
(meta (@ (name "viewport")
(content ,(string-join '("width=device-width"
"initial-scale=1"
"shrink-to-fit=no")
", "))))
(link (@ (rel "stylesheet")
(href "/static/css/bootstrap.min.css")))
2021-03-25 10:31:38 +01:00
(link (@ (rel "stylesheet")
(href "/static/css/datatables.min.css")))
(link (@ (rel "stylesheet")
(href "/static/css/open-iconic-bootstrap.css")))
2021-03-21 12:21:58 +01:00
(link (@ (rel "stylesheet")
(href "/static/css/choices.min.css")))
(link (@ (rel "stylesheet")
(href "/static/css/cuirass.css")))
(link (@ (rel "icon") (type "image/png")
(href "/static/images/icon.png")))
;; The empty strings are mandatory to force the SXML parser to
;; create end script tags.
(script (@ (src "/static/js/jquery-3.3.1.min.js")) "")
(script (@ (src "/static/js/popper.min.js")) "")
(script (@ (src "/static/js/bootstrap.min.js")) "")
(script (@ (src "/static/js/datatables.min.js")) "")
(script (@ (src "/static/js/d3.v6.min.js")) "")
(script (@ (src "/static/js/choices.min.js")) "")
(script (@ (src "/static/js/chart.js")) "")
(script (@ (src "/static/js/cuirass.js")) "")
(title ,title))
(body
(header
(a (@ (href "/static/about/javascript")
(rel "jslicense")
(class "d-none"))
"Javascript license information")
(nav (@ (class "navbar navbar-expand-lg navbar-light bg-light"))
(a (@ (class "navbar-brand pt-0")
(href "/"))
(img (@ (src "/static/images/guix.png")
(alt "logo")
(height "25")
(style "margin-top: -12px"))))
(button (@ (class "navbar-toggler")
(type "button")
(data-bs-toggle "collapse")
(data-bs-target "navbarDropdown")
(aria-controls "navbarDropdown")
(aria-expanded "false")
(aria-label "Toggle dropdown"))
(span (@ (class "navbar-toggler-icon"))))
(div (@ (id "navbarDropdown")
(class "collapse navbar-collapse"))
(ul (@ (class "navbar-nav mr-auto"))
(li (@ (class "nav-item dropdown"))
(a (@ (id "navbarDropdownMenuLink")
(class "nav-link dropdown-toggle")
(data-toggle "dropdown")
(href "#")
(role "button")
(aria-haspopup "true")
(aria-expanded "false"))
"Status")
(ul
(@ (class "dropdown-menu")
(role "menu")
(aria-labelledby "navbarDropdownMenuLink"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/metrics"))
"Global metrics"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/workers"))
"Workers status"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/status"))
"Running builds"))))
(li (@ (class "nav-item"))
(a (@ (class "nav-link" ,(if (null? navigation)
" active" ""))
(href "/"))
Home))
,@(navigation-items navigation)))
,(search-form query)))
(main (@ (id "content")
(class ,(if margin?
"container content"
"content-fixed-margin")))
,body)
(footer
(@ (class "footer text-center"))
2021-03-27 10:42:46 +01:00
(p (@ (class "mt-3"))
(a (@ (href "http://guix.gnu.org/cuirass/"))
,(string-append "Cuirass " %package-version))
" — Copyright © 20162023 by the GNU Guix community.")))))
(define (status-class status)
(cond
2021-03-03 15:25:04 +01:00
((= (build-status submitted) status)
"oi oi-clock text-warning")
((= (build-status scheduled) status)
"oi oi-clock text-warning")
((= (build-status started) status)
"oi oi-reload text-warning")
((= (build-status succeeded) status)
"oi oi-check text-success")
((= (build-status failed) status)
"oi oi-x text-danger")
((= (build-status failed-dependency) status)
"oi oi-warning text-danger")
((= (build-status failed-other) status)
"oi oi-warning text-danger")
((= (build-status canceled) status)
"oi oi-question-mark text-warning")
(else
"oi oi-warning text-danger")))
(define (status-title status)
(cond
2021-03-03 15:25:04 +01:00
((= (build-status submitted) status)
"Submitted")
((= (build-status scheduled) status)
"Scheduled")
((= (build-status started) status)
"Started")
((= (build-status succeeded) status)
"Succeeded")
((= (build-status failed) status)
"Failed")
((= (build-status failed-dependency) status)
"Failed (dependency)")
((= (build-status failed-other) status)
"Failed (other)")
((= (build-status canceled) status)
"Canceled")
(else
"Invalid status")))
(define (specifications-table specs evaluations summaries latest-evaluations)
"Return HTML for the SPECS table."
(define (spec->latest-eval-ok name)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(find (lambda (e)
(string=? (evaluation-specification-name e) name))
2021-04-14 15:05:00 +02:00
evaluations))
(define (spec->latest-eval name)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(find (lambda (e)
(string=? (evaluation-specification-name e) name))
latest-evaluations))
2021-04-14 15:05:00 +02:00
(define (eval-summary eval)
(find (lambda (s)
(= (evaluation-summary-id s)
(evaluation-id eval)))
2021-04-14 15:05:00 +02:00
summaries))
(define (summary->percentage summary)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let ((total (evaluation-summary-total summary))
(succeeded (evaluation-summary-succeeded summary)))
(if (zero? total)
0
(nearest-exact-integer (* 100 (/ succeeded total))))))
`((div (@ (class "d-flex flex-row mb-3"))
(div (@ (class "lead mr-auto"))
"Specifications")
,(let ((name "Add a specification"))
`(div
(a (@ (class "btn btn-outline-primary mr-1")
(href "/specification/add/")
(title ,name)
(aria-label ,name)
(role "button"))
2021-04-23 19:43:49 +02:00
(i (@ (class "oi oi-plus text-primary py-1"))
""))))
,(let ((name "RSS events"))
`(div
(a (@ (class "btn btn-outline-warning mr-1")
(href "/events/rss/")
(title ,name)
(aria-label ,name)
(role "button"))
2021-04-23 19:43:49 +02:00
(i (@ (class "oi oi-rss text-warning py-1"))
""))))
,(let ((name "Toggle between success rate and job count"))
`(div
(button (@ (class "btn btn-outline-primary job-toggle")
(title ,name)
(aria-label ,name)
(type "button"))
(i (@ (class "oi oi-dashboard d-inline-block py-1"))
"")))))
(table
2021-03-25 10:31:38 +01:00
(@ (id "spec-table")
(class "table table-sm table-hover"))
,@(if (null? specs)
`((th (@ (scope "col")) "No elements here."))
`((thead (tr (th (@ (scope "col")) Name)
(th (@ (scope "col")) Build)
2021-03-03 15:25:04 +01:00
(th (@ (scope "col")) Channels)
(th (@ (scope "col")) Priority)
(th (@ (scope "col")) Systems)
(th (@ (scope "col")) Jobs)
(th (@ (scope "col")) Action)))
(tbody
,@(map
(lambda (spec)
`(tr
(td (a (@ (href "/jobset/"
,(specification-name spec)))
,(specification-name spec)))
(td ,(match (specification-build spec)
((? symbol? build)
(symbol->string build))
((build _ ...)
(symbol->string build))))
(td ,(string-join
(map (lambda (channel)
(format #f "~a (on ~a)"
(channel-name channel)
(channel-branch channel)))
(specification-channels spec)) ", "))
(td ,(number->string
(specification-priority spec)))
(td
2021-04-14 15:05:00 +02:00
,(let* ((systems (specification-systems spec))
(systems*
(string-join
(sort systems string<?)
", "))
(tooltip?
(> (length systems) 1)))
`(span
(@ ,@(if tooltip?
`((data-toggle "tooltip")
(title ,systems*))
'()))
,(if tooltip?
(string-append (car systems) ", ...")
systems))))
(td
(@
(style "vertical-align: middle"))
,@(let* ((summary
(and=> (spec->latest-eval-ok
(specification-name spec))
eval-summary))
(last-eval
(spec->latest-eval
(specification-name spec)))
(last-eval-status-ok?
(and last-eval
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(<= (evaluation-current-status last-eval)
(evaluation-status succeeded))))
2021-04-14 15:05:00 +02:00
(percentage
2021-04-14 18:03:05 +02:00
(and summary (summary->percentage summary)))
2021-04-14 15:05:00 +02:00
(style
(format #f "width: ~a%" percentage)))
(cond
((and summary last-eval-status-ok?)
`((div
(@ (class "progress job-abs")
(title "Percentage succeeded"))
(div (@ (class "progress-bar")
(role "progressbar")
(style ,style)
(aria-valuemin "0")
(aria-valuemax "100"))
(strong
(span
(@ (class "text-dark"))
,percentage
"%"))))
" "
(div
(@ (class "job-rel d-none"))
,(successful-build-badge
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(evaluation-summary-succeeded summary))
,(failed-build-badge
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(evaluation-summary-failed summary))
,(scheduled-build-badge
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(evaluation-summary-scheduled summary)))))
((and last-eval (not last-eval-status-ok?))
;; LAST-EVAL is broken so it's missing from
;; SUMMARIES.
`((center
,@(broken-evaluation-badge
(evaluation-id last-eval)
(evaluation-current-status last-eval)))))
(else '()))))
(td
,@(let* ((name (specification-name spec))
(dashboard-name
(string-append "Dashboard " name)))
`((a (@ (href "/eval/latest/dashboard?spec="
,(uri-encode name)))
(div
(@ (class "oi oi-monitor d-inline-block ml-2")
(title ,dashboard-name)
(aria-label ,dashboard-name))
""))))
,(let ((id
(string-append
"specDropdown-"
(specification-name spec)))
(name
(string-append "Options "
(specification-name spec))))
`(div
(@ (id ,id)
(title ,name)
(aria-label ,name)
(class "dropdown d-inline-block ml-2"))
(a (@ (class "oi oi-menu dropdown-toggle no-dropdown-arrow")
(href "#")
(data-toggle "dropdown")
(role "button")
(aria-haspopup "true")
(aria-expanded "false"))
" ")
(ul (@ (class "dropdown-menu")
(role "menu")
(aria-labelledby ,id))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/specification/edit/"
,(specification-name spec)))
" Edit"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/admin/specifications/deactivate/"
,(specification-name spec)))
" Deactivate"))))))))
specs)))))))
(define* (specification-edit #:optional spec)
"Return HTML to add a new specification if no argument is passed, or to edit
the existing SPEC otherwise."
(define (channels->html channels)
(let ((html
(fold
(lambda (channel html)
(let ((first-row? (null? html))
(name (channel-name channel))
(url (channel-url channel))
(branch (channel-branch channel)))
(cons
`(div (@ (class ,(if first-row?
"form-group row channel"
"form-group row channel-new")))
(span (@ (for "channel-name")
(class "col-sm-2 col-form-label"))
,(if first-row? "Channels" ""))
(div (@ (class "col-sm-2"))
(input
(@ (type "text")
2021-03-21 12:21:58 +01:00
(class "form-control channel-name")
(name "channel-name")
(placeholder "name")
2021-03-12 10:53:05 +01:00
(value ,name)
(required)))
(label (@ (for "channel-name")
(class "sr-only"))
"Channel name"))
(div (@ (class "col-sm-4"))
(input
(@ (type "text")
2021-03-21 12:21:58 +01:00
(class "form-control channel-url")
(name "channel-url")
(placeholder "url")
2021-03-12 10:53:05 +01:00
(value ,url)
(required)))
(label (@ (for "channel-url")
(class "sr-only"))
"Channel url"))
(div (@ (class "col-sm-2"))
(input
(@ (type "text")
2021-03-21 12:21:58 +01:00
(class "form-control channel-branch")
(name "channel-branch")
(placeholder "branch")
2021-03-12 10:53:05 +01:00
(value ,branch)
(required)))
(label (@ (for "channel-branch")
(class "sr-only"))
"Channel branch"))
,@(if first-row?
'((a (@ (class "btn btn-success add-channel")
2021-03-21 12:21:58 +01:00
(href "#")
(role "button"))
"Add"))
'((a (@ (class "btn btn-danger remove-channel")
2021-03-21 12:21:58 +01:00
(href "#")
(role "button"))
"Remove"))))
html)))
'()
channels)))
(match (reverse html)
((first . rest)
(list first `(div (@ (class "channels"))
,@(if (null? rest)
'("")
rest)))))))
(let ((name (and spec (specification-name spec)))
2021-03-21 12:21:58 +01:00
(build (and spec (match (specification-build spec)
((? symbol? build) build)
((build _ ...) build))))
(channels (and spec (specification-channels spec)))
(period (and spec (specification-period spec)))
(priority (and spec (specification-priority spec)))
(systems (and spec (specification-systems spec))))
`(span
(p (@ (class "lead edit-channel"))
,(if spec
(format #f "Edit ~a specification" name)
"Create a new specification"))
(form (@ (id "add-specification")
2021-03-12 10:53:05 +01:00
(class "needs-validation")
,@(if spec
'((action "/admin/specification/edit"))
'((action "/admin/specification/add")))
(method "POST"))
(div (@ (class "form-group row"))
(label (@ (for "name")
(class "col-sm-2 col-form-label"))
"Name")
(div (@ (class "col-sm-4"))
(input (@ (type "text")
(class "form-control")
(id "name")
(name "name")
(pattern "[^/]+")
(value ,(or name ""))
,@(if spec
'((readonly))
2021-03-12 10:53:05 +01:00
'())
(required)))))
(div (@ (class "form-group row"))
(label (@ (for "build")
(class "col-sm-2 col-form-label"))
"Build")
(div (@ (class "col-sm-4"))
(select
2021-03-21 12:21:58 +01:00
(@ (class "form-control build-select")
(id "build")
(name "build"))
,@(map (lambda (type)
`(option (@ ,@(if (eq? type build)
'((selected))
'()))
,(symbol->string type)))
%build-types))))
2021-03-21 12:21:58 +01:00
,(if spec
(match (specification-build spec)
((build . rest)
`((span (@ (class "default-build-param")
(hidden "true"))
,(string-join
(map (lambda (param)
(cond
((string? param)
param)
(else
(object->string param))))
2021-03-21 12:21:58 +01:00
rest)
","))))
(else ""))
'())
(div (@ (class "form-group row param-select-row"))
(label (@(class "col-sm-2 col-form-label"))
"Parameter")
(div (@ (class "col-sm-4"))
(select (@ (type "text")
(class "form-control build-param-select")
(name "param-select")
(multiple))
"")))
2021-03-21 12:21:58 +01:00
(div (@ (class "form-group row param-input-row"))
(label (@ (class "col-sm-2 col-form-label"))
2021-03-21 12:21:58 +01:00
"Parameter")
(div (@ (class "col-sm-4"))
(input (@ (type "text")
(name "param-input")
(class "form-control build-param-input")))))
,@(channels->html
(if spec channels (list %default-guix-channel)))
(div (@ (class "form-group row"))
(label (@ (for "period")
(class "col-sm-2 col-form-label"))
"Period")
(div (@ (class "col-sm-4"))
(input
(@ (type "number")
(class "form-control")
(id "period")
(name "period")
(min 0)
(value ,(or period 0))))))
(div (@ (class "form-group row"))
(label (@ (for "priority")
(class "col-sm-2 col-form-label"))
"Priority")
(div (@ (class "col-sm-4"))
(input
(@ (type "number")
(class "form-control")
(id "priority")
(name "priority")
2021-03-12 10:53:05 +01:00
(min 0)
(max 9)
(value ,(or priority 9))))))
(div (@ (class "form-group row"))
(span (@ (class "col-sm-2 col-form-label"))
"Systems")
,@(map (lambda (system)
`(div (@ (class "form-check form-check-inline"))
2021-03-12 10:53:05 +01:00
(input (@ (class "form-check-input system")
(type "checkbox")
(id ,system)
(name ,system)
,@(if (and systems
(member system systems))
'((checked))
'())))
(label (@ (class "form-check-label")
(for ,system))
,system)))
%cuirass-supported-systems))
(div (@ (class "form-group row"))
(div (@ (class "col-sm-2"))
(button
(@ (type "submit")
(class "btn btn-primary"))
" Submit"))
(div (@ (class "col-sm-10 text-warning"))
"Declarative configuration updates may overwrite these settings!"))))))
(define* (build-details build dependencies products history
#:key (channels '())
(checkouts '()) (previous-checkouts '())
first-failure)
"Return HTML showing details for the BUILD."
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define status (build-current-status build))
(define weather (build-current-weather build))
(define evaluation
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-evaluation-id build))
(define (find-dependency id)
(find (lambda (build)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(= (build-id build) id))
dependencies))
(define (history-table-row build)
(define status
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-current-status build))
`(tr
(td (span (@ (class ,(status-class status))
(title ,(status-title status))
(aria-hidden "true"))
""))
(th (@ (scope "row"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(a (@ (href "/build/" ,(build-id build) "/details"))
,(build-id build)))
(td ,(build-nix-name build))
(td ,(if (completed? status)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(time->string (build-completion-time build))
"—"))))
(define (build-failure-info build)
;; If BUILD failed, provide hints as to the origin of the failure.
(if (= (build-status failed) (build-current-status build))
(if (= (build-weather new-failure) (build-current-weather build))
`((p "Channel changes compared to the "
(a (@ (href "/build/" ,(build-id (first history)) "/details"))
"previous (successful) build")
":"
,(checkout-change-table channels
previous-checkouts checkouts)))
(if first-failure
`((p "The first failure was "
(a (@ (href "/build/" ,(build-id first-failure)
"/details"))
"build #"
,(number->string (build-id first-failure)))
"."))
'()))
'()))
`((div (@ (class "d-flex flex-row mb-3"))
(div (@ (class "lead mr-auto"))
"Build details")
(div (@ (class "dropdown"))
(a (@ (class "btn btn-warning dropdown-toggle")
(href "#")
(data-toggle "dropdown")
(role "button")
(aria-haspopup "true")
(aria-expanded "false"))
"Action")
(ul (@ (class "dropdown-menu")
(role "menu"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/admin/build/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-id build) "/restart"))
" Restart")))))
(table
(@ (class "table table-sm table-hover"))
(tbody
(tr (th "Build ID")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td ,(build-id build)))
(tr (th "Evaluation")
(td (a (@ (href ,(string-append "/eval/"
(number->string evaluation))))
,(number->string evaluation))
" ("
(a (@ (href ,(string-append "/jobset/"
(build-specification-name build))))
,(build-specification-name build))
")"))
(tr (th "Status")
(td (span (@ (class ,(status-class status))
(title ,(status-title status)))
,(string-append " " (status-title status)))))
(tr (th "System")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td ,(build-system build)))
(tr (th "Name")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td ,(build-nix-name build)))
(tr (th "Duration")
(td ,(let ((timestamp (time-second (current-time time-utc)))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(start (build-start-time build))
(stop (build-completion-time build)))
(cond
((and (> start 0) (> stop 0))
(string-append (number->string (- stop start))
" seconds"))
((> start 0)
(string-append (number->string (- timestamp start))
" seconds"))
(else "—")))))
(tr (th "Finished")
(td ,(if (completed? status)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(time->string (build-completion-time build))
"—")))
,@(if (= (build-weather unknown) weather)
'()
`((tr (th "Weather")
(td (span (@ (class ,(weather-class weather))
(title ,(weather-title weather))
(aria-hidden "true"))
"")
" " ,(weather-title weather)
,@(build-failure-info build)))))
(tr (th "Log file")
(td ,(if (or (= (build-status started) status)
(= (build-status succeeded) status)
(= (build-status failed) status)
(= (build-status canceled) status))
`(div
(a (@ (href "/build/" ,(build-id build) "/log"))
"pretty")
", "
(a (@ (href "/build/" ,(build-id build) "/log/raw"))
"raw"))
"—")))
(tr (th "Derivation")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td (pre ,(build-derivation build))))
(tr (th "Dependencies")
(td
(@ (class "dependencies"))
,@(let ((dependencies
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-dependencies/id build))
(max-items 10))
(if (> (length dependencies) 0)
`(,(map (lambda (id index)
(let* ((build (find-dependency id))
(status (build-current-status build)))
`((div
,@(if (> index (1- max-items))
'((@ (class "collapse collapse-dep")))
'())
(span (@ (class ,(status-class status))
(title ,(status-title status))
(aria-hidden "true"))
"")
" "
(a (@ (href "/build/" ,id "/details"))
,(build-nix-name build))
(br)))))
dependencies
(iota (length dependencies)))
,@(if (> (length dependencies) max-items)
'((button (@ (id "collapse-dep-btn")
(class "btn btn-primary")
(type "button")
(data-toggle "collapse")
(data-target ".collapse-dep")
(aria-expanded "false")
(aria-controls "collapse-dep")
(aria-label "Toggle dependencies dropdown"))
"Show more"))
'()))
'("—")))))
(tr (th "Outputs")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td ,(map (lambda (output)
`(pre ,(output-item output)))
(build-outputs build))))
,@(if (null? products)
'()
(let ((product-items
(map
(lambda (product)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let* ((id (build-product-id product))
(size (build-product-file-size product))
(type (build-product-type product))
(path (build-product-file product))
(href (format #f "/download/~a" id)))
`(a (@ (href ,href))
(li (@ (class "list-group-item"))
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-auto"))
(span
(@ (class "oi oi-data-transfer-download")
(title "Download")
(aria-hidden "true"))))
(div (@ (class "col-md-auto"))
,path)
(div (@ (class "col-md-auto"))
"(" ,type ")")
(div (@ (class "col-md-auto"))
,(byte-count->string size))))))))
products)))
`((tr (th "Build outputs")
(td
(ul (@ (class "list-group d-flex flex-row"))
,product-items))))))
,@(match (build-worker build)
((or #f "") '())
(name
(let ((worker (db-get-worker name)))
(if worker
`((tr (th "Build machine")
(td (a (@ (href
,(string-append "/machine/"
(worker-machine worker))))
,(worker-machine worker))
", worker " ,name)))
`((tr (th "Worker") (td ,name)))))))))
,@(if (null? history)
'()
`((div (@ (class "lead mr-auto"))
"Build history")
(table
(@ (class "table table-sm table-hover table-striped"))
(thead
(tr
(th (@ (scope "col") (class "border-0")) ())
(th (@ (scope "col") (class "border-0")) "ID")
(th (@ (scope "col") (class "border-0")) "Name")
(th (@ (scope "col") (class "border-0")) "Completion time")))
(tbody ,@(map history-table-row history)))))))
(define (pagination first-link prev-link next-link last-link)
"Return html page navigation buttons with LINKS."
`(div (@ (class row))
(nav
(@ (class "mx-auto") (aria-label "Page navigation"))
(ul (@ (class "pagination"))
(li (@ (class "page-item"
,(if (string-null? prev-link) " disabled")))
(a (@ (class "page-link")
(href ,first-link))
"<< First"))
(li (@ (class "page-item"
,(if (string-null? prev-link) " disabled")))
(a (@ (class "page-link")
(href ,prev-link))
"< Previous"))
(li (@ (class "page-item"
,(if (string-null? next-link) " disabled")))
(a (@ (class "page-link")
(href ,next-link))
"Next >"))
(li (@ (class "page-item"
,(if (string-null? next-link) " disabled")))
(a (@ (class "page-link")
(href ,last-link))
"Last >>"))))))
database: Add a Checkouts table. It is used to know when a new evaluation must be triggered and to display input changes. * Makefile.am (dist_sql_DATA): Add 'src/sql/upgrade-3.sql'. * bin/cuirass.in (main): Call DB-SET-EVALUATION-DONE at startup to clear 'in-progress' evaluations. * bin/evaluate.in (input-checkout, format-checkouts): Rename '#:name' to '#:input'. * doc/cuirass.texi (Stamps): Remove section. (Checkouts): New section. * src/cuirass/base.scm (fetch-input, fetch-inputs, compile-checkouts): Rename '#:name' to '#:input'. (evaluate): Remove the COMMITS argument. Add an EVAL-ID argument. Don't call DB-ADD-EVALUATION because it was called sooner. Remove the EVAL-ID argument to AUGMENT-JOB because it's a closure. (build-packages): Add an EVAL-ID argument. Call DB-SET-EVALUATION-DONE once all the derivations are registered. (process-specs): Replace the stamping mechanism by the primary key constraint of the Checkouts table: call "evaluate" only when DB-ADD-EVALUATION is true, which means that at least one checkout was added. Change the EVALUATE and BUILD-PACKAGES arguments accordingly. * src/cuirass/database.scm (db-add-stamp, db-get-stamp): Remove procedures. (db-set-evaluations-done, db-set-evaluation-done): New exported procedure. (db-add-checkout): New procedure that returns #f if a checkout with the same revision already exists. (db-add-evaluation): Replace the EVAL argument with a SPEC-NAME and a CHECKOUTS arguments. Insert the evaluation only if at least one checkout was inserted. Return #f otherwise. (db-get-checkouts): New procedure. (db-get-evaluations, db-get-evaluations-build-summary): Handle the 'in_progress' column, remove the 'commits' column. Return the result of DB-GET-CHECKOUTS as part of the evaluation. * src/cuirass/templates.scm (input-changes, evaluation-badges): New procedures. (evaluation-info-table): Rename "Commits" to "Input changes". Use INPUT-CHANGES to display the input changes that triggered the evaluation. Use EVALUATION-BADGES to display a message indicating that the evaluation is in progress. * src/schema.sql (Stamps): Remove table. (Checkouts): New table. (Evaluations): Remove the 'commits' column. Add an 'in_progress' column. * src/sql/upgrade-3.sql: New file with SQL queries to upgrade the database. * tests/database.scm (make-dummy-eval): Remove procedure. (make-dummy-checkouts): New procedure. ("sqlite-exec"): Remove the 'commits' column. Add the 'in_progress' column. ("db-update-build-status!", "db-get-builds", "db-get-pending-derivations"): Update the arguments of DB-ADD-EVALUATION accordingly. * tests/http.scm (hash-table=?): Add support for lists of hash tables. (evaluations-query-result): Replace '#:commits' with '#:checkouts'. Return a list instead of returning one element, for symmetry. ("fill-db"): Add a new input so that the second checkout can refer to it. Replace EVALUATION1 and EVALUATION2 with CHECKOUTS1 and CHECKOUTS2. Update the arguments of DB-ADD-EVALUATION accordingly. ("/api/queue?nr=100"): Take the CAR of the EVALUATIONS-QUERY-RESULT list to make it symmetrical with the other argument of HASH-TABLE=?.
2018-08-11 20:30:11 +02:00
(define (input-changes checkouts)
(let ((changes
(string-join
(map (lambda (checkout)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let ((input (checkout-channel checkout))
(commit (checkout-commit checkout)))
database: Add a Checkouts table. It is used to know when a new evaluation must be triggered and to display input changes. * Makefile.am (dist_sql_DATA): Add 'src/sql/upgrade-3.sql'. * bin/cuirass.in (main): Call DB-SET-EVALUATION-DONE at startup to clear 'in-progress' evaluations. * bin/evaluate.in (input-checkout, format-checkouts): Rename '#:name' to '#:input'. * doc/cuirass.texi (Stamps): Remove section. (Checkouts): New section. * src/cuirass/base.scm (fetch-input, fetch-inputs, compile-checkouts): Rename '#:name' to '#:input'. (evaluate): Remove the COMMITS argument. Add an EVAL-ID argument. Don't call DB-ADD-EVALUATION because it was called sooner. Remove the EVAL-ID argument to AUGMENT-JOB because it's a closure. (build-packages): Add an EVAL-ID argument. Call DB-SET-EVALUATION-DONE once all the derivations are registered. (process-specs): Replace the stamping mechanism by the primary key constraint of the Checkouts table: call "evaluate" only when DB-ADD-EVALUATION is true, which means that at least one checkout was added. Change the EVALUATE and BUILD-PACKAGES arguments accordingly. * src/cuirass/database.scm (db-add-stamp, db-get-stamp): Remove procedures. (db-set-evaluations-done, db-set-evaluation-done): New exported procedure. (db-add-checkout): New procedure that returns #f if a checkout with the same revision already exists. (db-add-evaluation): Replace the EVAL argument with a SPEC-NAME and a CHECKOUTS arguments. Insert the evaluation only if at least one checkout was inserted. Return #f otherwise. (db-get-checkouts): New procedure. (db-get-evaluations, db-get-evaluations-build-summary): Handle the 'in_progress' column, remove the 'commits' column. Return the result of DB-GET-CHECKOUTS as part of the evaluation. * src/cuirass/templates.scm (input-changes, evaluation-badges): New procedures. (evaluation-info-table): Rename "Commits" to "Input changes". Use INPUT-CHANGES to display the input changes that triggered the evaluation. Use EVALUATION-BADGES to display a message indicating that the evaluation is in progress. * src/schema.sql (Stamps): Remove table. (Checkouts): New table. (Evaluations): Remove the 'commits' column. Add an 'in_progress' column. * src/sql/upgrade-3.sql: New file with SQL queries to upgrade the database. * tests/database.scm (make-dummy-eval): Remove procedure. (make-dummy-checkouts): New procedure. ("sqlite-exec"): Remove the 'commits' column. Add the 'in_progress' column. ("db-update-build-status!", "db-get-builds", "db-get-pending-derivations"): Update the arguments of DB-ADD-EVALUATION accordingly. * tests/http.scm (hash-table=?): Add support for lists of hash tables. (evaluations-query-result): Replace '#:commits' with '#:checkouts'. Return a list instead of returning one element, for symmetry. ("fill-db"): Add a new input so that the second checkout can refer to it. Replace EVALUATION1 and EVALUATION2 with CHECKOUTS1 and CHECKOUTS2. Update the arguments of DB-ADD-EVALUATION accordingly. ("/api/queue?nr=100"): Take the CAR of the EVALUATIONS-QUERY-RESULT list to make it symmetrical with the other argument of HASH-TABLE=?.
2018-08-11 20:30:11 +02:00
(format #f "~a → ~a" input (substring commit 0 7))))
checkouts)
", ")))
(if (string=? changes "") '(em "None") changes)))
(define (broken-evaluation-badge eval-id status)
(cond ((= status (evaluation-status failed))
`((a (@ (href "/eval/" ,eval-id "/log/raw")
(class "oi oi-x text-danger")
(title "Failed")
(aria-hidden "true"))
"")))
((= status (evaluation-status aborted))
`((a (@ (href "/eval/" ,eval-id "/log/raw")
(class "oi oi-x text-warning")
(title "Aborted")
(aria-hidden "true"))
"")))))
(define (evaluation-badges evaluation absolute)
(define (dashboard-link body)
`(a (@ (href "/eval/" ,(build-summary-evaluation-id evaluation)
"/dashboard"))
,body))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let ((status (build-summary-status evaluation)))
(if (= status (evaluation-status started))
'((em "In progress…"))
(cond
((= status (evaluation-status succeeded))
`((div
(@ (class "job-abs d-none"))
,(dashboard-link
(successful-build-badge
(if absolute
(evaluation-summary-succeeded absolute)
0)))
,(dashboard-link
(failed-build-badge
(if absolute
(evaluation-summary-failed absolute)
0)))
,(dashboard-link
(scheduled-build-badge
(if absolute
(evaluation-summary-scheduled absolute)
0))))
(div
(@ (class "job-rel"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(successful-build-badge (build-summary-succeeded evaluation)
(string-append
"/eval/"
(number->string
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-summary-evaluation-id evaluation))
"?status=succeeded"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(failed-build-badge (build-summary-failed evaluation)
(string-append
"/eval/"
(number->string
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-summary-evaluation-id evaluation))
"?status=failed"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(scheduled-build-badge (build-summary-scheduled evaluation)
(string-append
"/eval/"
(number->string
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-summary-evaluation-id evaluation))
"?status=pending")))))
(else
(broken-evaluation-badge (build-summary-evaluation-id evaluation)
status))))))
database: Add a Checkouts table. It is used to know when a new evaluation must be triggered and to display input changes. * Makefile.am (dist_sql_DATA): Add 'src/sql/upgrade-3.sql'. * bin/cuirass.in (main): Call DB-SET-EVALUATION-DONE at startup to clear 'in-progress' evaluations. * bin/evaluate.in (input-checkout, format-checkouts): Rename '#:name' to '#:input'. * doc/cuirass.texi (Stamps): Remove section. (Checkouts): New section. * src/cuirass/base.scm (fetch-input, fetch-inputs, compile-checkouts): Rename '#:name' to '#:input'. (evaluate): Remove the COMMITS argument. Add an EVAL-ID argument. Don't call DB-ADD-EVALUATION because it was called sooner. Remove the EVAL-ID argument to AUGMENT-JOB because it's a closure. (build-packages): Add an EVAL-ID argument. Call DB-SET-EVALUATION-DONE once all the derivations are registered. (process-specs): Replace the stamping mechanism by the primary key constraint of the Checkouts table: call "evaluate" only when DB-ADD-EVALUATION is true, which means that at least one checkout was added. Change the EVALUATE and BUILD-PACKAGES arguments accordingly. * src/cuirass/database.scm (db-add-stamp, db-get-stamp): Remove procedures. (db-set-evaluations-done, db-set-evaluation-done): New exported procedure. (db-add-checkout): New procedure that returns #f if a checkout with the same revision already exists. (db-add-evaluation): Replace the EVAL argument with a SPEC-NAME and a CHECKOUTS arguments. Insert the evaluation only if at least one checkout was inserted. Return #f otherwise. (db-get-checkouts): New procedure. (db-get-evaluations, db-get-evaluations-build-summary): Handle the 'in_progress' column, remove the 'commits' column. Return the result of DB-GET-CHECKOUTS as part of the evaluation. * src/cuirass/templates.scm (input-changes, evaluation-badges): New procedures. (evaluation-info-table): Rename "Commits" to "Input changes". Use INPUT-CHANGES to display the input changes that triggered the evaluation. Use EVALUATION-BADGES to display a message indicating that the evaluation is in progress. * src/schema.sql (Stamps): Remove table. (Checkouts): New table. (Evaluations): Remove the 'commits' column. Add an 'in_progress' column. * src/sql/upgrade-3.sql: New file with SQL queries to upgrade the database. * tests/database.scm (make-dummy-eval): Remove procedure. (make-dummy-checkouts): New procedure. ("sqlite-exec"): Remove the 'commits' column. Add the 'in_progress' column. ("db-update-build-status!", "db-get-builds", "db-get-pending-derivations"): Update the arguments of DB-ADD-EVALUATION accordingly. * tests/http.scm (hash-table=?): Add support for lists of hash tables. (evaluations-query-result): Replace '#:commits' with '#:checkouts'. Return a list instead of returning one element, for symmetry. ("fill-db"): Add a new input so that the second checkout can refer to it. Replace EVALUATION1 and EVALUATION2 with CHECKOUTS1 and CHECKOUTS2. Update the arguments of DB-ADD-EVALUATION accordingly. ("/api/queue?nr=100"): Take the CAR of the EVALUATIONS-QUERY-RESULT list to make it symmetrical with the other argument of HASH-TABLE=?.
2018-08-11 20:30:11 +02:00
(define* (evaluation-info-table name evaluations id-min id-max
#:key absolute-summary)
"Return HTML for the EVALUATION table NAME. ID-MIN and ID-MAX are
global minimal and maximal id."
(define (eval-absolute-summary eval)
(find (lambda (e)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(= (evaluation-summary-id e)
(build-summary-evaluation-id eval)))
absolute-summary))
2021-04-23 19:43:49 +02:00
`((div (@ (class "d-flex flex-row mb-3"))
(div (@ (class "lead mr-auto"))
"Evaluations of " ,name)
,(let ((rss-name "RSS events"))
`(div
(a (@ (class "btn btn-outline-warning mr-1")
(href "/events/rss/?specification=" ,name)
(title ,rss-name)
(aria-label ,rss-name)
(role "button"))
(i (@ (class "oi oi-rss text-warning py-1")
(aria-hidden "true"))
""))))
,(let ((name "Toggle between build changes and build overview"))
2021-04-23 19:43:49 +02:00
`(div
(button (@ (class "btn btn-outline-primary job-toggle")
(title ,name)
(aria-label ,name)
(type "button"))
(i (@ (class "oi oi-dashboard d-inline-block py-1"))
2021-04-23 19:43:49 +02:00
"")))))
(table
(@ (class "table table-sm table-hover table-striped"))
,@(if (null? evaluations)
`((th (@ (scope "col")) "No elements here."))
`((thead
(tr
(th (@ (scope "col")) "#")
2021-03-03 15:25:04 +01:00
(th (@ (scope "col")) "Channel changes")
(th (@ (scope "col"))
(div (@ (class "job-rel")) "Build changes")
(div (@ (class "job-abs d-none"))
"Total number of builds"))
(th (@ (scope "col")) "Action")))
(tbody
,@(map
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(lambda (summary)
`(tr (th (@ (scope "row"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(a (@ (href
"/eval/"
,(build-summary-evaluation-id summary)))
,(build-summary-evaluation-id summary)))
(td ,(input-changes (build-summary-checkouts summary)))
(td
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,@(evaluation-badges summary
(eval-absolute-summary summary)))
,(let* ((id (build-summary-evaluation-id summary))
2021-04-23 19:43:49 +02:00
(title
(string-append "Dashboard evaluation "
(number->string id))))
`(td
(a (@ (href "/eval/" ,id "/dashboard"))
(div
(@ (class
,(string-append
"oi oi-monitor d-inline-block "
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(if (eq? (build-summary-status summary)
2021-04-23 19:43:49 +02:00
(evaluation-status succeeded))
"visible"
"invisible")))
(title ,title)
(aria-label ,title))
""))
,(let ((dropdown-id
(string-append
"evaluationDropdown-"
(number->string id)))
(name
(string-append "Options evaluation "
(number->string id))))
`(div
(@ (id ,dropdown-id)
2021-04-23 19:43:49 +02:00
(title ,name)
(aria-label ,name)
(class "dropdown d-inline-block ml-2"))
(a (@ (class "oi oi-menu dropdown-toggle no-dropdown-arrow")
(href "#")
(data-toggle "dropdown")
(role "button")
(aria-haspopup "true")
(aria-expanded "false"))
" ")
(ul (@ (class "dropdown-menu")
(role "menu")
(aria-labelledby ,id))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/admin/evaluation/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-summary-evaluation-id summary)
2021-04-23 19:43:49 +02:00
"/cancel"))
" Cancel pending builds"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/admin/evaluation/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-summary-evaluation-id summary)
2021-04-23 19:43:49 +02:00
"/restart"))
" Restart all builds"))
(li (@ (role "menuitem"))
(a (@ (class "dropdown-item")
(href "/admin/evaluation/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-summary-evaluation-id summary)
2021-04-23 19:43:49 +02:00
"/retry"))
" Retry the evaluation")))))))))
evaluations)))))
,(if (null? evaluations)
(pagination "" "" "" "")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let* ((eval-ids (map build-summary-evaluation-id evaluations))
(page-id-min (last eval-ids))
(page-id-max (first eval-ids)))
(pagination
(format #f "?border-high=~d" (1+ id-max))
(if (= page-id-max id-max)
""
(format #f "?border-low=~d" page-id-max))
(if (= page-id-min id-min)
""
(format #f "?border-high=~d" page-id-min))
(format #f "?border-low=~d" (1- id-min)))))))
(define (time->string time)
"Return a string representing TIME in a concise, human-readable way."
(define now*
(current-time time-utc))
(define now
(time-second now*))
(define elapsed
(- now time))
(cond ((< elapsed 120)
"seconds ago")
((< elapsed 7200)
(let ((minutes (inexact->exact
(round (/ elapsed 60)))))
(format #f "~a minutes ago" minutes)))
((< elapsed (* 48 3600))
(let ((hours (inexact->exact
(round (/ elapsed 3600)))))
(format #f "~a hours ago" hours)))
(else
(let* ((time (make-time time-utc 0 time))
(date (time-utc->date time))
(year (date-year date))
(current (date-year (time-utc->date now*)))
(format (if (= year current)
"~e ~b ~H:~M ~z"
"~e ~b ~Y ~H:~M")))
(date->string date format)))))
(define (weather-class status)
(cond
((= (build-weather unknown) status)
"oi oi-media-record text-primary mt-1")
((= (build-weather new-success) status)
"oi oi-arrow-thick-top text-success mt-1")
((= (build-weather new-failure) status)
"oi oi-arrow-thick-bottom text-danger mt-1")
((= (build-weather still-succeeding) status)
"oi oi-media-record text-success mt-1")
((= (build-weather still-failing) status)
"oi oi-media-record text-danger mt-1")))
(define (weather-title status)
(cond
((= (build-weather unknown) status) "Unknown")
((= (build-weather new-success) status) "New success")
((= (build-weather new-failure) status) "New failure")
((= (build-weather still-succeeding) status) "Still succeeding")
((= (build-weather still-failing) status) "Still failing")))
(define (build-eval-table eval-id builds build-min build-max status)
"Return HTML for the BUILDS table evaluation with given STATUS. BUILD-MIN
and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
(define (table-header)
`(thead
(tr
(th (@ (scope "col") (class "border-0")) '())
(th (@ (scope "col") (class "border-0")) '())
(th (@ (scope "col") (class "border-0")) "ID")
(th (@ (scope "col") (class "border-0")) "Completion time")
(th (@ (scope "col") (class "border-0")) "Job")
(th (@ (scope "col") (class "border-0")) "Name")
(th (@ (scope "col") (class "border-0")) "System"))))
(define (table-row build)
(define status
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-current-status build))
(define weather
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-current-weather build))
`(tr
(td (a (@ (class ,(status-class status))
(title ,(status-title status))
(aria-hidden "true")
,@(if (completed-with-logs? status)
`((href "/build/" ,(build-id build) "/log"))
'()))
""))
(td (span (@ (class ,(weather-class weather))
(title ,(weather-title weather))
(aria-hidden "true"))
""))
(th (@ (scope "row"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(a (@ (href "/build/" ,(build-id build) "/details"))
,(build-id build)))
(td ,(if (completed? status)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(time->string (build-completion-time build))
"—"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td ,(build-job-name build))
(td ,(build-nix-name build))
(td ,(build-system build))))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define (page-boundary-build-id build)
(match build
((stoptime id) id)))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define (page-boundary-build-stoptime build)
(match build
((stoptime id) stoptime)))
`((table
2021-03-25 10:31:38 +01:00
(@ (id "eval-table")
(class "table table-sm table-hover table-striped"))
,@(if (null? builds)
`((th (@ (scope "col") (class "border-0")) "No elements here."))
`(,(table-header)
(tbody ,@(map table-row builds)))))
,(if (null? builds)
(pagination "" "" "" "")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let* ((build-time-ids (map (lambda (build)
(list (build-completion-time build)
(build-id build)))
builds))
(page-build-min (last build-time-ids))
(page-build-max (first build-time-ids)))
(pagination
(format
#f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(page-boundary-build-stoptime build-max)
(1+ (page-boundary-build-id build-max))
status)
(if (equal? page-build-max build-max)
""
(format
#f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(page-boundary-build-stoptime page-build-max)
(page-boundary-build-id page-build-max)
status))
(if (equal? page-build-min build-min)
""
(format
#f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(page-boundary-build-stoptime page-build-min)
(page-boundary-build-id page-build-min)
status))
(format
#f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(page-boundary-build-stoptime build-min)
(1- (page-boundary-build-id build-min))
status))))))
;; FIXME: Copied from (guix scripts describe).
(define %vcs-web-views
;; Hard-coded list of host names and corresponding web view URL templates.
;; TODO: Allow '.guix-channel' files to specify a URL template.
(let ((labhub-url (lambda (repository-url commit)
(string-append
(if (string-suffix? ".git" repository-url)
(string-drop-right repository-url 4)
repository-url)
"/commit/" commit))))
`(("git.savannah.gnu.org"
,(lambda (repository-url commit)
(string-append (string-replace-substring repository-url
"/git/" "/cgit/")
"/log/?id=" commit)))
("notabug.org" ,labhub-url)
("framagit.org" ,labhub-url)
("gitlab.com" ,labhub-url)
("gitlab.inria.fr" ,labhub-url)
("github.com" ,labhub-url))))
(define %vcs-web-commit-range-views
;; List of host names and corresponding URL to display a commit range.
(let ((gitlab-url (lambda (repository-url commit1 commit2)
(string-append
(if (string-suffix? ".git" repository-url)
(string-drop-right repository-url 4)
repository-url)
"/-/compare/" commit1 "..." commit2)))
(github-url (lambda (repository-url commit1 commit2)
(string-append
(if (string-suffix? ".git" repository-url)
(string-drop-right repository-url 4)
repository-url)
"/compare/" commit1 ".." commit2))))
`(("git.savannah.gnu.org"
,(lambda (repository-url commit1 commit2)
(string-append (string-replace-substring repository-url
"/git/" "/cgit/")
"/log/?qt=range&q=" commit1 ".." commit2)))
("framagit.org" ,gitlab-url)
("gitlab.com" ,gitlab-url)
("gitlab.inria.fr" ,gitlab-url)
("github.com" ,github-url))))
(define* (commit-hyperlink url commit #:key shorten?)
"Return, if possible, a hyperlink for COMMIT of the repository at URL. When
SHORTEN? is true, display a shortened version of COMMIT."
(let ((str (if shorten?
(string-take commit 7)
commit)))
(match (string->uri url)
(#f str)
(uri
(let ((host (uri-host uri)))
(match (assoc-ref %vcs-web-views host)
(#f str)
((link) `(a (@ (href ,(link url commit))) ,str))))))))
(define (nearest-exact-integer x)
"Given a real number X, return the nearest exact integer, with ties going to
the nearest exact even integer."
(inexact->exact (round x)))
(define (seconds->string duration)
(if (< duration 60)
(format #f "~a second~:p" duration)
(format #f "~a minute~:p" (nearest-exact-integer
(/ duration 60)))))
(define* (checkout-table checkouts channels
#:key (changes '()))
"Return SHTML for a table representing CHECKOUTS. CHANGES is the subset of
CHECKOUTS that has changed compared to the previous evaluation."
(define changed-element
;; HTML element to represent a checkout that has changed compared to the
;; previous evaluation.
'(span (@ (class "oi oi-arrow-thick-top text-primary mt-1")
(aria-hidden "true")
(title "Channel updated compared to previous evaluation."))))
`(table (@ (class "table table-sm table-hover"))
(thead
(tr (th (@ (class "border-0") (scope "col")) " ")
(th (@ (class "border-0") (scope "col")) "Channel")
(th (@ (class "border-0") (scope "col")) "Commit")))
(tbody
,@(map (lambda (checkout)
;; Normally CHECKOUT is a <checkout> record that was
;; returned by 'latest-checkouts'. However, due to old
;; bugs, the database might yield #f for channels that are
;; indirect dependencies; deal with it gracefully.
(if checkout
(let* ((name (checkout-channel checkout))
(channel (find (lambda (channel)
(eq? (channel-name channel)
name))
channels)))
;; Some checkout entries may refer to removed
;; inputs.
(if channel
(let ((url (channel-url channel))
(commit (checkout-commit checkout))
(changed? (member checkout changes)))
`(tr (td ,(if changed?
changed-element
""))
(td ,url)
(td (code ,(commit-hyperlink url commit)))))
'()))
`(tr (td "?")
(td (i "checkout information is missing")))))
checkouts))))
(define (commit-range-hyperlink url commit1 commit2)
"Return, if possible, a hyperlink to a web view of the range
COMMIT1..COMMIT2 of the Git repository at URL."
(define shorten
(cut string-take <> 7))
(define body
`(code ,(shorten commit1) " → " ,(shorten commit2)))
(match (string->uri url)
(#f body)
(uri
(let ((host (uri-host uri)))
(match (assoc-ref %vcs-web-commit-range-views host)
(#f body)
((link) `(a (@ (href ,(link url commit1 commit2)))
,body)))))))
(define (checkout-change-table channels old new)
"Return a table representing the changes from OLD to NEW, both of which are
lists of <checkout> records. Use CHANNELS to grab additional metadata such as
the channel's URL."
`(table (@ (class "table table-sm table-hover"))
(tbody
,@(map (lambda (checkout)
(let* ((name (checkout-channel checkout))
(commit (checkout-commit checkout))
(previous (find (lambda (checkout)
(eq? (checkout-channel checkout)
name))
old))
(channel (find (lambda (channel)
(eq? (channel-name channel)
name))
channels))
(url (and channel (channel-url channel))))
(if (string=? commit (checkout-commit previous))
'()
`(tr (td ,name)
(td ,(commit-range-hyperlink
(channel-url channel)
(checkout-commit previous)
commit))))))
new))))
(define* (build-counter-badge value class title
#:optional link)
(if link
`(a (@ (href ,link)
(class "badge " ,class " badge-counter"
,(if (eqv? 0 value) " hidden" ""))
(title ,title))
,value)
`(div (@ (class "badge " ,class " badge-counter"
,(if (eqv? 0 value) " hidden" ""))
(title ,title))
,value)))
(define successful-build-badge
(cut build-counter-badge <> "badge-success" "Succeeded" <...>))
(define failed-build-badge
(cut build-counter-badge <> "badge-danger" "Failed" <...>))
(define scheduled-build-badge
(cut build-counter-badge <> "badge-secondary" "Scheduled" <...>))
(define* (evaluation-build-table evaluation
#:key
2021-03-03 15:25:04 +01:00
channels
(checkouts '())
(checkout-changes '())
status builds
builds-id-min builds-id-max)
"Return HTML for an evaluation page, containing a table of builds for that
evaluation."
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define id (evaluation-summary-id evaluation))
(define total (evaluation-summary-total evaluation))
(define timestamp (evaluation-summary-start-time evaluation))
(define evaltime (evaluation-summary-completion-time evaluation))
(define duration (- evaltime timestamp))
(define spec (evaluation-specification-name (db-get-evaluation id)))
`((p (@ (class "lead"))
"Evaluation #" ,(number->string id)
", " (a (@ (href "/jobset/" ,spec)) ,spec) " jobset")
,@(if (= timestamp 0)
'()
`((p ,(if (= evaltime 0)
(format #f "Evaluation started ~a."
(time->string timestamp))
(format #f "Completed ~a in ~a."
(time->string evaltime)
(seconds->string duration))))))
,(checkout-table checkouts channels
#:changes checkout-changes)
,(let ((status (evaluation-summary-status evaluation)))
(cond ((= status (evaluation-status started))
`(p (@ (class "lead"))
(span (@ (class "oi oi-cog pr-2")) "")
"Evaluation is in progress…"))
((= status (evaluation-status failed))
`(p (@ (class "lead"))
(a (@ (class "oi oi-circle-x text-danger pr-2")
(href ,(string-append "/eval/"
(number->string id)
"/log/raw")))
"")
"Evaluation failed."))
((= status (evaluation-status aborted))
`(p (@ (class "lead"))
(a (@ (class "oi oi-circle-x text-warning pr-2")
(href ,(string-append "/eval/"
(number->string id)
"/log/raw")))
"")
"Evaluation canceled."))
(else "")))
,@(if (and (null? builds)
(not (= (evaluation-summary-status evaluation)
(evaluation-status succeeded))))
'()
`((p (@ (class "lead"))
,(format #f "~@[~a~] ~:[B~;b~]uilds"
(and=> status string-capitalize)
status)
" "
(a (@ (class "oi oi-monitor mr-2")
(style "font-size:0.8em")
(href "/eval/" ,id "/dashboard")
(role "button")))
(a (@ (id "paginate")
(class "oi oi-collapse-down")
(style "font-size:0.7em")
(href "")
(role "button"))))
(ul (@ (class "nav nav-tabs"))
(li (@ (class "nav-item"))
(a (@ (class ,(string-append "nav-link "
(match status
(#f "active")
(_ ""))))
(href "?all="))
"All "
(span (@ (class "badge badge-light badge-pill"))
,total)))
(li (@ (class "nav-item"))
(a (@ (class ,(string-append "nav-link "
(match status
("pending" "active")
(_ ""))))
(href "?status=pending"))
(span (@ (class "oi oi-clock text-warning")
(title "Scheduled")
(aria-hidden "true"))
"")
" Scheduled "
(span (@ (class "badge badge-light badge-pill"))
,(evaluation-summary-scheduled evaluation))))
(li (@ (class "nav-item"))
(a (@ (class ,(string-append "nav-link "
(match status
("succeeded" "active")
(_ ""))))
(href "?status=succeeded"))
(span (@ (class "oi oi-check text-success")
(title "Succeeded")
(aria-hidden "true"))
"")
" Succeeded "
(span (@ (class "badge badge-light badge-pill"))
,(evaluation-summary-succeeded evaluation))))
(li (@ (class "nav-item"))
(a (@ (class ,(string-append "nav-link "
(match status
("failed" "active")
(_ ""))))
(href "?status=failed"))
(span (@ (class "oi oi-x text-danger")
(title "Failed")
(aria-hidden "true"))
"")
" Failed "
(span (@ (class "badge badge-light badge-pill"))
,(evaluation-summary-failed evaluation)))))
(div (@ (class "tab-content pt-3"))
(div (@ (class "tab-pane show active"))
,(build-eval-table
id
builds
builds-id-min
builds-id-max
status)))))))
(define (build-search-results-table query builds build-min build-max)
"Return HTML for the BUILDS table evaluation matching QUERY. BUILD-MIN
and BUILD-MAX are global minimal and maximal row identifiers."
(define (table-header)
`(thead
(tr
(th (@ (scope "col")) '())
(th (@ (scope "col")) "ID")
(th (@ (scope "col")) "Specification")
(th (@ (scope "col")) "Completion time")
(th (@ (scope "col")) "Job")
(th (@ (scope "col")) "Name")
(th (@ (scope "col")) "System"))))
(define (table-row build)
(define status
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-current-status build))
`(tr
(td (a (@ (class ,(status-class status))
(title ,(status-title status))
(aria-hidden "true")
,@(if (completed-with-logs? status)
`((href "/build/" ,(build-id build) "/log"))
'()))
""))
(th (@ (scope "row"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(a (@ (href "/build/" ,(build-id build) "/details"))
,(build-id build)))
(td ,(build-specification-name build))
(td ,(if (completed? status)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(time->string (build-completion-time build))
"—"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(td ,(build-job-name build))
(td ,(build-nix-name build))
(td ,(build-system build))))
`((p (@ (class "lead"))
"Builds matching " (em ,query))
(table
(@ (class "table table-sm table-hover table-striped"))
,@(if (null? builds)
`((th (@ (scope "col")) "No elements here."))
`(,(table-header)
(tbody ,@(map table-row builds)))))
,(if (null? builds)
(pagination "" "" "" "")
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(let* ((build-ids (map build-id builds))
(page-build-min (last build-ids))
(page-build-max (first build-ids)))
(pagination
(format
#f "?query=~a&border-high-id=~d"
query
(1+ (first build-max)))
(if (equal? page-build-max (first build-max))
""
(format
#f "?query=~a&border-low-id=~d"
query
page-build-max))
(if (equal? page-build-min (first build-min))
""
(format
#f "?query=~a&border-high-id=~d"
query
page-build-min))
(format
#f "?query=~a&border-low-id=~d"
query
(1- (first build-min))))))))
(define (running-builds-table builds)
"Return HTML for the running builds table."
(define (build-row build)
`(tr
(th (@ (scope "row"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(a (@ (href "/build/" ,(build-id build) "/details"))
,(build-id build)))
(td ,(build-job-name build))
(td ,(time->string
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(build-start-time build)))
(td ,(build-system build))
(td (a (@ (href "/build/" ,(build-id build) "/log"))
"log"))))
`((p (@ (class "lead")) "Running builds")
(table
(@ (class "table table-sm table-hover table-striped"))
,@(if (null? builds)
`((th (@ (scope "col")) "No elements here."))
`((thead (tr (th (@ (scope "col")) "ID")
(th (@ (scope "col")) "Job")
(th (@ (scope "col")) "Queued at")
(th (@ (scope "col")) "System")
(th (@ (scope "col")) "Log")))
(tbody
,(map build-row builds)))))))
(define* (make-line-chart id datasets
#:key
(interpolation? #t)
(legend? #f)
(time-x-axes? #f)
xaxes-labels
x-label
y-label
2021-02-08 12:25:47 +01:00
(x-unit "day")
title
labels
colors)
(let* ((normal-xAxes (vector `((type . "category")
(labels . ,xaxes-labels)
(display . #t)
(scaleLabel
. ((display . #t)
(labelString . ,x-label))))))
(time-xAxes (vector `((type . "time")
2021-02-08 12:25:47 +01:00
(time . ((unit . ,x-unit)))
(display . #t)
(distribution . "series")
(scaleLabel
. ((display . #t)
(labelString . ,x-label))))))
(scales `((xAxes . ,(if time-x-axes?
time-xAxes
normal-xAxes))
(yAxes
. ,(vector `((display . #t)
(scaleLabel
. ((display . #t)
(labelString . ,y-label))))))))
(chart `((type . "line")
(data . ((datasets
. ,(apply vector
(map (lambda (dataset label color)
`((fill . #f)
(label . ,label)
,@(if interpolation?
'()
'((lineTension . 0)))
(borderColor . ,color)
(data . ,dataset)))
datasets labels colors)))))
(options . ((responsive . #t)
(tooltips . ((enabled . #f)))
(legend . ((display . ,legend?)))
(title . ((display . #f)
(text . ,title)))
(scales . ,scales))))))
`((script ,(format #f "window.addEventListener('load',
function(event) {\
window.~a = new Chart\
(document.getElementById('~a').getContext('2d'), ~a);\
});" id id (string-replace-substring
(scm->json-string chart) "\"" "'"))))))
(define* (global-metrics-content #:key
avg-eval-durations
avg-eval-build-start-time
builds-per-day
2021-03-23 09:47:08 +01:00
builds-per-machine
eval-completion-speed
new-derivations-per-day
pending-builds
percentage-failed-eval)
(define (avg-eval-duration-row . eval-durations)
(let ((spec (match eval-durations
(((spec . _) . rest) spec))))
`(tr (td ,spec)
,@(map (lambda (duration)
`(td ,(number->string
(nearest-exact-integer duration))))
(map cdr eval-durations)))))
(define (percentage-failed-eval-row . percentages)
(let ((spec (match percentages
(((spec . _) . rest) spec))))
`(tr (td ,spec)
,@(map (lambda (duration)
`(td ,(number->string
(nearest-exact-integer duration))
"%"))
(map cdr percentages)))))
2021-03-23 09:47:08 +01:00
(define (builds-per-machine-rows builds)
(map (match-lambda
((field . value)
`(tr (td ,field)
(td ,(number->string
(nearest-exact-integer value))))))
builds))
(define (builds->json-scm builds)
(apply vector
(map (match-lambda
((field . value)
`((x . ,(* field 1000)) (y . ,value))))
builds)))
(define (evals->json-scm evals)
(apply vector
(map (match-lambda
((field . value)
`((x . ,(number->string field)) (y . ,value))))
evals)))
(define (evals->labels evals)
(apply vector
(map (match-lambda
((field . value) field))
evals)))
(let ((builds-chart "builds_per_day")
(build-start-chart "avg_eval_build_start_time")
(evaluation-speed-chart "eval_speed_chart")
(pending-builds-chart "pending_builds"))
`((p (@ (class "lead")) "Global metrics")
(h6 "Average evaluation duration per specification (seconds).")
(table
(@ (class "table table-sm table-hover table-striped"))
(thead (tr (th (@ (scope "col")) "Specification")
(th (@ (scope "col")) "10 last evaluations")
(th (@ (scope "col")) "100 last evaluations")
(th (@ (scope "col")) "All evaluations")))
(tbody
,(apply map avg-eval-duration-row avg-eval-durations)))
(br)
(h6 "Builds completion.")
(p "This shows the difference between newly added derivations and built
derivations per day.")
(canvas (@ (id ,builds-chart)) "")
(br)
(h6 "Evaluation average build start time.")
(p "This is the average time required for an evaluation to start its
builds.")
(br)
(canvas (@ (id ,build-start-chart)) "")
(br)
(h6 "Evaluation completion speed.")
(p "The evaluation completion speed is the sum of an evaluation
completed builds divided by the time required to build them.")
(br)
(canvas (@ (id ,evaluation-speed-chart)) "")
(br)
(h6 "Pending builds.")
(p "This is the sum of all the currently pending builds.")
(br)
(canvas (@ (id ,pending-builds-chart)) "")
(br)
2021-03-23 09:47:08 +01:00
(h6 "Builds per machine.")
(p "This is the builds count per machine during the last day.")
(table
(@ (class "table table-sm table-hover table-striped"))
(thead (tr (th (@ (scope "col")) "Machine")
(th (@ (scope "col")) "Builds (last 24 hours)")))
(tbody
,(builds-per-machine-rows builds-per-machine)))
(br)
(h6 "Percentage of failed evaluations.")
(table
(@ (class "table table-sm table-hover table-striped"))
(thead (tr (th (@ (scope "col")) "Specification")
(th (@ (scope "col")) "10 last evaluations")
(th (@ (scope "col")) "100 last evaluations")
(th (@ (scope "col")) "All evaluations")))
(tbody
,(apply map percentage-failed-eval-row percentage-failed-eval)))
;; Scripts.
,@(make-line-chart builds-chart
(list (builds->json-scm new-derivations-per-day)
(builds->json-scm builds-per-day))
#:interpolation? #f
#:time-x-axes? #t
#:x-label "Day"
#:y-label "Builds"
#:title "Builds per day"
#:legend? #t
#:labels '("New derivations"
"Builds completed")
#:colors (list "#f6dd27" "#3e95cd"))
,@(make-line-chart build-start-chart
(list (evals->json-scm avg-eval-build-start-time))
#:xaxes-labels (evals->labels
avg-eval-build-start-time)
#:x-label "Evaluations"
#:y-label "Time (s)"
#:title "Evaluation average build start time"
#:labels '("Build start time")
#:colors (list "#3e95cd"))
,@(make-line-chart evaluation-speed-chart
(list (evals->json-scm eval-completion-speed))
#:xaxes-labels (evals->labels
eval-completion-speed)
#:x-label "Evaluations"
#:y-label "Speed (builds/hour)"
#:title "Evaluation completion speed"
#:labels '("Completion speed")
#:colors (list "#3e95cd"))
,@(make-line-chart pending-builds-chart
(list (builds->json-scm pending-builds))
#:time-x-axes? #t
#:x-label "Day"
#:y-label "Builds"
#:title "Pending builds"
#:labels '("Pending builds")
#:colors (list "#3e95cd")))))
(define system->color-class
(let ((alist (map cons
%supported-systems
(circular-list "" "bg-success"
"bg-info" "bg-warning"
"bg-danger"))))
(lambda (system)
"Return a Bootstrap color class for SYSTEM, a system type such as
\"x86_64-linux\"."
(or (assoc-ref alist system) ""))))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define (workers-status workers builds percentages)
(define (machine-row machine)
(let* ((workers (sort (filter (lambda (worker)
(string=? (worker-machine worker)
machine))
workers)
(lambda (w1 w2)
(string<? (worker-name w1)
(worker-name w2))))))
`(div (@ (class "col-sm-4 mt-3"))
2021-02-08 12:25:47 +01:00
(a (@(href "/machine/" ,machine))
(h6 ,machine))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(map (lambda (worker)
(define build
(find (lambda (build)
(and (build-worker build)
(string=? (build-worker build)
(worker-name worker))))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
builds))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define percentage
(and build (assq-ref percentages build)))
(let ((style (format #f
"width: ~a%"
(if build
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
percentage
0))))
`(div (@ (class "progress mt-1")
(style "height: 20px"))
(div (@ (class
"progress-bar "
,(system->color-class
(if build
(build-system build)
(first (worker-systems worker)))))
(role "progressbar")
(style ,style)
(aria-valuemin "0")
(aria-valuemax "100"))
,(if build
`(strong
(@ (class "justify-content-center
d-flex position-absolute w-100"))
(a (@ (class "text-dark text-truncate")
(style "max-width: 150px")
(href "/build/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-id build)
"/details"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-job-name build)))
'(em
(@ (class "justify-content-center
text-dark d-flex position-absolute w-100"))
"idle"))))))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
workers))))
(let ((machines (reverse
(sort (delete-duplicates
(map worker-machine workers))
version>?))))
`((p (@ (class "lead")) "Workers status")
(div (@ (class "container"))
(div (@ (class "row"))
,@(map machine-row machines))))))
2021-02-08 12:25:47 +01:00
(define* (machine-status name workers builds info)
(define (history->json-scm history)
(apply vector
(map (match-lambda
((field . value)
`((x . ,(* field 1000)) (y . ,value))))
history)))
(define (ram-available->json-scm history)
(apply vector
(map (match-lambda
((field . value)
`((x . ,(* field 1000))
(y . ,(/ value (expt 2 30))))))
history)))
`((p (@ (class "lead")) "Machine " ,name)
,@(if (null? info)
'()
`((table
(@ (class "table table-sm table-hover table-striped"))
(tbody
(tr (th "Hostname")
(td ,(assq-ref info #:hostname)))
(tr (th "Info")
(td ,(assq-ref info #:info)))
(tr (th "Boot time")
(td ,(time->string
(assq-ref info #:boottime))))
(tr (th "Total RAM")
(td ,(assq-ref info #:ram)))
(tr (th "Total root disk space")
(td ,(assq-ref info #:root-space)))
(tr (th "Total store disk space")
(td ,(assq-ref info #:store-space)))))))
(h6 "Workers")
(table
(@ (class "table table-sm table-hover table-striped"))
,@(if (null? workers)
`((th (@ (scope "col")) "No elements here."))
`((thead
(tr
(th (@ (scope "col")) "Name")
(th (@ (scope "col")) "Systems")
(th (@ (scope "col")) "Building")
(th (@ (scope "col")) "Last seen")))
(tbody
,@(map
(lambda (worker build)
`(tr (td ,(worker-name worker))
(td ,(string-join (worker-systems worker)
", "))
(td ,(match build
(() "idle")
((build _ ...)
2021-02-08 12:25:47 +01:00
`(a (@ (class "text-truncate")
(style "max-width: 150px")
(href "/build/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-id build)
2021-02-08 12:25:47 +01:00
"/details"))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
,(build-job-name build)))))
2021-02-08 12:25:47 +01:00
(td ,(time->string
(worker-last-seen worker)))))
workers builds)))))
,@(if (null? info)
'((div (@ (class "alert alert-danger"))
"Could not find machine information using Zabbix."))
`((h6 "CPU idle time")
,@(let ((cpu-idle (assq-ref info #:cpu-idle))
(cpu-idle-chart "cpu_idle_chart"))
`((br)
(canvas (@ (id ,cpu-idle-chart)) "")
2021-02-08 12:25:47 +01:00
,@(make-line-chart cpu-idle-chart
(list (history->json-scm cpu-idle))
#:time-x-axes? #t
#:x-label "Time"
#:y-label "Percentage"
#:x-unit "minute"
#:title "CPU idle time"
#:labels '("CPU idle time")
#:colors (list "#3e95cd"))))
(br)
(h6 "Available memory")
,@(let ((ram-available (assq-ref info #:ram-available))
(ram-available-chart "ram_available_chart"))
`((br)
(canvas (@ (id ,ram-available-chart)) "")
2021-02-08 12:25:47 +01:00
,@(make-line-chart ram-available-chart
(list
(ram-available->json-scm ram-available))
#:time-x-axes? #t
#:x-label "Time"
#:y-label "GiB"
#:x-unit "minute"
#:title
"Available memory"
#:labels
'("Available memory")
#:colors (list "#3e95cd"))))
(br)
(h6 "Free store disk space percentage")
,@(let ((store-free (assq-ref info #:store-free))
(store-free-chart "store_free_chart"))
`((br)
(canvas (@ (id ,store-free-chart)) "")
2021-02-08 12:25:47 +01:00
,@(make-line-chart store-free-chart
(list (history->json-scm store-free))
#:time-x-axes? #t
#:x-label "Time"
#:y-label "Percentage"
#:x-unit "minute"
#:title
"Free store disk space percentage"
#:labels
'("Free store disk space percentage")
#:colors (list "#3e95cd"))))))))
(define (pretty-build-log id)
"Return HTML for a pretty rendering of the log of build ID."
(let ((url (string-append "/build/" (number->string id)
"/log/raw")))
`((noscript
"This page requires JavaScript but you can "
(a (@ (href ,url)) "view the raw build log")
" instead.")
(script (@ (type "text/javascript")
(src "/static/js/build-log.js"))
"")
(pre (code (@ (id "build-log") (class "build-log"))
;; Placeholder filled in by 'build-log.js'.
"⚙️ Loading build log…"))
(div (@ (class "text-secondary d-flex flex-row mb-3"))
(span (@ (class "oi oi-data-transfer-download pr-2")) "")
(a (@ (href ,url)) "raw build log")))))
(define* (evaluation-dashboard evaluation systems
#:key
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(checkouts (evaluation-checkouts evaluation))
channels
current-system
2021-04-21 12:59:18 +02:00
dashboard-id
names
prev-eval
next-eval)
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(define id
(evaluation-id evaluation))
(define time
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(evaluation-completion-time evaluation))
(define checkout-changes
(evaluation-checkouts evaluation))
(let ((jobs
(if names
(format #f "/api/jobs?evaluation=~a&names=~a"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
id names)
(format #f "/api/jobs?evaluation=~a&system=~a"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
id current-system))))
`((nav
(@ (aria-label "Evaluation navigation")
(class "eval-nav"))
(ul (@ (class "pagination pagination-sm"))
(li
(p (@ (class "lead mb-0 mr-3"))
"Dashboard for "
(a (@ (href ,(string-append "/eval/"
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(number->string id))))
"evaluation #" ,(number->string id))))
(li (@ (class
,(string-append "page-item "
(if prev-eval
""
"disabled"))))
,(let ((name "Previous evaluation"))
`(a
(@ (id "dashboard-prev-link")
(class "page-link")
(title ,name)
(aria-label ,name)
(href
,(if prev-eval
(format #f "/eval/~a/dashboard~a"
prev-eval
(if dashboard-id
(format #f "/~a" dashboard-id)
""))
"#")))
"«")))
(li (@ (class
,(string-append "page-item "
(if next-eval
""
"disabled"))))
,(let ((name "Next evaluation"))
`(a
(@ (id "dashboard-next-link")
(class "page-link")
(title ,name)
(aria-label ,name)
(href
,(if next-eval
(format #f "/eval/~a/dashboard~a"
next-eval
(if dashboard-id
(format #f "/~a" dashboard-id)
""))
"#")))
"»")))))
(details
(summary ,(format #f "Evaluation completed ~a."
(time->string time)))
,(checkout-table checkouts channels
#:changes checkout-changes))
(form (@ (id "get-dashboard")
2021-04-21 12:59:18 +02:00
(class
,(string-append "row g-3 mb-3 "
(if names
"d-none"
"")))
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(action "/eval/" ,id "/dashboard")
(method "GET"))
(div (@ (class "col-auto"))
(select (@ (id "system")
(name "system")
(class "form-control"))
,@(map (lambda (system)
`(option
(@ (value ,system)
,@(if (string=? system current-system)
'((selected))
'()))
,system))
systems)))
(div (@ (class "col-auto"))
(button
(@ (id "load-btn")
(class "btn btn-primary")
(type "submit")
(disabled))
(span
(@ (class "spinner-border spinner-border-sm")
(role "status")
(aria-hidden "true"))
"")
" Loading")))
(div
(@ (class "input-group")
(role "search")
(style "width:15em"))
(label (@ (for "query-jobs")
(class "sr-only"))
"Search for jobs")
(input (@ (type "text")
(class "form-control")
(id "query-jobs")
(name "query-jobs")
(placeholder "search for jobs"))))
(br)
(div (@ (id "dashboard")
(class "invisible")
(url ,jobs))))))
(define* (badge-svg spec badge-string summary
#:key type)
"Return the badge SVG for the specification with the given SUMMARY. The
BADGE-STRING procedure takes a badge name as input an returns the badge
content as a string."
(define (replace str patterns)
(match patterns
(() str)
(((in out) . rest)
(replace (string-replace-substring str in out) rest))))
(if summary
(let* ((succeeded
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(evaluation-summary-succeeded summary))
(total
database: Use records instead of alists. Instead of using alists, internal code now manipulates records. Strong typing makes the code easier to understand and to check for correctness. * src/cuirass/database.scm (<build>, <build-product>, <job>) (<output>): New record types. (db-add-output): Keep a single argument, expect an <output> record. (db-add-build-product): Expect a <build> record and return its ID on success. (db-add-build-product, db-get-output, db-get-outputs) (db-get-build-percentages): Use record accessors and constructors. (db-add-job): Rename to... (db-add-job-for-build): ... this. Expect records. (db-get-jobs): Likewise. Augment query to include 'evaluation'. (<evaluation>): New record type. (db-get-build-dependencies/derivation, build-dependencies/id): New procedures. (db-register-builds): Change signature and adjust for records. (db-get-last-status): Produce records. (db-get-builds-by-search, db-get-builds): Likewise. (<checkout>): New record type. (db-get-checkouts, db-get-latest-checkout): Produce them. (parse-evaluation): Likewise. (<build-summary>, <evaluation-summary>): New record types. (db-get-latest-evaluations, db-get-evaluation-summary): Produce them. (db-get-evaluations-absolute-summary): Adjust for records. (<dashboard>): New record type. (db-get-dashboard): Produce it. * src/cuirass/http.scm (build->hydra-build): Expect records. (evaluation->json-object): Likewise. (evaluation-html-page): Likewise. (url-handler): Likewise. * src/cuirass/notification.scm (build-weather-text) (build-details-url, notification-subject, notification-text): Likewise. * src/cuirass/rss.scm (build-details-url, build->rss-item): Likewise. * src/cuirass/scripts/evaluate.scm (checkouts->channel-instances): Likewise. (user-alists->builds): New procedure. (inferior-evaluation): Use it. * src/cuirass/templates.scm (specifications-table, build-details) (input-changes, evaluation-badges, evaluation-info-table) (build-eval-table, evaluation-build-table, running-builds-table): Adjust for records. (workers-status): Likewise, and add 'percentages' parameter. (machine-status, evaluation-dashboard): Adjust for records. * src/cuirass/base.scm (set-build-successful!, build-derivation=?) (create-build-outputs, build-packages): Likewise. * tests/database.scm (make-dummy-build): Likewsise. All tests use and expect records. * tests/remote.scm: Likewise. * tests/http.scm: Likewise.
2023-08-14 23:44:51 +02:00
(evaluation-summary-total summary))
(percentage
(nearest-exact-integer
(* 100 (/ succeeded total))))
(percentage-str
(string-append
(number->string percentage) "%")))
(case type
((0)
(replace (badge-string "badge-percentage.svg")
`(("X%" ,percentage-str))))
(else
(replace (badge-string "badge-spec-percentage.svg")
`(("X%" ,percentage-str)
("_name" ,spec))))))
(badge-string "badge-error.svg")))
(define (javascript-licenses)
"Return the Javascript licenses table, for compatibility with LibreJS. See:
https://www.gnu.org/software/librejs/free-your-javascript.html."
'((table
(@ (id "jslicense-labels1"))
(tr
(td (a (@ (href "/static/js/popper.min.js")) "popper.min.js"))
(td (a (@ (href "https://github.com/popperjs/popper-core/blob/master/LICENSE.md"))
"Expat"))
(td (a (@ (href "/static/js/popper.min.js")) "popper.js") ))
(tr
(td (a (@ (href "/static/js/datatables.min.js")) "datatables.min.js"))
(td (a (@ (href "https://datatables.net/license/mit")) "Expat"))
(td (a (@ (href "https://cdn.datatables.net/1.10.24/js/dataTables.bootstrap.js"))
"dataTables.bootstrap.js")))
(tr
(td (a (@ (href "/static/js/d3.v6.min.js")) "d3.v6.min.js"))
(td (a (@ (href "https://raw.githubusercontent.com/d3/d3/main/LICENSE"))
"BSD-3-Clause"))
(td (a (@ (href "https://github.com/d3/d3/releases/tag/v6.6.2"))
"d3.js")))
(tr
(td (a (@ (href "/static/js/choices.min.js")) "choices.min.js"))
(td (a (@ (href "https://github.com/Choices-js/Choices/blob/master/LICENSE"))
"Expat"))
(td (a (@ (href "http://libs.wware.org/choices.js/9.0.1/scripts/choices.js"))
"choices.js")))
(tr
(td (a (@ (href "/static/js/chart.js")) "chart.js"))
(td (a (@ (href "https://github.com/chartjs/Chart.js/blob/master/LICENSE.md"))
"Expat"))
(td (a (@ (href "https://github.com/chartjs/Chart.js/releases/tag/v2.9.3"))
"Chart.js")))
(tr
(td (a (@ (href "/static/js/bootstrap.min.js")) "bootstrap.min.js"))
(td (a (@ (href "https://github.com/twbs/bootstrap/blob/master/LICENSE"))
"Expat"))
(td (a (@ (href "https://github.com/twbs/bootstrap/releases/download/v4.2.1/bootstrap-4.2.1-dist.zip"))
"bootstrap.js"))))))