aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/model
diff options
context:
space:
mode:
Diffstat (limited to 'guix-data-service/model')
-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
6 files changed, 56 insertions, 49 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
generated by cgit v1.2.3 (git 2.25.4) at 2024-05-14 20:03:07 +0000