guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

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
Show stats 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")
(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)))))

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

@ -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

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

@ -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

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

@ -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))))))

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

@ -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))))))))))

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

@ -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

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

@ -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)

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

@ -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)

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

@ -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)

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

@ -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