aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-09-04 13:03:29 +0200
committerChristopher Baines <mail@cbaines.net>2019-09-04 19:27:48 +0200
commitfc6bbf3e3cbfd7288715833af8154ee5f0fc554c (patch)
treea7ce323c23ac296965448c0a99851bac24cae3af
parent80010a8a1bda00de816dce22b0b712653b088180 (diff)
downloaddata-service-fc6bbf3e3cbfd7288715833af8154ee5f0fc554c.tar
data-service-fc6bbf3e3cbfd7288715833af8154ee5f0fc554c.tar.gz
Change license code to use insert-missing-data-and-return-all-ids
As this now supports inserting sets of data.
-rw-r--r--guix-data-service/model/license.scm107
1 files changed, 20 insertions, 87 deletions
diff --git a/guix-data-service/model/license.scm b/guix-data-service/model/license.scm
index 73df612..0aa65eb 100644
--- a/guix-data-service/model/license.scm
+++ b/guix-data-service/model/license.scm
@@ -1,6 +1,7 @@
(define-module (guix-data-service model license)
#:use-module (srfi srfi-1)
#:use-module (ice-9 vlist)
+ #:use-module (ice-9 match)
#:use-module (squee)
#:use-module (guix inferior)
#:use-module (guix-data-service model utils)
@@ -43,95 +44,27 @@
(inferior-eval '(use-modules (guix licenses)) inf)
(inferior-eval (proc packages) inf))
-(define (insert-licenses values)
- (string-append
- "INSERT INTO licenses "
- "(name, uri, comment) "
- "VALUES "
- (string-join
- (map (lambda (license-values)
- (string-append
- "("
- (string-join
- (map value->quoted-string-or-null
- license-values)
- ", ")
- ")"))
- values)
- ", ")
- " RETURNING id"))
-
(define (inferior-packages->license-id-lists conn inf packages)
(define license-data
(inferior-packages->license-data inf packages))
- (define (sort-license-ids ids)
- (map number->string
- (sort (map string->number ids) <)))
-
- (define (non-string-to-false lst)
- (map (lambda (value)
- (if (string? value)
- value
- #f))
- lst))
-
- (define (empty-string-to-false lst)
- ;; TODO squee returns empty strings for null values, which will probably
- ;; cause problems
- (map (lambda (value)
- (if (string? value)
- (if (string-null? value)
- #f
- value)
- value))
- lst))
-
- (let* ((unique-license-tuples
- (filter (lambda (license-tuple)
- (not (null? license-tuple)))
- (delete-duplicates
- (map
- (lambda (lst)
- (non-string-to-false
- (empty-string-to-false lst)))
- (concatenate license-data)))))
- (existing-license-entries
- (exec-query->vhash conn
- "SELECT id, name, uri, comment FROM licenses"
- (lambda (vals)
- (non-string-to-false
- (empty-string-to-false (cdr vals))))
- first)) ;; id
- (missing-license-entries
- (delete-duplicates
- (filter (lambda (values)
- (not (vhash-assoc values
- existing-license-entries)))
- unique-license-tuples)))
- (new-license-entries
- (if (null? missing-license-entries)
- '()
- (map first
- (exec-query conn
- (insert-licenses missing-license-entries)))))
- (new-entries-id-lookup-vhash
- (two-lists->vhash missing-license-entries
- new-license-entries)))
+ (define (string-or-null v)
+ (if (string? v)
+ v
+ ;; save non string values as NULL
+ NULL))
- (map (lambda (license-value-lists)
- (sort-license-ids
- (map (lambda (license-values)
- (cdr
- (or (vhash-assoc license-values
- existing-license-entries)
- (vhash-assoc license-values
- new-entries-id-lookup-vhash)
- (begin
- (error "missing license entry"
- license-values)))))
- (map (lambda (lst)
- (non-string-to-false
- (empty-string-to-false lst)))
- license-value-lists))))
- license-data)))
+ (insert-missing-data-and-return-all-ids
+ conn
+ "licenses"
+ `(name uri comment)
+ (map (lambda (license-tuples)
+ (map
+ (match-lambda
+ ((name uri comment)
+ (list name
+ (string-or-null uri)
+ (string-or-null comment))))
+ license-tuples))
+ license-data)
+ #:sets-of-data? #t))