TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Oleg Pykhalov 2018-07-03 23:28:42 +03:00
parent a59b0fa2d7
commit 88388766f7
No known key found for this signature in database
GPG Key ID: 7246E11C69B79569
4 changed files with 163 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
doc/guix.texi
View File

@ -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

48
guix/import/gem.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; 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))

27
guix/scripts/import/gem.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; 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 ...)

108
tests/gem.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; 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")