diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-01-03 10:38:42 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-01-03 10:38:42 +0000 |
| commit | 94a4bda7c7163ed5fd2e901e5f2306b6b680e615 (patch) | |
| tree | e17fb8f4679c70e386feb04616672c0b740fadcf | |
| parent | d90f395e814ee74e531cd7f6e5910bc4a095aa54 (diff) | |
| download | build-coordinator-94a4bda7c7163ed5fd2e901e5f2306b6b680e615.tar build-coordinator-94a4bda7c7163ed5fd2e901e5f2306b6b680e615.tar.gz | |
Enable matching tags by just the key
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 14 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 31 | ||||
| -rw-r--r-- | scripts/guix-build-coordinator.in | 12 |
3 files changed, 49 insertions, 8 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 0a2aef4..2b7a916 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -248,7 +248,8 @@ (if (eq? key 'tag) (match (string-split value #\:) ((tag-key tag-value) - (cons tag-key tag-value))) + (cons tag-key tag-value)) + ((tag-key) tag-key)) #f))) query-parameters) #:not-tags @@ -257,7 +258,8 @@ (if (eq? key 'not_tag) (match (string-split value #\:) ((tag-key tag-value) - (cons tag-key tag-value))) + (cons tag-key tag-value)) + ((tag_key) tag_key)) #f))) query-parameters) #:processed @@ -464,13 +466,17 @@ '() (map (match-lambda ((key . value) - (simple-format #f "tag=~A:~A" key value))) + (simple-format #f "tag=~A:~A" key value)) + (key + (simple-format #f "tag=~A" key))) tags)) ,@(if (null? not-tags) '() (map (match-lambda ((key . value) - (simple-format #f "not_tag=~A:~A" key value))) + (simple-format #f "not_tag=~A:~A" key value)) + (key + (simple-format #f "not_tag=~A" key))) not-tags)) ,@(if (boolean? processed) (if processed diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index a20f6ed..bc3dd58 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -1201,6 +1201,12 @@ WHERE uuid = :uuid" db " SELECT id FROM tags WHERE key = :key AND value = :value" + #:cache? #t)) + (key-statement + (sqlite-prepare + db + " +SELECT id FROM tags WHERE key = :key" #:cache? #t))) (lambda (tag not?) (match tag @@ -1220,6 +1226,31 @@ SELECT id FROM tags WHERE key = :key AND value = :value" (#f #f)))) (sqlite-reset statement) + result)) + (key + (sqlite-bind-arguments key-statement + #:key key) + + (let* ((tag-ids (sqlite-map + (match-lambda + (#(id) id)) + key-statement)) + (result + (string-append + "(" + (string-join + (map (lambda (id) + (simple-format + #f "tag_string ~A '%,~A,%'" + (if not? + "NOT LIKE" + "LIKE") + id)) + tag-ids) + (if not? " AND " " OR ")) + ")"))) + (sqlite-reset key-statement) + result)))))) (let ((tag-expressions diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 64e38ca..de8e789 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -136,7 +136,8 @@ (lambda (opt name arg result) (alist-cons 'tags (cons (match (string-split arg #\=) - ((key value) (cons key value))) + ((key value) (cons key value)) + ((key) key)) (or (assq-ref result 'tags) '())) (alist-delete 'tags result)))) @@ -144,7 +145,8 @@ (lambda (opt name arg result) (alist-cons 'not-tags (cons (match (string-split arg #\=) - ((key value) (cons key value))) + ((key value) (cons key value)) + ((key) key)) (or (assq-ref result 'not-tags) '())) (alist-delete 'not-tags result)))) @@ -181,7 +183,8 @@ (lambda (opt name arg result) (alist-cons 'tags (cons (match (string-split arg #\=) - ((key value) (cons key value))) + ((key value) (cons key value)) + ((key) key)) (or (assq-ref result 'tags) '())) (alist-delete 'tags result)))) @@ -189,7 +192,8 @@ (lambda (opt name arg result) (alist-cons 'not-tags (cons (match (string-split arg #\=) - ((key value) (cons key value))) + ((key value) (cons key value)) + ((key) key)) (or (assq-ref result 'not-tags) '())) (alist-delete 'not-tags result)))))) |