diff options
-rw-r--r-- | guix-data-service/model/git-branch.scm | 7 | ||||
-rw-r--r-- | guix-data-service/model/git-repository.scm | 23 | ||||
-rw-r--r-- | guix-data-service/model/license-set.scm | 20 | ||||
-rw-r--r-- | guix-data-service/model/lint-warning-message.scm | 13 | ||||
-rw-r--r-- | guix-data-service/model/location.scm | 27 | ||||
-rw-r--r-- | guix-data-service/model/utils.scm | 15 | ||||
-rw-r--r-- | tests/model-git-repository.scm | 22 | ||||
-rw-r--r-- | tests/model-lint-checker.scm | 10 | ||||
-rw-r--r-- | tests/model-lint-warning-message.scm | 18 | ||||
-rw-r--r-- | tests/model-package-metadata.scm | 2 |
10 files changed, 82 insertions, 75 deletions
diff --git a/guix-data-service/model/git-branch.scm b/guix-data-service/model/git-branch.scm index 37c83d6..466172f 100644 --- a/guix-data-service/model/git-branch.scm +++ b/guix-data-service/model/git-branch.scm @@ -22,7 +22,7 @@ "ON CONFLICT DO NOTHING") (list name commit - git-repository-id + (number->string git-repository-id) (date->string datetime "~s")))) (define (git-branches-for-commit conn commit) @@ -94,7 +94,8 @@ WHERE git_branches.commit = $1") (exec-query conn query - (list branch-name git-repository-id)))) + (list branch-name + (number->string git-repository-id))))) (define* (latest-processed-commit-for-branch conn repository-id branch-name) (define query @@ -149,5 +150,5 @@ ORDER BY name, datetime DESC")) (exec-query conn query - (list git-repository-id)))) + (list (number->string git-repository-id))))) diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm index f460d0e..610dc49 100644 --- a/guix-data-service/model/git-repository.scm +++ b/guix-data-service/model/git-repository.scm @@ -41,17 +41,18 @@ conn (string-append "SELECT id FROM git_repositories WHERE url = '" url "'")))) - (match existing-id - (((id)) id) - (() - (caar - (exec-query conn - (string-append - "INSERT INTO git_repositories " - "(url) " - "VALUES " - "('" url "') " - "RETURNING id"))))))) + (string->number + (match existing-id + (((id)) id) + (() + (caar + (exec-query conn + (string-append + "INSERT INTO git_repositories " + "(url) " + "VALUES " + "('" url "') " + "RETURNING id")))))))) (define (guix-revisions-and-jobs-for-git-repository conn git-repository-id) (define query diff --git a/guix-data-service/model/license-set.scm b/guix-data-service/model/license-set.scm index 61ded10..0ff253e 100644 --- a/guix-data-service/model/license-set.scm +++ b/guix-data-service/model/license-set.scm @@ -20,7 +20,7 @@ FROM license_sets") "('{" (string-join (map number->string - (sort (map string->number license-ids) <)) + (sort license-ids <)) ", ") "}')")) license-id-lists) @@ -39,12 +39,15 @@ FROM license_sets") (lambda (results) (if (string=? (second results) "{}") '() - (string-split - (string-drop-right - (string-drop (second results) 1) - 1) - #\,))) - first)) ;; id + (map + string->number + (string-split + (string-drop-right + (string-drop (second results) 1) + 1) + #\,)))) + (lambda (result) + (string->number (first result))))) ;; id (missing-license-sets (delete-duplicates (filter (lambda (license-set-license-ids) @@ -54,7 +57,8 @@ FROM license_sets") (new-license-set-entries (if (null? missing-license-sets) '() - (map first + (map (lambda (result) + (string->number (first result))) (exec-query conn (insert-license-sets missing-license-sets))))) (new-entries-id-lookup-vhash diff --git a/guix-data-service/model/lint-warning-message.scm b/guix-data-service/model/lint-warning-message.scm index 7e54e41..85183a3 100644 --- a/guix-data-service/model/lint-warning-message.scm +++ b/guix-data-service/model/lint-warning-message.scm @@ -26,7 +26,7 @@ "('{" (string-join (map number->string - (sort (map string->number lint-message-ids) <)) + (sort lint-message-ids <)) ", ") "}')") " RETURNING id"))) @@ -47,10 +47,11 @@ (string-append "SELECT id FROM lint_warning_message_sets " "WHERE message_ids = ARRAY[" - (string-join lint-warning-message-ids ", ") + (string-join (map number->string lint-warning-message-ids) ", ") "]")))) - (match lint-message-set-id - (((id)) id) - (() - (insert-lint-warning-message-set conn lint-warning-message-ids))))) + (string->number + (match lint-message-set-id + (((id)) id) + (() + (insert-lint-warning-message-set conn lint-warning-message-ids)))))) diff --git a/guix-data-service/model/location.scm b/guix-data-service/model/location.scm index 9850377..6e010da 100644 --- a/guix-data-service/model/location.scm +++ b/guix-data-service/model/location.scm @@ -37,16 +37,17 @@ (define (location->location-id conn location) (match location (($ <location> file line column) - (match (exec-query conn - select-existing-location - (list file - (number->string line) - (number->string column))) - (((id)) id) - (() - (caar - (exec-query conn - insert-location - (list file - (number->string line) - (number->string column))))))))) + (string->number + (match (exec-query conn + select-existing-location + (list file + (number->string line) + (number->string column))) + (((id)) id) + (() + (caar + (exec-query conn + insert-location + (list file + (number->string line) + (number->string column)))))))))) diff --git a/guix-data-service/model/utils.scm b/guix-data-service/model/utils.scm index 1d187b8..e636988 100644 --- a/guix-data-service/model/utils.scm +++ b/guix-data-service/model/utils.scm @@ -165,15 +165,12 @@ '())) data)) - (define (sort-ids ids) - (map number->string - (sort (map string->number ids) <))) - (let* ((existing-entries (exec-query->vhash conn select-query cdr - first)) + (lambda (result) + (string->number (first result))))) (missing-entries (filter (lambda (field-values) (not (vhash-assoc @@ -187,7 +184,8 @@ (new-entries (if (null? missing-entries) '() - (map first + (map (lambda (result) + (string->number (first result))) (exec-query conn (insert-sql missing-entries))))) (new-entries-lookup-vhash (two-lists->vhash missing-entries @@ -197,7 +195,7 @@ (map (lambda (field-value-lists) ;; Normalise the result at this point, ensuring that the id's ;; in the set are sorted - (sort-ids + (sort (map (lambda (field-values) (cdr (or (vhash-assoc (normalise-values field-values) @@ -205,7 +203,8 @@ (vhash-assoc field-values new-entries-lookup-vhash) (error "missing entry" field-values)))) - field-value-lists))) + field-value-lists) + <)) data) (map (lambda (field-values) (cdr diff --git a/tests/model-git-repository.scm b/tests/model-git-repository.scm index befcbfa..ee72f24 100644 --- a/tests/model-git-repository.scm +++ b/tests/model-git-repository.scm @@ -1,4 +1,5 @@ (define-module (test-model-git-repository) + #:use-module (ice-9 match) #:use-module (srfi srfi-64) #:use-module (guix-data-service database) #:use-module (guix-data-service model git-repository)) @@ -12,22 +13,21 @@ (with-postgresql-transaction conn (lambda (conn) - (number? - (string->number - (git-repository-url->git-repository-id - conn - "test-non-existent-url")))) + (match (git-repository-url->git-repository-id + conn + "test-non-existent-url") + ((? number? x) + #t))) #:always-rollback? #t)) - (test-assert "returns the right id for an existing URL" + (let* ((url "test-url") + (id (git-repository-url->git-repository-id conn url))) (with-postgresql-transaction conn (lambda (conn) - (let* ((url "test-url") - (id (git-repository-url->git-repository-id conn url))) - (string=? - id - (git-repository-url->git-repository-id conn url)))) + (test-equal "returns the right id for an existing URL" + id + (git-repository-url->git-repository-id conn url))) #:always-rollback? #t)))) (test-end) diff --git a/tests/model-lint-checker.scm b/tests/model-lint-checker.scm index 64088e5..bbc79de 100644 --- a/tests/model-lint-checker.scm +++ b/tests/model-lint-checker.scm @@ -18,7 +18,7 @@ conn (lambda (conn) (match (lint-checkers->lint-checker-ids conn data) - (((? string? id1) (? string? id2)) + (((? number? id1) (? number? id2)) #t))) #:always-rollback? #t)) @@ -27,11 +27,11 @@ conn (lambda (conn) (match (lint-checkers->lint-checker-ids conn data) - (((? string? id1) (? string? id2)) + (((? number? id1) (? number? id2)) (match (lint-checkers->lint-checker-ids conn data) - (((? string? second-id1) (? string? second-id2)) - (and (string=? id1 second-id1) - (string=? id2 second-id2))))))) + (((? number? second-id1) (? number? second-id2)) + (and (eq? id1 second-id1) + (eq? id2 second-id2))))))) #:always-rollback? #t)))) (test-end) diff --git a/tests/model-lint-warning-message.scm b/tests/model-lint-warning-message.scm index c6fad55..746dcca 100644 --- a/tests/model-lint-warning-message.scm +++ b/tests/model-lint-warning-message.scm @@ -18,7 +18,7 @@ conn (lambda (conn) (match (lint-warning-message-data->lint-warning-message-ids conn data) - (((? string? id1) (? string? id2)) + (((? number? id1) (? number? id2)) #t))) #:always-rollback? #t)) @@ -27,11 +27,11 @@ conn (lambda (conn) (match (lint-warning-message-data->lint-warning-message-ids conn data) - (((? string? id1) (? string? id2)) + (((? number? id1) (? number? id2)) (match (lint-warning-message-data->lint-warning-message-ids conn data) - (((? string? second-id1) (? string? second-id2)) - (and (string=? id1 second-id1) - (string=? id2 second-id2))))))) + (((? number? second-id1) (? number? second-id2)) + (and (eq? id1 second-id1) + (eq? id2 second-id2))))))) #:always-rollback? #t)) (test-assert "single set insert" @@ -39,7 +39,7 @@ conn (lambda (conn) (match (lint-warning-message-data->lint-warning-message-set-id conn data) - ((? string? id1) + ((? number? id1) #t))) #:always-rollback? #t)) @@ -48,10 +48,10 @@ conn (lambda (conn) (match (lint-warning-message-data->lint-warning-message-set-id conn data) - ((? string? id) + ((? number? id) (match (lint-warning-message-data->lint-warning-message-set-id conn data) - ((? string? second-id) - (string=? id second-id)))))) + ((? number? second-id) + (eq? id second-id)))))) #:always-rollback? #t)))) (test-end) diff --git a/tests/model-package-metadata.scm b/tests/model-package-metadata.scm index 015a0b2..21ca55b 100644 --- a/tests/model-package-metadata.scm +++ b/tests/model-package-metadata.scm @@ -58,7 +58,7 @@ (list mock-inferior-package-foo mock-inferior-package-foo-2) (test-license-set-ids conn)) - ((x) (string? x)))) + ((x) (number? x)))) #:always-rollback? #t)) (with-postgresql-transaction |