From fc6bbf3e3cbfd7288715833af8154ee5f0fc554c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 4 Sep 2019 13:03:29 +0200 Subject: Change license code to use insert-missing-data-and-return-all-ids As this now supports inserting sets of data. --- guix-data-service/model/license.scm | 107 +++++++----------------------------- 1 file 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)) -- cgit v1.2.3