diff options
| -rw-r--r-- | src/cuirass/database.scm | 98 |
1 files changed, 49 insertions, 49 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 147028e..f47152a 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -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)))) |