import: gem: Use spdx-string->license for license lookup.

Similar to what was done for the crate importer in 263a267b75.

* guix/import/gem.scm (string->license): Try spdx-string->license first,
  returning symbols instead of license objects.  Fall back
  to the existing hardcoded table for non-SPDX strings.
  (make-gem-sexp): Remove license->symbol calls;
  licenses are now symbols directly.
* tests/import/gem.scm (test-spdx-json): New fixture.
  ("gem->guix-package with SPDX license identifiers"): New test.

Change-Id: I5fa0ebdfd3a3393eab5ef0554ed09887a89bc107
Reviewed-by: Carlo Zancanaro <carlo@zancanaro.id.au>
Signed-off-by: Nguyễn Gia Phong <cnx@loang.net>

2 files changed, 106 insertions, 11 deletions

diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index d7a61788462..7fc026129a0 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -138,8 +138,8 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
      (home-page ,home-page)
      (license ,(match licenses
                  (() #f)
-                 ((license) (license->symbol license))
-                 (_ `(list ,@(map license->symbol licenses)))))))
+                 ((license) license)
+                 (_ `(list ,@licenses))))))
 
 (define* (gem->guix-package package-name #:key (repo 'rubygems) version
                             #:allow-other-keys)
@@ -183,15 +183,16 @@ package on RubyGems."
     (substring source-url 31 (string-rindex source-url #\-))))
 
 (define (string->license str)
-  "Convert the string STR into a license object."
-  (match str
-    ("GNU LGPL" license:lgpl2.0)
-    ("GPL" license:gpl3)
-    ((or "BSD" "BSD License") license:bsd-3)
-    ((or "MIT" "MIT license" "Expat license") license:expat)
-    ("Public domain" license:public-domain)
-    ((or "Apache License, Version 2.0" "Apache 2.0") license:asl2.0)
-    (_ #f)))
+  "Convert the string STR into a license symbol."
+  (or (spdx-string->license str)
+      (match str
+        ("GNU LGPL" 'license:lgpl2.0)
+        ("GPL" 'license:gpl3)
+        ((or "BSD" "BSD License") 'license:bsd-3)
+        ((or "MIT" "MIT license" "Expat license") 'license:expat)
+        ("Public domain" 'license:public-domain)
+        ((or "Apache License, Version 2.0" "Apache 2.0") 'license:asl2.0)
+        (_ 'unknown-license!))))
 
 (define gem-package?
   (url-prefix-predicate "https://rubygems.org/downloads/"))
diff --git a/tests/import/gem.scm b/tests/import/gem.scm
index dfa33d40366..9b65c328ca9 100644
--- a/tests/import/gem.scm
+++ b/tests/import/gem.scm
@@ -125,6 +125,19 @@
   \"licenses\": [\"MIT\"]
 }")
 
+(define test-spdx-json
+  "{
+  \"name\": \"spdx-gem\",
+  \"version\": \"1.0.0\",
+  \"sha\": \"f3676eafca9987cb5fe263df1edf2538bf6dafc712b30e17be3543a9680547a8\",
+  \"info\": \"A gem with SPDX licenses\",
+  \"homepage_uri\": \"https://example.com\",
+  \"dependencies\": {
+    \"runtime\": []
+  },
+  \"licenses\": [\"Ruby\", \"BSD-2-Clause\"]
+}")
+
 (test-begin "gem")
 
 (test-assert "gem->guix-package"
@@ -346,4 +359,85 @@
       (x
        (pk 'fail x #f)))))
 
+(test-assert "gem->guix-package with SPDX license identifiers"
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://rubygems.org/api/v1/gems/spdx-gem.json"
+              (values (open-input-string test-spdx-json)
+                      (string-length test-spdx-json)))
+             (_ (error "Unexpected URL: " url)))))
+    (match (gem->guix-package "spdx-gem")
+      (`(package
+          (name "ruby-spdx-gem")
+          (version "1.0.0")
+          (source (origin
+                    (method url-fetch)
+                    (uri (rubygems-uri "spdx-gem" version))
+                    (sha256
+                     (base32
+                      "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+          (build-system ruby-build-system)
+          (synopsis "A gem with SPDX licenses")
+          (description "This package provides a gem with SPDX licenses.")
+          (home-page "https://example.com")
+          (license (list license:ruby license:bsd-2)))
+       #t)
+      (x
+       (pk 'fail x #f)))))
+
+(test-assert "gem->guix-package with gibberish license identifiers"
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://rubygems.org/api/v1/gems/gibberish-license-gem.json"
+              (values (open-input-string test-gibberish-licenses-json)
+                      (string-length test-gibberish-licenses-json)))
+             (_ (error "Unexpected URL: " url)))))
+    (match (gem->guix-package "gibberish-license-gem")
+      (`(package
+          (name "ruby-gibberish-license-gem")
+          (version "1.0.0")
+          (source (origin
+                    (method url-fetch)
+                    (uri (rubygems-uri "gibberish-license-gem" version))
+                    (sha256
+                     (base32
+                      "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+          (build-system ruby-build-system)
+          (synopsis "A gem with gibberish licenses")
+          (description "This package provides a gem with gibberish licenses.")
+          (home-page "https://example.com")
+          (license (list unknown-license! unknown-license!)))
+       #t)
+      (x
+       (pk 'fail x #f)))))
+
+(test-assert "gem->guix-package with mixed valid and gibberish licenses"
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://rubygems.org/api/v1/gems/mixed-license-gem.json"
+              (values (open-input-string test-mixed-licenses-json)
+                      (string-length test-mixed-licenses-json)))
+             (_ (error "Unexpected URL: " url)))))
+    (match (gem->guix-package "mixed-license-gem")
+      (`(package
+          (name "ruby-mixed-license-gem")
+          (version "1.0.0")
+          (source (origin
+                    (method url-fetch)
+                    (uri (rubygems-uri "mixed-license-gem" version))
+                    (sha256
+                     (base32
+                      "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+          (build-system ruby-build-system)
+          (synopsis "A gem with one valid and one gibberish license")
+          (description "This package provides a gem with one valid \
+and one gibberish license.")
+          (home-page "https://example.com")
+          (license (list license:expat unknown-license!)))
+       #t)
+      (x
+       (pk 'fail x #f)))))
 (test-end "gem")