cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Start handling ids as numbers, rather than strings

Browse source 
squee, returns all data as strings, and expects strings as inputs to
queries. So, keeping the ids as strings was easy initially, but it means that
you can't tell from the type whether it should be quoted, or not...

Therefore, handle ids as strings, converting them to numbers when they're
fetched from the database, and back to strings as part of the queries.
This commit is contained in:
Christopher Baines 2019-09-04 19:24:22 +02:00
parent 6c90fe4324
commit d3913a14d5
10 changed files with 82 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

7
guix-data-service/model/git-branch.scm
View file

@ -22,7 +22,7 @@
"ON CONFLICT DO NOTHING") "ON CONFLICT DO NOTHING")
(list name (list name
commit commit
git-repository-id (number->string git-repository-id)
(date->string datetime "~s")))) (date->string datetime "~s"))))
(define (git-branches-for-commit conn commit) (define (git-branches-for-commit conn commit)
@ -94,7 +94,8 @@ WHERE git_branches.commit = $1")
(exec-query (exec-query
conn conn
query 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* (latest-processed-commit-for-branch conn repository-id branch-name)
(define query (define query
@ -149,5 +150,5 @@ ORDER BY name, datetime DESC"))
(exec-query (exec-query
conn conn
query query
(list git-repository-id)))) (list (number->string git-repository-id)))))

3
guix-data-service/model/git-repository.scm
View file

@ -41,6 +41,7 @@
conn conn
(string-append (string-append
"SELECT id FROM git_repositories WHERE url = '" url "'")))) "SELECT id FROM git_repositories WHERE url = '" url "'"))))
(string->number
(match existing-id (match existing-id
(((id)) id) (((id)) id)
(() (()
@ -51,7 +52,7 @@
"(url) " "(url) "
"VALUES " "VALUES "
"('" url "') " "('" url "') "
"RETURNING id"))))))) "RETURNING id"))))))))
(define (guix-revisions-and-jobs-for-git-repository conn git-repository-id) (define (guix-revisions-and-jobs-for-git-repository conn git-repository-id)
(define query (define query

12
guix-data-service/model/license-set.scm
View file

@ -20,7 +20,7 @@ FROM license_sets")
"('{" "('{"
(string-join (string-join
(map number->string (map number->string
(sort (map string->number license-ids) <)) (sort license-ids <))
", ") ", ")
"}')")) "}')"))
license-id-lists) license-id-lists)
@ -39,12 +39,15 @@ FROM license_sets")
(lambda (results) (lambda (results)
(if (string=? (second results) "{}") (if (string=? (second results) "{}")
'() '()
(map
string->number
(string-split (string-split
(string-drop-right (string-drop-right
(string-drop (second results) 1) (string-drop (second results) 1)
1) 1)
#\,))) #\,))))
first)) ;; id (lambda (result)
(string->number (first result))))) ;; id
(missing-license-sets (missing-license-sets
(delete-duplicates (delete-duplicates
(filter (lambda (license-set-license-ids) (filter (lambda (license-set-license-ids)
@ -54,7 +57,8 @@ FROM license_sets")
(new-license-set-entries (new-license-set-entries
(if (null? missing-license-sets) (if (null? missing-license-sets)
'() '()
(map first (map (lambda (result)
(string->number (first result)))
(exec-query conn (exec-query conn
(insert-license-sets missing-license-sets))))) (insert-license-sets missing-license-sets)))))
(new-entries-id-lookup-vhash (new-entries-id-lookup-vhash

7
guix-data-service/model/lint-warning-message.scm
View file

@ -26,7 +26,7 @@
"('{" "('{"
(string-join (string-join
(map number->string (map number->string
(sort (map string->number lint-message-ids) <)) (sort lint-message-ids <))
", ") ", ")
"}')") "}')")
" RETURNING id"))) " RETURNING id")))
@ -47,10 +47,11 @@
(string-append (string-append
"SELECT id FROM lint_warning_message_sets " "SELECT id FROM lint_warning_message_sets "
"WHERE message_ids = ARRAY[" "WHERE message_ids = ARRAY["
(string-join lint-warning-message-ids ", ") (string-join (map number->string lint-warning-message-ids) ", ")
"]")))) "]"))))
(string->number
(match lint-message-set-id (match lint-message-set-id
(((id)) id) (((id)) id)
(() (()
(insert-lint-warning-message-set conn lint-warning-message-ids))))) (insert-lint-warning-message-set conn lint-warning-message-ids))))))

3
guix-data-service/model/location.scm
View file

@ -37,6 +37,7 @@
(define (location->location-id conn location) (define (location->location-id conn location)
(match location (match location
(($ <location> file line column) (($ <location> file line column)
(string->number
(match (exec-query conn (match (exec-query conn
select-existing-location select-existing-location
(list file (list file
@ -49,4 +50,4 @@
insert-location insert-location
(list file (list file
(number->string line) (number->string line)
(number->string column))))))))) (number->string column))))))))))

15
guix-data-service/model/utils.scm
View file

@ -165,15 +165,12 @@
'())) '()))
data)) data))
(define (sort-ids ids)
(map number->string
(sort (map string->number ids) <)))
(let* ((existing-entries (let* ((existing-entries
(exec-query->vhash conn (exec-query->vhash conn
select-query select-query
cdr cdr
first)) (lambda (result)
(string->number (first result)))))
(missing-entries (missing-entries
(filter (lambda (field-values) (filter (lambda (field-values)
(not (vhash-assoc (not (vhash-assoc
@ -187,7 +184,8 @@
(new-entries (new-entries
(if (null? missing-entries) (if (null? missing-entries)
'() '()
(map first (map (lambda (result)
(string->number (first result)))
(exec-query conn (insert-sql missing-entries))))) (exec-query conn (insert-sql missing-entries)))))
(new-entries-lookup-vhash (new-entries-lookup-vhash
(two-lists->vhash missing-entries (two-lists->vhash missing-entries
@ -197,7 +195,7 @@
(map (lambda (field-value-lists) (map (lambda (field-value-lists)
;; Normalise the result at this point, ensuring that the id's ;; Normalise the result at this point, ensuring that the id's
;; in the set are sorted ;; in the set are sorted
(sort-ids (sort
(map (lambda (field-values) (map (lambda (field-values)
(cdr (cdr
(or (vhash-assoc (normalise-values field-values) (or (vhash-assoc (normalise-values field-values)
@ -205,7 +203,8 @@
(vhash-assoc field-values (vhash-assoc field-values
new-entries-lookup-vhash) new-entries-lookup-vhash)
(error "missing entry" field-values)))) (error "missing entry" field-values))))
field-value-lists))) field-value-lists)
<))
data) data)
(map (lambda (field-values) (map (lambda (field-values)
(cdr (cdr

18
tests/model-git-repository.scm
View file

@ -1,4 +1,5 @@
(define-module (test-model-git-repository) (define-module (test-model-git-repository)
#:use-module (ice-9 match)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service model git-repository)) #:use-module (guix-data-service model git-repository))
@ -12,22 +13,21 @@
(with-postgresql-transaction (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(number? (match (git-repository-url->git-repository-id
(string->number
(git-repository-url->git-repository-id
conn conn
"test-non-existent-url")))) "test-non-existent-url")
((? number? x)
#t)))
#:always-rollback? #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 (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(let* ((url "test-url") (test-equal "returns the right id for an existing URL"
(id (git-repository-url->git-repository-id conn url)))
(string=?
id id
(git-repository-url->git-repository-id conn url)))) (git-repository-url->git-repository-id conn url)))
#:always-rollback? #t)))) #:always-rollback? #t))))
(test-end) (test-end)

10
tests/model-lint-checker.scm
View file

@ -18,7 +18,7 @@
conn conn
(lambda (conn) (lambda (conn)
(match (lint-checkers->lint-checker-ids conn data) (match (lint-checkers->lint-checker-ids conn data)
(((? string? id1) (? string? id2)) (((? number? id1) (? number? id2))
#t))) #t)))
#:always-rollback? #t)) #:always-rollback? #t))
@ -27,11 +27,11 @@
conn conn
(lambda (conn) (lambda (conn)
(match (lint-checkers->lint-checker-ids conn data) (match (lint-checkers->lint-checker-ids conn data)
(((? string? id1) (? string? id2)) (((? number? id1) (? number? id2))
(match (lint-checkers->lint-checker-ids conn data) (match (lint-checkers->lint-checker-ids conn data)
(((? string? second-id1) (? string? second-id2)) (((? number? second-id1) (? number? second-id2))
(and (string=? id1 second-id1) (and (eq? id1 second-id1)
(string=? id2 second-id2))))))) (eq? id2 second-id2)))))))
#:always-rollback? #t)))) #:always-rollback? #t))))
(test-end) (test-end)

18
tests/model-lint-warning-message.scm
View file

@ -18,7 +18,7 @@
conn conn
(lambda (conn) (lambda (conn)
(match (lint-warning-message-data->lint-warning-message-ids conn data) (match (lint-warning-message-data->lint-warning-message-ids conn data)
(((? string? id1) (? string? id2)) (((? number? id1) (? number? id2))
#t))) #t)))
#:always-rollback? #t)) #:always-rollback? #t))
@ -27,11 +27,11 @@
conn conn
(lambda (conn) (lambda (conn)
(match (lint-warning-message-data->lint-warning-message-ids conn data) (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) (match (lint-warning-message-data->lint-warning-message-ids conn data)
(((? string? second-id1) (? string? second-id2)) (((? number? second-id1) (? number? second-id2))
(and (string=? id1 second-id1) (and (eq? id1 second-id1)
(string=? id2 second-id2))))))) (eq? id2 second-id2)))))))
#:always-rollback? #t)) #:always-rollback? #t))
(test-assert "single set insert" (test-assert "single set insert"
@ -39,7 +39,7 @@
conn conn
(lambda (conn) (lambda (conn)
(match (lint-warning-message-data->lint-warning-message-set-id conn data) (match (lint-warning-message-data->lint-warning-message-set-id conn data)
((? string? id1) ((? number? id1)
#t))) #t)))
#:always-rollback? #t)) #:always-rollback? #t))
@ -48,10 +48,10 @@
conn conn
(lambda (conn) (lambda (conn)
(match (lint-warning-message-data->lint-warning-message-set-id conn data) (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) (match (lint-warning-message-data->lint-warning-message-set-id conn data)
((? string? second-id) ((? number? second-id)
(string=? id second-id)))))) (eq? id second-id))))))
#:always-rollback? #t)))) #:always-rollback? #t))))
(test-end) (test-end)

2
tests/model-package-metadata.scm
View file

@ -58,7 +58,7 @@
(list mock-inferior-package-foo (list mock-inferior-package-foo
mock-inferior-package-foo-2) mock-inferior-package-foo-2)
(test-license-set-ids conn)) (test-license-set-ids conn))
((x) (string? x)))) ((x) (number? x))))
#:always-rollback? #t)) #:always-rollback? #t))
(with-postgresql-transaction (with-postgresql-transaction