Add build history support.
* src/cuirass/database.scm (db-get-builds): Add "oldevaluation" filter. * src/cuirass/templates.scm (build-details): Add "history" argument. * src/cuirass/http.scm (url-handler): Adapt it.
This commit is contained in:
parent
f9a5cbe0dd
commit
a57b066e4f
|
@ -987,6 +987,7 @@ CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
|
|||
(job . "Builds.job_name = :job")
|
||||
(system . "Builds.system = :system")
|
||||
(worker . "Builds.worker = :worker")
|
||||
(oldevaluation . "Builds.evaluation < :oldevaluation")
|
||||
(evaluation . "Builds.evaluation = :evaluation")
|
||||
(status . ,(match (assq-ref filters 'status)
|
||||
(#f #f)
|
||||
|
@ -1088,7 +1089,7 @@ ORDER BY ~a;"
|
|||
name)
|
||||
name))
|
||||
(match name
|
||||
('nr (or value -1))
|
||||
('nr value)
|
||||
('order #f) ; Doesn't need binding.
|
||||
('status #f) ; Doesn't need binding.
|
||||
(else value)))))
|
||||
|
|
|
@ -439,11 +439,19 @@ Hydra format."
|
|||
(respond-build-not-found id))))
|
||||
(('GET "build" (= string->number id) "details")
|
||||
(let* ((build (and id (db-get-build id)))
|
||||
(products (and build (assoc-ref build #:buildproducts))))
|
||||
(products (and build (assoc-ref build #:buildproducts)))
|
||||
(history
|
||||
(db-get-builds
|
||||
`((jobset . ,(assq-ref build #:specification))
|
||||
(job . ,(assq-ref build #:job-name))
|
||||
(oldevaluation . ,(assq-ref build #:eval-id))
|
||||
(status . done)
|
||||
(order . evaluation)
|
||||
(nr . 5)))))
|
||||
(if build
|
||||
(respond-html
|
||||
(html-page (string-append "Build " (number->string id))
|
||||
(build-details build products)
|
||||
(build-details build products history)
|
||||
`(((#:name . ,(assq-ref build #:specification))
|
||||
(#:link . ,(string-append "/jobset/" (assq-ref build #:specification)))))))
|
||||
(respond-build-not-found id))))
|
||||
|
|
|
@ -241,7 +241,7 @@ system whose names start with " (code "guile-") ":" (br)
|
|||
"Add")))))
|
||||
'()))))
|
||||
|
||||
(define (build-details build products)
|
||||
(define (build-details build products history)
|
||||
"Return HTML showing details for the BUILD."
|
||||
(define status (assq-ref build #:status))
|
||||
(define weather (assq-ref build #:weather))
|
||||
|
@ -269,6 +269,21 @@ system whose names start with " (code "guile-") ":" (br)
|
|||
(define evaluation
|
||||
(assq-ref build #:eval-id))
|
||||
|
||||
(define (history-table-row build)
|
||||
(define status
|
||||
(assq-ref build #:status))
|
||||
|
||||
`(tr
|
||||
(td (span (@ (class ,(status-class status))
|
||||
(title ,(status-title status))
|
||||
(aria-hidden "true"))
|
||||
""))
|
||||
(th (@ (scope "row"))
|
||||
(a (@ (href "/build/" ,(assq-ref build #:id) "/details"))
|
||||
,(assq-ref build #:id)))
|
||||
(td ,(assq-ref build #:nix-name))
|
||||
(td ,(time->string (assq-ref build #:stoptime)))))
|
||||
|
||||
`((p (@ (class "lead")) "Build details")
|
||||
(table
|
||||
(@ (class "table table-sm table-hover"))
|
||||
|
@ -282,7 +297,7 @@ system whose names start with " (code "guile-") ":" (br)
|
|||
(tr (th "Status")
|
||||
(td (span (@ (class ,(status-class status))
|
||||
(title ,(status-title status)))
|
||||
,(string-append " " (status-title status)))
|
||||
,(string-append " " (status-title status)))
|
||||
,@(map (lambda (output)
|
||||
`((br)
|
||||
(a (@ (href ,(string-append "/log/" (basename output))))
|
||||
|
@ -349,12 +364,24 @@ system whose names start with " (code "guile-") ":" (br)
|
|||
(div (@ (class "col-md-auto"))
|
||||
"(" ,type ")")
|
||||
(div (@ (class "col-md-auto"))
|
||||
,(byte-count->string size))))))))
|
||||
,(byte-count->string size))))))))
|
||||
products)))
|
||||
`((tr (th "Build outputs")
|
||||
(td
|
||||
(ul (@ (class "list-group d-flex flex-row"))
|
||||
,product-items))))))))))
|
||||
,product-items))))))))
|
||||
,@(if (null? history)
|
||||
'()
|
||||
`((h6 "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."
|
||||
|
|
Loading…
Reference in New Issue