diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-01-17 21:23:34 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-01-17 21:23:34 +0000 |
| commit | bd73f8c42963dc7c9a1c769179443849129ada1e (patch) | |
| tree | c5d928f652a639ca62b903e84d55981d0e9a45cc /guix-build-coordinator | |
| parent | f462547786710c72ab5dc65faf84fb9cdb5ea339 (diff) | |
| download | build-coordinator-bd73f8c42963dc7c9a1c769179443849129ada1e.tar build-coordinator-bd73f8c42963dc7c9a1c769179443849129ada1e.tar.gz | |
Fix up a load of the tag related code
Turns out vector-fold and vector-map don't work like I'd expected them to,
like fold and map for vectors.
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 4 | ||||
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 46 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 21 |
3 files changed, 46 insertions, 25 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index aaf9dd6..917a567 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -158,7 +158,7 @@ ((_ . build-value) (string=? agent-value build-value))) (vector-fold - (lambda (tag result) + (lambda (_ result tag) (if (string=? (car tag) agent-key) (cons tag result) @@ -541,7 +541,7 @@ ((_ . build-value) (string=? agent-value build-value))) (vector-fold - (lambda (tag result) + (lambda (_ result tag) (if (string=? (car tag) agent-key) (cons tag result) diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 98e73e6..16fa529 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -22,6 +22,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-43) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 exceptions) @@ -176,7 +177,13 @@ (lambda (time) (strftime "%F %T" time))) 'null)) - (tags . ,tags) + (tags . ,(vector-map + (lambda (_ tag) + (match tag + ((key . value) + `((key . ,key) + (value . ,value))))) + tags)) (derivation-inputs . ,(list->vector derivation-inputs)) (setup-failures . ,(list->vector setup-failures)))))))) (('POST "build" uuid "cancel") @@ -210,9 +217,15 @@ (render-json `((id . ,agent-id) ,@agent-details - (tags . ,(datastore-fetch-agent-tags - datastore - agent-id)) + (tags . ,(vector-map + (lambda (_ tag) + (match tag + ((key . value) + `((key . ,key) + (value . ,value))))) + (datastore-fetch-agent-tags + datastore + agent-id))) (allocated_builds . ,(list->vector (datastore-list-agent-builds datastore @@ -232,9 +245,14 @@ (let ((agent-details (datastore-find-agent datastore agent-id))) (if agent-details (begin - (datastore-replace-agent-tags datastore - agent-id - (assoc-ref body "tags")) + (datastore-replace-agent-tags + datastore + agent-id + (vector-map + (lambda (_ tag) + `((key . ,(assoc-ref tag "key")) + (value . ,(assoc-ref tag "value")))) + (assoc-ref body "tags"))) (render-json `((result . success)))) (render-json @@ -452,17 +470,11 @@ '()) ,@(if (null? tags) '() - `((tags . ,(list->vector - (map (match-lambda - ((key . value) - `((key . ,key) - (value . ,value)))) - tags))))) + `((tags . ,(list->vector tags)))) ,@(if defer-until `((defer-until . ,(date->string defer-until "~1 ~3"))) '())))) - (define (send-cancel-build-request coordinator-uri build-id) @@ -488,7 +500,8 @@ `(,@(if (null? tags) '() (map (match-lambda - ((key . value) + ((('key . key) + ('value . value)) (simple-format #f "tag=~A:~A" key value)) (key (simple-format #f "tag=~A" key))) @@ -496,7 +509,8 @@ ,@(if (null? not-tags) '() (map (match-lambda - ((key . value) + ((('key . key) + ('value . value)) (simple-format #f "not_tag=~A:~A" key value)) (key (simple-format #f "not_tag=~A" key))) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 6af0b46..a66614a 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -532,19 +532,26 @@ INSERT INTO agent_tags (agent_id, tag_id) VALUES (:agent_id, :tag_id)" result)) + (define (insert-tag key value) + (sqlite-bind-arguments agent-tags-statement + #:agent_id agent-id + #:tag_id (tag->id key value)) + (sqlite-step agent-tags-statement) + (sqlite-reset agent-tags-statement)) + (sqlite-bind-arguments delete-agent-tags-statement #:agent_id agent-id) (sqlite-step delete-agent-tags-statement) (sqlite-reset delete-agent-tags-statement) (for-each (match-lambda - ((key . value) - (sqlite-bind-arguments agent-tags-statement - #:agent_id agent-id - #:tag_id (tag->id key value)) - (sqlite-step agent-tags-statement) - (sqlite-reset agent-tags-statement))) - tags)))) + ((('key . key) + ('value . value)) + (insert-tag key value)) + ((key . value) (insert-tag key value))) + (if (vector? tags) + (vector->list tags) + tags))))) #t) (define-method (datastore-store-derivation |