database: Indent 'db-get-builds'.
* src/cuirass/database.scm (db-get-builds): Reindent.
This commit is contained in:
Ludovic Courtès
parent
36d7c93119
commit
be3650d965
|
|
@ -382,7 +382,7 @@ FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job |
|
|||
(assqx-ref rest key)))))
|
||||
|
||||
(define (format-output name path)
|
||||
`(,name . ((#:path . ,path))))
|
||||
`(,name . ((#:path . ,path))))
|
||||
|
||||
(define (cons-output name path rest)
|
||||
"If NAME and PATH are both not #f, cons them to REST.
|
||||
|
|
@ -412,57 +412,57 @@ This is made specifically to support LEFT JOINs.
|
|||
Assumes that if group id stays the same the group headers stay the same."
|
||||
(define (finish-group)
|
||||
(match repeated-row
|
||||
(#(timestamp starttime stoptime log status derivation job-name system
|
||||
nix-name repo-name branch)
|
||||
`((#:id . ,repeated-builds-id)
|
||||
(#:timestamp . ,timestamp)
|
||||
(#:starttime . ,starttime)
|
||||
(#:stoptime . ,stoptime)
|
||||
(#:log . ,log)
|
||||
(#:status . ,status)
|
||||
(#:derivation . ,derivation)
|
||||
(#:job-name . ,job-name)
|
||||
(#:system . ,system)
|
||||
(#:nix-name . ,nix-name)
|
||||
(#:repo-name . ,repo-name)
|
||||
(#:outputs . ,outputs)
|
||||
(#:branch . ,branch)))))
|
||||
(#(timestamp starttime stoptime log status derivation job-name system
|
||||
nix-name repo-name branch)
|
||||
`((#:id . ,repeated-builds-id)
|
||||
(#:timestamp . ,timestamp)
|
||||
(#:starttime . ,starttime)
|
||||
(#:stoptime . ,stoptime)
|
||||
(#:log . ,log)
|
||||
(#:status . ,status)
|
||||
(#:derivation . ,derivation)
|
||||
(#:job-name . ,job-name)
|
||||
(#:system . ,system)
|
||||
(#:nix-name . ,nix-name)
|
||||
(#:repo-name . ,repo-name)
|
||||
(#:outputs . ,outputs)
|
||||
(#:branch . ,branch)))))
|
||||
|
||||
(define (same-group? builds-id)
|
||||
(= builds-id repeated-builds-id))
|
||||
|
||||
(match rows
|
||||
(() (list (finish-group)))
|
||||
((#((? same-group? x-builds-id) x-output-name x-output-path other-cells ...) . rest)
|
||||
;; Accumulate group members of current group.
|
||||
(let ((outputs (cons-output x-output-name x-output-path outputs)))
|
||||
(collect-outputs repeated-builds-id repeated-row outputs rest)))
|
||||
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
|
||||
(cons ;; Finish current group.
|
||||
(finish-group)
|
||||
;; Start new group.
|
||||
(let ((outputs (cons-output x-output-name x-output-path '())))
|
||||
(let ((x-repeated-row (list->vector other-cells)))
|
||||
(collect-outputs x-builds-id x-repeated-row outputs rest)))))))
|
||||
(() (list (finish-group)))
|
||||
((#((? same-group? x-builds-id) x-output-name x-output-path other-cells ...) . rest)
|
||||
;; Accumulate group members of current group.
|
||||
(let ((outputs (cons-output x-output-name x-output-path outputs)))
|
||||
(collect-outputs repeated-builds-id repeated-row outputs rest)))
|
||||
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
|
||||
(cons (finish-group) ;finish current group
|
||||
|
||||
;; Start new group.
|
||||
(let* ((outputs (cons-output x-output-name x-output-path '()))
|
||||
(x-repeated-row (list->vector other-cells)))
|
||||
(collect-outputs x-builds-id x-repeated-row outputs rest))))))
|
||||
|
||||
(define (group-outputs rows)
|
||||
(match rows
|
||||
(() '())
|
||||
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
|
||||
(let ((x-repeated-row (list->vector other-cells)))
|
||||
(collect-outputs x-builds-id x-repeated-row '() rows)))))
|
||||
(() '())
|
||||
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
|
||||
(let ((x-repeated-row (list->vector other-cells)))
|
||||
(collect-outputs x-builds-id x-repeated-row '() rows)))))
|
||||
|
||||
(let* ((order (if (eq? (assqx-ref filters 'order) 'build-id)
|
||||
"ASC"
|
||||
"DESC"))
|
||||
"ASC"
|
||||
"DESC"))
|
||||
(order-column-name
|
||||
(match (assqx-ref filters 'order)
|
||||
(('order 'build-id) "Builds.id")
|
||||
(('order 'decreasing-build-id) "Builds.id")
|
||||
(('order 'finish-time) "Builds.stoptime")
|
||||
(('order 'start-time) "Builds.starttime")
|
||||
(('order 'submission-time) "Builds.timestamp")
|
||||
(_ "Builds.id")))
|
||||
(('order 'build-id) "Builds.id")
|
||||
(('order 'decreasing-build-id) "Builds.id")
|
||||
(('order 'finish-time) "Builds.stoptime")
|
||||
(('order 'start-time) "Builds.starttime")
|
||||
(('order 'submission-time) "Builds.timestamp")
|
||||
(_ "Builds.id")))
|
||||
(stmt-text (format #f "\
|
||||
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\
|
||||
Derivations.job_name, Derivations.system, Derivations.nix_name,\
|
||||
|
|
@ -481,15 +481,15 @@ AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status =
|
|||
ORDER BY ~a ~a, Builds.id ASC LIMIT :nr;" order-column-name order))
|
||||
(stmt (sqlite-prepare db stmt-text #:cache? #t)))
|
||||
(sqlite-bind-arguments stmt #:id (assqx-ref filters 'id)
|
||||
#:project (assqx-ref filters 'project)
|
||||
#:jobset (assqx-ref filters 'jobset)
|
||||
#:job (assqx-ref filters 'job)
|
||||
#:system (assqx-ref filters 'system)
|
||||
#:status (and=> (assqx-ref filters 'status)
|
||||
object->string)
|
||||
#:nr (match (assqx-ref filters 'nr)
|
||||
(#f -1)
|
||||
(x x)))
|
||||
#:project (assqx-ref filters 'project)
|
||||
#:jobset (assqx-ref filters 'jobset)
|
||||
#:job (assqx-ref filters 'job)
|
||||
#:system (assqx-ref filters 'system)
|
||||
#:status (and=> (assqx-ref filters 'status)
|
||||
object->string)
|
||||
#:nr (match (assqx-ref filters 'nr)
|
||||
(#f -1)
|
||||
(x x)))
|
||||
(sqlite-reset stmt)
|
||||
(group-outputs (sqlite-fold-right cons '() stmt))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue