aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/model/license.scm
blob: 0aa65eb714581134e3d63cb170728e53eda34de5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
(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)
  #:export (inferior-packages->license-id-lists))

(define inferior-package-id
  (@@ (guix inferior) inferior-package-id))

(define (inferior-packages->license-data inf packages)
  (define (proc packages)
    `(map (lambda (inferior-package-id)
            (let ((package (hashv-ref %package-table inferior-package-id)))
              (match (package-license package)
                ((? license? license)
                 (list
                  (list (license-name license)
                        (license-uri license)
                        (license-comment license))))
                ((values ...)
                 (map (match-lambda
                        ((? license? license)
                         (list (license-name license)
                               (license-uri license)
                               (license-comment license)))
                        (x
                         (simple-format
                          (current-error-port)
                          "error: unknown license value ~A for package ~A"
                          x package)
                         '()))
                      values))
                (x
                 (simple-format
                  (current-error-port)
                  "error: unknown license value ~A for package ~A"
                  x package)
                 '()))))
          (list ,@(map inferior-package-id packages))))

  (inferior-eval '(use-modules (guix licenses)) inf)
  (inferior-eval (proc packages) inf))

(define (inferior-packages->license-id-lists conn inf packages)
  (define license-data
    (inferior-packages->license-data inf packages))

  (define (string-or-null v)
    (if (string? v)
        v
        ;; save non string values as NULL
        NULL))

  (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))