guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add build weather support. 

* src/cuirass/database.scm (build-weather): New macro.
(build-status->weather): New procedure.
(db-get-builds): Return the build weather using the new procedure.
* src/cuirass/http.scm (build->hydra-build): Also return the weather.
* src/cuirass/templates.scm (weather-class, weather-title): New procedures.
(build-eval-table): Display the weather.
* tests/database.scm ("db-get-build weather"): New tests.
* tests/http.scm (build-query-result): Adapt it.
This commit is contained in:
Mathieu Othacehe 2021-02-01 14:27:24 +01:00
parent 54244e6e97
commit d7282c05c0
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
5 changed files with 111 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
src/cuirass/database.scm
View File

@ -58,6 +58,7 @@
db-set-evaluation-status
db-set-evaluation-time
build-status
build-weather
db-add-output
db-add-build
db-add-build-product
@ -930,6 +931,26 @@ ORDER BY Builds.id DESC;"))
(#:buildproducts . ,(db-get-build-products id)))
result))))))))
(define-enumeration build-weather
(unknown -1)
(new-success 0)
(new-failure 1)
(still-succeeding 2)
(still-failing 3))
(define (build-status->weather status last-status)
(cond
((or (< status 0) (not last-status))
(build-weather unknown))
((and (= status 0) (> last-status 0))
(build-weather new-success))
((and (> status 0) (= last-status 0))
(build-weather new-failure))
((and (= status 0) (= last-status 0))
(build-weather still-succeeding))
((and (> status 0) (> last-status 0))
(build-weather still-failing))))
(define (db-get-builds filters)
"Retrieve all builds in the database which are matched by given FILTERS.
FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jobset |
@ -1084,34 +1105,38 @@ ORDER BY ~a;"
products-id products-type products-file-size
products-checksum products-path)
. rest)
(loop rest
(cons `((#:derivation . ,derivation)
(#:id . ,(string->number id))
(#:timestamp . ,(string->number timestamp))
(#:starttime . ,(string->number starttime))
(#:stoptime . ,(string->number stoptime))
(#:log . ,log)
(#:status . ,(string->number status))
(#:last-status . ,(and last-status
(string->number last-status)))
(#:priority . ,(string->number priority))
(#:max-silent . ,(string->number max-silent))
(#:timeout . ,(string->number timeout))
(#:job-name . ,job-name)
(#:system . ,system)
(#:worker . ,worker)
(#:nix-name . ,nix-name)
(#:eval-id . ,(string->number eval-id))
(#:specification . ,specification)
(#:outputs . ,(format-outputs outputs-name
outputs-path))
(#:buildproducts .
,(format-build-products products-id
products-type
products-file-size
products-checksum
products-path)))
result))))))))
(let* ((status (string->number status))
(last-status (and last-status
(string->number last-status)))
(weather (build-status->weather status last-status)))
(loop rest
(cons `((#:derivation . ,derivation)
(#:id . ,(string->number id))
(#:timestamp . ,(string->number timestamp))
(#:starttime . ,(string->number starttime))
(#:stoptime . ,(string->number stoptime))
(#:log . ,log)
(#:status . ,status)
(#:last-status . ,last-status)
(#:weather . ,weather)
(#:priority . ,(string->number priority))
(#:max-silent . ,(string->number max-silent))
(#:timeout . ,(string->number timeout))
(#:job-name . ,job-name)
(#:system . ,system)
(#:worker . ,worker)
(#:nix-name . ,nix-name)
(#:eval-id . ,(string->number eval-id))
(#:specification . ,specification)
(#:outputs . ,(format-outputs outputs-name
outputs-path))
(#:buildproducts .
,(format-build-products products-id
products-type
products-file-size
products-checksum
products-path)))
result)))))))))
(define (db-get-build derivation-or-id)
"Retrieve a build in the database which corresponds to DERIVATION-OR-ID."

1
src/cuirass/http.scm
View File

@ -105,6 +105,7 @@
(#:system . ,(assq-ref build #:system))
(#:nixname . ,(assq-ref build #:nix-name))
(#:buildstatus . ,(assq-ref build #:status))
(#:weather . ,(assq-ref build #:weather))
(#:busy . ,(bool->int (eqv? (build-status started)
(assq-ref build #:status))))
(#:priority . 0)

30
src/cuirass/templates.scm
View File

@ -34,6 +34,7 @@
#:use-module ((guix utils) #:select (string-replace-substring
version>?))
#:use-module ((cuirass database) #:select (build-status
build-weather
evaluation-status))
#:use-module (cuirass remote)
#:export (html-page
@ -489,6 +490,27 @@ system whose names start with " (code "guile-") ":" (br)
"~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."
@ -501,6 +523,7 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
(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")) "Weather")
(th (@ (scope "col") (class "border-0")) "System")
(th (@ (scope "col") (class "border-0")) "Log"))))
@ -508,6 +531,9 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
(define status
(assq-ref build #:buildstatus))
(define weather
(assq-ref build #:weather))
(define completed?
(or (= (build-status succeeded) status)
(= (build-status failed) status)))
@ -526,6 +552,10 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
"—"))
(td ,(assq-ref build #:job))
(td ,(assq-ref build #:nixname))
(td (span (@ (class ,(weather-class weather))
(title ,(weather-title weather))
(aria-hidden "true"))
""))
(td ,(assq-ref build #:system))
(td (a (@ (href "/build/" ,(assq-ref build #:id) "/log/raw"))
"raw"))))

26
tests/database.scm
View File

@ -464,6 +464,32 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
(list (db-get-build "/old-build.drv")
(db-get-build "/new-build.drv")))))
(test-equal "db-get-builds weather"
(build-weather new-success)
(begin
(assq-ref (db-get-build "/new-build.drv") #:weather)))
(test-equal "db-get-builds weather"
(build-weather new-failure)
(begin
(db-update-build-status! "/old-build.drv" 0)
(db-update-build-status! "/new-build.drv" 1)
(assq-ref (db-get-build "/new-build.drv") #:weather)))
(test-equal "db-get-builds weather"
(build-weather still-succeeding)
(begin
(db-update-build-status! "/old-build.drv" 0)
(db-update-build-status! "/new-build.drv" 0)
(assq-ref (db-get-build "/new-build.drv") #:weather)))
(test-equal "db-get-builds weather"
(build-weather still-failing)
(begin
(db-update-build-status! "/old-build.drv" 1)
(db-update-build-status! "/new-build.drv" 1)
(assq-ref (db-get-build "/new-build.drv") #:weather)))
(test-assert "db-close"
(begin
(exec-query (%db) (format #f "DROP OWNED BY CURRENT_USER;"))

1
tests/http.scm
View File

@ -65,6 +65,7 @@
(#:system . "x86_64-linux")
(#:nixname . "fake-1.0")
(#:buildstatus . 0)
(#:weather . -1)
(#:busy . 0)
(#:priority . 0)
(#:finished . 1)