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

Improve insert-missing-data-and-return-all-ids

Browse source 
Use exec-query-with-null-handling to distinguish NULL values, change it to
just take a list of fields and remove the handlers. Also, add a sets-of-data?
parameter so that this can be used licenses.
This commit is contained in:
Christopher Baines 2019-09-04 12:57:06 +02:00
parent 1441942200
commit 80010a8a1b
4 changed files with 88 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

5
guix-data-service/model/lint-checker.scm
View file

@ -12,10 +12,7 @@
(insert-missing-data-and-return-all-ids
conn
"lint_checkers"
`((name . ,(lambda (value)
(quote-string (symbol->string value))))
(description . ,quote-string)
(network_dependent . ,value->sql-boolean))
'(name description network_dependent)
lint-checkers-data))
(define (lint-warning-count-by-lint-checker-for-revision conn commit-hash)

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

@ -12,8 +12,7 @@
(insert-missing-data-and-return-all-ids
conn
"lint_warning_messages"
`((locale . ,quote-string)
(message . ,quote-string))
'(locale message)
(map (match-lambda
((locale . message)
(list locale message)))

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

@ -13,10 +13,7 @@
(insert-missing-data-and-return-all-ids
conn
"lint_warnings"
`((lint_checker_id . ,identity)
(package_id . ,identity)
(location_id . ,identity)
(lint_warning_message_set_id . ,identity))
'(lint_checker_id package_id location_id lint_warning_message_set_id)
lint-warnings-data))
(define (insert-guix-revision-lint-warnings conn

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

@ -4,9 +4,10 @@
#:use-module (ice-9 vlist)
#:use-module (ice-9 receive)
#:use-module (squee)
#:export (quote-string
#:use-module (guix-data-service database)
#:export (NULL
quote-string
value->quoted-string-or-null
value->sql-boolean
non-empty-string-or-false
exec-query->vhash
two-lists->vhash
@ -14,6 +15,8 @@
group-list-by-first-n-fields
insert-missing-data-and-return-all-ids))
(define NULL '())
(define (quote-string s)
(string-append "$STR$" s "$STR$"))
@ -22,16 +25,6 @@
(string-append "$STR$" value "$STR$")
"NULL"))
(define (value->sql-boolean v)
(match v
((? boolean? x)
(if x "TRUE" "FALSE"))
((? string? x)
(if (or (string=? x "t")
(string=? x "TRUE"))
"TRUE"
"FALSE"))))
(define (non-empty-string-or-false s)
(if (string? s)
(if (string-null? s)
@ -45,7 +38,7 @@
(value-function row)
result))
vlist-null
(exec-query conn query)))
(exec-query-with-null-handling conn query)))
(define (two-lists->vhash l1 l2)
(fold (lambda (key value result)
@ -78,63 +71,79 @@
'()
lists))
(define (insert-missing-data-and-return-all-ids
conn
table-name
fields-and-handlers
data)
(define fields (map symbol->string
(map first fields-and-handlers)))
(define* (insert-missing-data-and-return-all-ids
conn
table-name
fields
data
#:key
sets-of-data?)
(define field-strings
(map symbol->string fields))
(define handlers (map cdr fields-and-handlers))
(define value->sql
(match-lambda
((? string? s)
(string-append "$STR$" s "$STR$"))
((? symbol? s)
(string-append "$STR$"
(symbol->string s)
"$STR$"))
((? number? n)
(number->string n))
((? boolean? b)
(if b "TRUE" "FALSE"))
((? null?)
"NULL")
(v
(error
(simple-format #f "error: unknown type for value: ~A" v)))))
(define select-query
(string-append
"SELECT id, "
(string-join (map (lambda (field)
(string-append table-name "." field))
fields)
field-strings)
", ")
" FROM " table-name
" JOIN (VALUES "
;; TODO This doesn't handle NULL values
(string-join
(map
(lambda (field-values)
(string-append
"("
(string-join
(map (lambda (value handler)
(handler value))
field-values
handlers)
",")
(string-join (map value->sql field-values) ",")
")"))
data)
(if sets-of-data?
(delete-duplicates
(concatenate data))
data))
", ")
") AS vals (" (string-join fields ", ") ") "
") AS vals (" (string-join field-strings ", ") ") "
"ON "
(string-join
(map (lambda (field)
(string-append
table-name "." field " = vals." field))
fields)
"(" table-name "." field " = vals." field
" OR (" table-name "." field " IS NULL AND"
" vals." field " IS NULL))"))
field-strings)
" AND ")))
(define (insert-sql missing-data)
(string-append
"INSERT INTO " table-name " ("
(string-join fields ", ")
(string-join field-strings ", ")
") VALUES "
(string-join
(map (lambda (field-values)
(string-append
"("
(string-join
(map (lambda (value handler)
(handler value))
field-values
handlers)
(map (lambda (value)
(value->sql value))
field-values)
", ")
")"))
missing-data)
@ -150,9 +159,16 @@
((? symbol? s)
(symbol->string s))
((? string? s)
s))
s)
((? null? s)
;; exec-query-with-null-handling specifies NULL values as '()
'()))
data))
(define (sort-ids ids)
(map number->string
(sort (map string->number ids) <)))
(let* ((existing-entries
(exec-query->vhash conn
select-query
@ -160,9 +176,14 @@
first))
(missing-entries
(filter (lambda (field-values)
(not (vhash-assoc (normalise-values field-values)
existing-entries)))
data))
(not (vhash-assoc
;; Normalise at this point, so that the proper value
;; to insert is carried forward
(normalise-values field-values)
existing-entries)))
(if sets-of-data?
(delete-duplicates (concatenate data))
data)))
(new-entries
(if (null? missing-entries)
'()
@ -172,11 +193,25 @@
(two-lists->vhash missing-entries
new-entries)))
(map (lambda (field-values)
(cdr
(or (vhash-assoc (normalise-values field-values)
existing-entries)
(vhash-assoc field-values
new-entries-lookup-vhash)
(error "missing entry" field-values))))
data)))
(if sets-of-data?
(map (lambda (field-value-lists)
;; Normalise the result at this point, ensuring that the id's
;; in the set are sorted
(sort-ids
(map (lambda (field-values)
(cdr
(or (vhash-assoc (normalise-values field-values)
existing-entries)
(vhash-assoc field-values
new-entries-lookup-vhash)
(error "missing entry" field-values))))
field-value-lists)))
data)
(map (lambda (field-values)
(cdr
(or (vhash-assoc (normalise-values field-values)
existing-entries)
(vhash-assoc field-values
new-entries-lookup-vhash)
(error "missing entry" field-values))))
data))))