~ruther/guix-local

afcc6d636f7d7b1914fa3425da3574db4a94f26f — Ricardo Wurmus 3 years ago 19ea75a
import/cran: Process more complex license strings.

* guix/import/cran.scm (string->license): Add more match clauses.
(string->licenses): Split license conjunctions at "|" and apply
string->license on each license.
(description->package): Use string->licenses.
1 files changed, 58 insertions(+), 26 deletions(-)

M guix/import/cran.scm
M guix/import/cran.scm => guix/import/cran.scm +58 -26
@@ 82,32 82,64 @@
(define %input-style
  (make-parameter 'variable)) ; or 'specification

(define string->license
  (match-lambda
   ("AGPL-3" 'agpl3+)
   ("Artistic-2.0" 'artistic2.0)
   ("Apache License 2.0" 'asl2.0)
   ("BSD_2_clause" 'bsd-2)
   ("BSD_2_clause + file LICENSE" 'bsd-2)
   ("BSD_3_clause" 'bsd-3)
   ("BSD_3_clause + file LICENSE" 'bsd-3)
   ("GPL" '(list gpl2+ gpl3+))
   ("GPL (>= 2)" 'gpl2+)
   ("GPL (>= 3)" 'gpl3+)
   ("GPL-2" 'gpl2)
   ("GPL-3" 'gpl3)
   ("LGPL-2" 'lgpl2.0)
   ("LGPL-2.1" 'lgpl2.1)
   ("LGPL-3" 'lgpl3)
   ("LGPL (>= 2)" 'lgpl2.0+)
   ("LGPL (>= 2.1)" 'lgpl2.1+)
   ("LGPL (>= 3)" 'lgpl3+)
   ("MIT" 'expat)
   ("MIT + file LICENSE" 'expat)
   ((x) (string->license x))
   ((lst ...) `(list ,@(map string->license lst)))
   (_ #f)))
(define (string->licenses license-string)
  (let ((licenses
         (map string-trim-both
              (string-tokenize license-string
                               (char-set-complement (char-set #\|))))))
    (string->license licenses)))

(define string->license
  (let ((prefix identity))
    (match-lambda
      ("AGPL-3" (prefix 'agpl3))
      ("AGPL (>= 3)" (prefix 'agpl3+))
      ("Artistic-2.0" (prefix 'artistic2.0))
      ((or "Apache License 2.0"
           "Apache License (== 2.0)")
       (prefix 'asl2.0))
      ("BSD_2_clause" (prefix 'bsd-2))
      ("BSD_2_clause + file LICENSE" (prefix 'bsd-2))
      ("BSD_3_clause" (prefix 'bsd-3))
      ("BSD_3_clause + file LICENSE" (prefix 'bsd-3))
      ("CC0" (prefix 'cc0))
      ("CC BY-SA 4.0" (prefix 'cc-by-sa4.0))
      ("CeCILL" (prefix 'cecill))
      ((or "GPL"
           "GNU General Public License")
       `(list ,(prefix 'gpl2+) ,(prefix 'gpl3+)))
      ((or "GPL (>= 2)"
           "GPL (>= 2.0)")
       (prefix 'gpl2+))
      ((or "GPL (> 2)"
           "GPL (>= 3)"
           "GPL (>= 3.0)"
           "GNU General Public License (>= 3)")
       (prefix 'gpl3+))
      ((or "GPL-2"
           "GNU General Public License version 2")
       (prefix 'gpl2))
      ((or "GPL-3"
           "GNU General Public License version 3")
       (prefix 'gpl3))
      ((or "GNU Lesser General Public License"
           "LGPL")
       (prefix 'lgpl2.0+))
      ("LGPL-2" (prefix 'lgpl2.0))
      ("LGPL-2.1" (prefix 'lgpl2.1))
      ("LGPL-3" (prefix 'lgpl3))
      ((or "LGPL (>= 2)"
           "LGPL (>= 2.0)")
       (prefix 'lgpl2.0+))
      ("LGPL (>= 2.1)" (prefix 'lgpl2.1+))
      ("LGPL (>= 3)" (prefix 'lgpl3+))
      ("MIT" (prefix 'expat))
      ("MIT + file LICENSE" (prefix 'expat))
      ("file LICENSE"
       `(,(prefix 'fsdg-compatible) "file://LICENSE"))
      ((x) (string->license x))
      ((lst ...) `(list ,@(map string->license lst)))
      (unknown `(,(prefix 'fsdg-compatible) ,unknown)))))

(define (description->alist description)
  "Convert a DESCRIPTION string into an alist."


@@ 485,7 517,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
         (name       (assoc-ref meta "Package"))
         (synopsis   (assoc-ref meta "Title"))
         (version    (assoc-ref meta "Version"))
         (license    (string->license (assoc-ref meta "License")))
         (license    (string->licenses (assoc-ref meta "License")))
         ;; Some packages have multiple home pages.  Some have none.
         (home-page  (case repository
                       ((git) (assoc-ref meta 'git))