Store license information for packages

And display this on the package page.

This uses a couple of new tables, and an additional field in the
package_metadata table.

Currently, the order of the licenses in the package definition isn't stored,
as I'm not sure the order in the list is significant.

1 files changed, 70 insertions, 0 deletions

diff --git a/guix-data-service/model/license-set.scm b/guix-data-service/model/license-set.scm
new file mode 100644
index 0000000..44c0a70
--- /dev/null
+++ b/guix-data-service/model/license-set.scm
@@ -0,0 +1,70 @@
+(define-module (guix-data-service model license-set)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 vlist)
+  #:use-module (squee)
+  #:use-module (guix-data-service model utils)
+  #:use-module (guix-data-service model license)
+  #:export (inferior-packages->license-set-ids))
+
+(define select-license-sets
+  "
+SELECT id, license_ids
+FROM license_sets")
+
+(define (insert-license-sets license-id-lists)
+  (string-append
+   "INSERT INTO license_sets (license_ids) VALUES "
+   (string-join
+    (map (lambda (license-ids)
+           (string-append
+            "('{"
+            (string-join
+             (map number->string
+                  (sort (map string->number license-ids) <))
+             ", ")
+            "}')"))
+         license-id-lists)
+    ", ")
+   " RETURNING id"))
+
+(define (inferior-packages->license-set-ids conn inf packages)
+  (define license-id-lists
+    (inferior-packages->license-id-lists conn inf packages))
+
+  (let* ((unique-license-id-lists (delete-duplicates
+                                   license-id-lists))
+         (existing-license-sets
+          (exec-query->vhash conn
+                             select-license-sets
+                             (lambda (results)
+                               (string-split (string-drop-right
+                                              (string-drop (second results) 1)
+                                              1)
+                                             #\,))
+                             first)) ;; id
+         (missing-license-sets
+          (delete-duplicates
+           (filter (lambda (license-set-license-ids)
+                     (not (vhash-assoc license-set-license-ids
+                                       existing-license-sets)))
+                   unique-license-id-lists)))
+         (new-license-set-entries
+          (if (null? missing-license-sets)
+              '()
+              (map first
+                   (exec-query conn
+                               (insert-license-sets missing-license-sets)))))
+         (new-entries-id-lookup-vhash
+          (two-lists->vhash missing-license-sets
+                            new-license-set-entries)))
+
+    (map (lambda (license-id-list)
+           (cdr
+            (or (vhash-assoc license-id-list
+                             existing-license-sets)
+                (vhash-assoc license-id-list
+                             new-entries-id-lookup-vhash)
+                (begin
+                  (error "missing license set entry"
+                         license-id-list)))))
+         license-id-lists)))