Merge branch 'staging' into core-updates

3 files changed, 42 insertions, 23 deletions

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index e7edbf6656..1ffa408666 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -499,6 +500,12 @@ are unavailable."
              (base-url (string-append base-url directory))
              (url  (cond ((and=> (string->uri url) uri-scheme) ;full URL?
                           url)
+                         ;; full URL, except for URI scheme.  Reuse the URI
+                         ;; scheme of the document that contains the link.
+                         ((string-prefix? "//" url)
+                          (string-append
+                           (symbol->string (uri-scheme (string->uri base-url)))
+                           ":" url))
                          ((string-prefix? "/" url) ;absolute path?
                           (let ((uri (string->uri base-url)))
                             (uri->string
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 0e5bb7e635..ad1343bff4 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -81,10 +82,12 @@
   (requirements  gem-dependency-requirements))    ;string
 
 
-(define (rubygems-fetch name)
-  "Return a <gem> record for the package NAME, or #f on failure."
+(define* (rubygems-fetch name #:optional version)
+  "Return a <gem> record for the package NAME and VERSION, or #f on failure.  If VERSION is #f or missing, return the latest version gem."
   (and=> (json-fetch
-          (string-append "https://rubygems.org/api/v1/gems/" name ".json"))
+          (if version
+              (string-append "https://rubygems.org/api/v2/rubygems/" name "/versions/" version ".json")
+              (string-append "https://rubygems.org/api/v1/gems/" name ".json")))
          json->gem))
 
 (define (ruby-package-name name)
@@ -122,8 +125,11 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
 
 (define* (gem->guix-package package-name #:key (repo 'rubygems) version)
   "Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the
-`package' s-expression corresponding to that package, or #f on failure."
-  (let ((gem (rubygems-fetch package-name)))
+`package' s-expression corresponding to that package, or #f on failure.
+Optionally include a VERSION string to fetch a specific version gem."
+  (let ((gem (if version
+                 (rubygems-fetch package-name version)
+                 (rubygems-fetch package-name))))
     (if gem
         (let* ((dependencies-names (map gem-dependency-name
                                         (gem-dependencies-runtime
@@ -189,4 +195,5 @@ package on RubyGems."
   (recursive-import package-name
                     #:repo '()
                     #:repo->guix-package gem->guix-package
-                    #:guix-name ruby-package-name))
+                    #:guix-name ruby-package-name
+                    #:version version))
diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm
index 82deac16ad..7f1e73332b 100644
--- a/guix/scripts/import/gem.scm
+++ b/guix/scripts/import/gem.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +32,7 @@
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 receive)
   #:export (guix-import-gem))
 
 
@@ -42,8 +44,9 @@
   '())
 
 (define (show-help)
-  (display (G_ "Usage: guix import gem PACKAGE-NAME
-Import and convert the RubyGems package for PACKAGE-NAME.\n"))
+  (display (G_ "Usage: guix import gem PACKAGE-NAME[@VERSION] Import and
+convert the RubyGems package for PACKAGE-NAME.  Optionally, a version can be
+specified after the at-sign (@) character.\n"))
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
@@ -86,21 +89,23 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n"))
                              (_ #f))
                            (reverse opts))))
     (match args
-      ((package-name)
-       (let ((code (if (assoc-ref opts 'recursive)
-                       (map (match-lambda
-                              ((and ('package ('name name) . rest) pkg)
-                               `(define-public ,(string->symbol name)
-                                  ,pkg))
-                              (_ #f))
-                            (gem-recursive-import package-name 'rubygems))
-                       (let ((sexp (gem->guix-package package-name)))
-                         (if sexp sexp #f)))))
-         (match code
-           ((or #f '(#f))
-            (leave (G_ "failed to download meta-data for package '~a'~%")
-                   package-name))
-           (_ code))))
+      ((spec)
+       (receive (package-name package-version)
+           (package-name->name+version spec)
+         (let ((code (if (assoc-ref opts 'recursive)
+                         (map (match-lambda
+                                ((and ('package ('name name) . rest) pkg)
+                                 `(define-public ,(string->symbol name)
+                                    ,pkg))
+                                (_ #f))
+                              (gem-recursive-import package-name package-version))
+                         (let ((sexp (gem->guix-package package-name #:version package-version)))
+                           (if sexp sexp #f)))))
+           (match code
+             ((or #f '(#f))
+              (leave (G_ "failed to download meta-data for package '~a'~%")
+                     package-name))
+             (_ code)))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)