aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix-data-service/model/git-branch.scm7
-rw-r--r--guix-data-service/model/git-repository.scm23
-rw-r--r--guix-data-service/model/license-set.scm20
-rw-r--r--guix-data-service/model/lint-warning-message.scm13
-rw-r--r--guix-data-service/model/location.scm27
-rw-r--r--guix-data-service/model/utils.scm15
-rw-r--r--tests/model-git-repository.scm22
-rw-r--r--tests/model-lint-checker.scm10
-rw-r--r--tests/model-lint-warning-message.scm18
-rw-r--r--tests/model-package-metadata.scm2
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
generated by cgit v1.2.3 (git 2.25.4) at 2024-04-28 22:58:06 +0000