unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Taiju HIGASHI <higashi@taiju.info>
To: 57694@debbugs.gnu.org
Cc: Taiju HIGASHI <higashi@taiju.info>
Subject: [bug#57694] [PATCH 1/1] import: gem: Support for importing a specified version of a gem.
Date: Fri,  9 Sep 2022 22:47:36 +0900	[thread overview]
Message-ID: <20220909134736.18808-2-higashi@taiju.info> (raw)
In-Reply-To: <20220909134434.18497-1-higashi@taiju.info>

* guix/import/gem.scm: (rubygems-fetch, gem->guix-package)
(gem-recursive-import): Fix to fetch the specified version of the gem.
* guix/scripts/import/gem.scm (show-help): Modify the help message.
(guix-import-gem): Modify the version number to be passed to subsequent
procedures
* tests/gem.scm: Add tests.
---
 guix/import/gem.scm         |  19 ++++--
 guix/scripts/import/gem.scm |  39 +++++++------
 tests/gem.scm               | 113 ++++++++++++++++++++++++++++++++++++
 3 files changed, 148 insertions(+), 23 deletions(-)

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 @@ (define-json-mapping <gem-dependency> make-gem-dependency gem-dependency?
   (requirements  gem-dependency-requirements))    ;string
 
 \f
-(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 @@ (define (make-gem-sexp name version hash home-page synopsis description
 
 (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 @@ (define* (gem-recursive-import package-name #:optional version)
   (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..2e646e4475 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 @@ (define-module (guix scripts import gem)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 receive)
   #:export (guix-import-gem))
 
 \f
@@ -42,8 +44,9 @@ (define %default-options
   '())
 
 (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 arobas (@) character.\n"))
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
@@ -86,21 +89,23 @@ (define (parse-options)
                              (_ #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 ...)
diff --git a/tests/gem.scm b/tests/gem.scm
index c8fe15398e..6aa0d279dc 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,6 +45,22 @@ (define test-foo-json
   \"licenses\": [\"MIT\", \"Apache 2.0\"]
 }")
 
+(define test-foo-v2-json
+  "{
+  \"name\": \"foo\",
+  \"version\": \"2.0.0\",
+  \"sha\": \"f3676eafca9987cb5fe263df1edf2538bf6dafc712b30e17be3543a9680547a8\",
+  \"info\": \"A cool gem\",
+  \"homepage_uri\": \"https://example.com\",
+  \"dependencies\": {
+    \"runtime\": [
+      { \"name\": \"bundler\" },
+      { \"name\": \"bar\" }
+    ]
+  },
+  \"licenses\": [\"MIT\", \"Apache 2.0\"]
+}")
+
 (define test-bar-json
   "{
   \"name\": \"bar\",
@@ -103,6 +120,35 @@ (define test-bundler-json
       (x
        (pk 'fail x #f)))))
 
+(test-assert "gem->guix-package with a specific version"
+  ;; Replace network resources with sample data.
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://rubygems.org/api/v2/rubygems/foo/versions/2.0.0.json"
+              (values (open-input-string test-foo-v2-json)
+                      (string-length test-foo-v2-json)))
+             (_ (error "Unexpected URL: " url)))))
+    (match (gem->guix-package "foo" #:version "2.0.0")
+      (('package
+         ('name "ruby-foo")
+         ('version "2.0.0")
+         ('source ('origin
+                    ('method 'url-fetch)
+                    ('uri ('rubygems-uri "foo" 'version))
+                    ('sha256
+                     ('base32
+                      "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+         ('build-system 'ruby-build-system)
+         ('propagated-inputs ('list 'bundler 'ruby-bar))
+         ('synopsis "A cool gem")
+         ('description "This package provides a cool gem")
+         ('home-page "https://example.com")
+         ('license ('list 'license:expat 'license:asl2.0)))
+       #t)
+      (x
+       (pk 'fail x #f)))))
+
 (test-assert "gem-recursive-import"
   ;; Replace network resources with sample data.
   (mock ((guix http-client) http-fetch
@@ -170,4 +216,71 @@ (define test-bundler-json
           (x
            (pk 'fail x #f)))))
 
+(test-assert "gem-recursive-import with a specific version"
+  ;; Replace network resources with sample data.
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://rubygems.org/api/v2/rubygems/foo/versions/2.0.0.json"
+              (values (open-input-string test-foo-v2-json)
+                      (string-length test-foo-v2-json)))
+             ("https://rubygems.org/api/v1/gems/bar.json"
+              (values (open-input-string test-bar-json)
+                      (string-length test-bar-json)))
+             ("https://rubygems.org/api/v1/gems/bundler.json"
+              (values (open-input-string test-bundler-json)
+                      (string-length test-bundler-json)))
+             (_ (error "Unexpected URL: " url)))))
+        (match (gem-recursive-import "foo" "2.0.0")
+          ((('package
+              ('name "ruby-bar")
+              ('version "1.0.0")
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('rubygems-uri "bar" 'version))
+                 ('sha256
+                  ('base32
+                   "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+              ('build-system 'ruby-build-system)
+              ('propagated-inputs ('list 'bundler))
+              ('synopsis "Another cool gem")
+              ('description "Another cool gem")
+              ('home-page "https://example.com")
+              ('license #f))                      ;no licensing info
+            ('package
+              ('name "ruby-bundler")
+              ('version "1.14.2")
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('rubygems-uri "bundler" 'version))
+                 ('sha256
+                  ('base32
+                   "1446xiz7zg0bz7kgx9jv84y0s4hpsg61dj5l3qb0i00avc1kxd9v"))))
+              ('build-system 'ruby-build-system)
+              ('synopsis "Ruby gem bundler")
+              ('description "Ruby gem bundler")
+              ('home-page "https://bundler.io/")
+              ('license 'license:expat))
+            ('package
+              ('name "ruby-foo")
+              ('version "2.0.0")
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('rubygems-uri "foo" 'version))
+                 ('sha256
+                  ('base32
+                   "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+              ('build-system 'ruby-build-system)
+              ('propagated-inputs ('list 'bundler 'ruby-bar))
+              ('synopsis "A cool gem")
+              ('description "This package provides a cool gem")
+              ('home-page "https://example.com")
+              ('license ('list 'license:expat 'license:asl2.0))))
+           #t)
+          (x
+           (pk 'fail x #f)))))
+
 (test-end "gem")
-- 
2.37.2





  reply	other threads:[~2022-09-09 13:51 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-09-09 13:44 [bug#57694] [PATCH 0/1] Support for importing a specified version of a gem Taiju HIGASHI
2022-09-09 13:47 ` Taiju HIGASHI [this message]
2022-09-14  9:55   ` [bug#57694] [PATCH 1/1] import: gem: " Taiju HIGASHI
2022-09-17 17:18     ` bug#57694: " Christopher Baines
2022-09-17 23:52       ` [bug#57694] " Taiju HIGASHI

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220909134736.18808-2-higashi@taiju.info \
    --to=higashi@taiju.info \
    --cc=57694@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).