12/12: import/cran: Process more complex license strings.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit afcc6d636f7d7b1914fa3425da3574db4a94f26f
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Wed Sep 28 22:07:40 2022 +0200

    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.
---
 guix/import/cran.scm | 84 ++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 58 insertions(+), 26 deletions(-)

diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 57c14e5fbc..17e33d5f52 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -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))