From 88388766f778d344699e7a8a0a4d970c403007e3 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Tue, 3 Jul 2018 23:28:42 +0300 Subject: import: gem: Add recursive import. * doc/guix.texi (Invoking guix import): Document gem recursive import. * guix/import/gem.scm (gem->guix-package): Return package and dependencies values. (gem-recursive-import): New procedure. * guix/scripts/import/gem.scm (show-help, %options): Add recursive option. (guix-import-gem): Use 'gem-recursive-import'. * tests/gem.scm (test-json): Rename to 'test-foo-json'. ("gem->guix-package"): Use 'test-foo-json'. (test-bar-json, test-bundler-json): New variables. ("gem-recursive-import"): New test. --- doc/guix.texi | 8 ++++ guix/import/gem.scm | 48 ++++++++++++-------- guix/scripts/import/gem.scm | 27 +++++++++-- tests/gem.scm | 108 ++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 163 insertions(+), 28 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index a8e53a5308..8026bea356 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6380,6 +6380,14 @@ The command below imports metadata for the @code{rails} Ruby package: guix import gem rails @end example +@table @code +@item --recursive +@itemx -r +Traverse the dependency graph of the given upstream package recursively +and generate package expressions for all those packages that are not yet +in Guix. +@end table + @item cpan @cindex CPAN Import metadata from @uref{https://www.metacpan.org/, MetaCPAN}@footnote{This diff --git a/guix/import/gem.scm b/guix/import/gem.scm index 646163fb7b..ea576b5e4a 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016 Ben Woodcroft +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,8 @@ #:use-module (guix base32) #:use-module (guix build-system ruby) #:export (gem->guix-package - %gem-updater)) + %gem-updater + gem-recursive-import)) (define (rubygems-fetch name) "Return an alist representation of the RubyGems metadata for the package NAME, @@ -115,29 +117,30 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." ((license) (license->symbol license)) (_ `(list ,@(map license->symbol licenses))))))) -(define* (gem->guix-package package-name #:optional version) +(define* (gem->guix-package package-name #:optional (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 ((package (rubygems-fetch package-name))) (and package - (let ((name (assoc-ref package "name")) - (version (assoc-ref package "version")) - (hash (assoc-ref package "sha")) - (synopsis (assoc-ref package "info")) ; nothing better to use - (description (beautify-description - (assoc-ref package "info"))) - (home-page (assoc-ref package "homepage_uri")) - (dependencies (map (lambda (dep) - (let ((name (assoc-ref dep "name"))) - (if (string=? name "bundler") - "bundler" ; special case, no prefix - (ruby-package-name name)))) - (assoc-ref* package "dependencies" - "runtime"))) - (licenses (map string->license - (assoc-ref package "licenses")))) - (make-gem-sexp name version hash home-page synopsis - description dependencies licenses))))) + (let* ((name (assoc-ref package "name")) + (version (assoc-ref package "version")) + (hash (assoc-ref package "sha")) + (synopsis (assoc-ref package "info")) ; nothing better to use + (description (beautify-description + (assoc-ref package "info"))) + (home-page (assoc-ref package "homepage_uri")) + (dependencies-names (map (lambda (dep) (assoc-ref dep "name")) + (assoc-ref* package "dependencies" "runtime"))) + (dependencies (map (lambda (dep) + (if (string=? dep "bundler") + "bundler" ; special case, no prefix + (ruby-package-name dep))) + dependencies-names)) + (licenses (map string->license + (assoc-ref package "licenses")))) + (values (make-gem-sexp name version hash home-page synopsis + description dependencies licenses) + dependencies-names))))) (define (guix-package->gem-name package) "Given a PACKAGE built from rubygems.org, return the name of the @@ -192,3 +195,8 @@ package on RubyGems." (description "Updater for RubyGem packages") (pred gem-package?) (latest latest-release))) + +(define* (gem-recursive-import package-name #:optional version) + (recursive-import package-name '() + #:repo->guix-package gem->guix-package + #:guix-name ruby-package-name)) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index 349a0a072a..b6d9ccaae4 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-gem)) @@ -44,6 +46,9 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) -h, --help display this help and exit")) (display (G_ " -V, --version display version information and exit")) + (display (G_ " + -r, --recursive generate package expressions for all Gem packages\ + that are not yet in Guix")) (newline) (show-bug-report-information)) @@ -56,6 +61,9 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix import pypi"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) %standard-import-options)) @@ -81,11 +89,20 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) (reverse opts)))) (match args ((package-name) - (let ((sexp (gem->guix-package package-name))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - package-name)) - sexp)) + (if (assoc-ref opts 'recursive) + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (reverse + (stream->list + (gem-recursive-import package-name 'rubygems)))) + (let ((sexp (gem->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp))) (() (leave (G_ "too few arguments~%"))) ((many ...) diff --git a/tests/gem.scm b/tests/gem.scm index a39e8ba514..4220170ff0 100644 --- a/tests/gem.scm +++ b/tests/gem.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016 Ricardo Wurmus +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,10 +24,11 @@ #:use-module (guix hash) #:use-module (guix tests) #:use-module ((guix build utils) #:select (delete-file-recursively)) + #:use-module (srfi srfi-41) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) -(define test-json +(define test-foo-json "{ \"name\": \"foo\", \"version\": \"1.0.0\", @@ -42,6 +44,34 @@ \"licenses\": [\"MIT\", \"Apache 2.0\"] }") +(define test-bar-json + "{ + \"name\": \"bar\", + \"version\": \"1.0.0\", + \"sha\": \"f3676eafca9987cb5fe263df1edf2538bf6dafc712b30e17be3543a9680547a8\", + \"info\": \"Another cool gem\", + \"homepage_uri\": \"https://example.com\", + \"dependencies\": { + \"runtime\": [ + { \"name\": \"bundler\" }, + ] + }, + \"licenses\": [\"MIT\", \"Apache 2.0\"] +}") + +(define test-bundler-json + "{ + \"name\": \"bundler\", + \"version\": \"1.14.2\", + \"sha\": \"3bb53e03db0a8008161eb4c816ccd317120d3c415ba6fee6f90bbc7f7eec8690\", + \"info\": \"Ruby gem bundler\", + \"homepage_uri\": \"https://bundler.io/\", + \"dependencies\": { + \"runtime\": [] + }, + \"licenses\": [\"MIT\"] +}") + (test-begin "gem") (test-assert "gem->guix-package" @@ -50,8 +80,8 @@ (lambda (url . rest) (match url ("https://rubygems.org/api/v1/gems/foo.json" - (values (open-input-string test-json) - (string-length test-json))) + (values (open-input-string test-foo-json) + (string-length test-foo-json))) (_ (error "Unexpected URL: " url))))) (match (gem->guix-package "foo") (('package @@ -76,4 +106,76 @@ (x (pk 'fail x #f))))) +(test-assert "gem-recursive-import" + ;; Replace network resources with sample data. + (mock ((guix http-client) http-fetch + (lambda (url . rest) + (match url + ("https://rubygems.org/api/v1/gems/foo.json" + (values (open-input-string test-foo-json) + (string-length test-foo-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 (stream->list (gem-recursive-import "foo")) + ((('package + ('name "ruby-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('rubygems-uri "foo" 'version)) + ('sha256 + ('base32 + "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) + ('build-system 'ruby-build-system) + ('propagated-inputs + ('quasiquote + (("bundler" ('unquote 'bundler)) + ("ruby-bar" ('unquote '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))) + ('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-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 + ('quasiquote + (('"bundler" ('unquote 'bundler))))) + ('synopsis "Another cool gem") + ('description "Another cool gem") + ('home-page "https://example.com") + ('license ('list 'license:expat 'license:asl2.0)))) + #t) + (x + (pk 'fail x #f))))) + (test-end "gem") -- cgit v1.2.3