mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Start handling ids as numbers, rather than strings
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:
parent
6c90fe4324
commit
d3913a14d5
|
@ -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)))))
|
||||
|
||||
|
|
|
@ -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,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
|
||||
|
|
|
@ -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))))))
|
||||
|
|
|
@ -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))))))))))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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,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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue