On Sun, Aug 16, 2015 at 10:01 PM, David Thompson <dthomps...@worcester.edu> wrote: > Building off of the new and improved Ruby build system, here are two > patches that add a handy RubyGems importer.
Here's an updated patch that uses the hex encoded SHAs on rubygems.org rather than downloading the source gem and computing the hash locally. - Dave
From d370086d5e1c5878110d0cc4cd1884f601545acb Mon Sep 17 00:00:00 2001 From: David Thompson <dthomps...@worcester.edu> Date: Sun, 16 Aug 2015 21:15:45 -0400 Subject: [PATCH] import: Add Ruby gem importer. * gnu/scripts/import.scm (importers): Add "gem". * gnu/import/gem.scm: New file. * gnu/scripts/import/gem.scm: New file. * Makefile.am (MODULES): Add them. --- Makefile.am | 3 +- guix/import/gem.scm | 131 ++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/gem.scm | 91 ++++++++++++++++++++++++++++++ 4 files changed, 225 insertions(+), 2 deletions(-) create mode 100644 guix/import/gem.scm create mode 100644 guix/scripts/import/gem.scm diff --git a/Makefile.am b/Makefile.am index ada4cbe..f9203ec 100644 --- a/Makefile.am +++ b/Makefile.am @@ -213,7 +213,8 @@ MODULES += \ guix/import/pypi.scm \ guix/scripts/import/pypi.scm \ guix/import/cpan.scm \ - guix/scripts/import/cpan.scm + guix/scripts/import/gem.scm \ + guix/import/gem.scm SCM_TESTS += \ tests/pypi.scm \ diff --git a/guix/import/gem.scm b/guix/import/gem.scm new file mode 100644 index 0000000..3c28d1d --- /dev/null +++ b/guix/import/gem.scm @@ -0,0 +1,131 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson <da...@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix import gem) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (rnrs bytevectors) + #:use-module (json) + #:use-module (web uri) + #:use-module (guix import utils) + #:use-module (guix import json) + #:use-module (guix packages) + #:use-module (guix licenses) + #:use-module (guix base32) + #:export (gem->guix-package)) + +(define (rubygems-fetch name) + "Return an alist representation of the RubyGems metadata for the package NAME, +or #f on failure." + (json-fetch + (string-append "https://rubygems.org/api/v1/gems/"; name ".json"))) + +(define (ruby-package-name name) + "Given the NAME of a package on RubyGems, return a Guix-compliant name for +the package." + (if (string-prefix? "ruby-" name) + (snake-case name) + (string-append "ruby-" (snake-case name)))) + +(define (hex-string->bytevector str) + "Convert the hexadecimal encoded string STR to a bytevector." + (define hex-char->int + (match-lambda + (#\0 0) + (#\1 1) + (#\2 2) + (#\3 3) + (#\4 4) + (#\5 5) + (#\6 6) + (#\7 7) + (#\8 8) + (#\9 9) + (#\a 10) + (#\b 11) + (#\c 12) + (#\d 13) + (#\e 14) + (#\f 15))) + + (define (read-byte i) + (let ((j (* 2 i))) + (+ (hex-char->int (string-ref str (1+ j))) + (* (hex-char->int (string-ref str j)) 16)))) + + (let* ((len (/ (string-length str) 2)) + (bv (make-bytevector len))) + (let loop ((i 0)) + (if (= i len) + bv + (begin + (bytevector-u8-set! bv i (read-byte i)) + (loop (1+ i))))))) + +(define (make-gem-sexp name version hash home-page description + dependencies licenses) + "Return the `package' s-expression for a Ruby package with the given NAME, +VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." + `(package + (name ,(ruby-package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (rubygems-uri ,name version)) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (hex-string->bytevector hash)))))) + (build-system ruby-build-system) + ,@(if (null? dependencies) + '() + `((propagated-inputs + (,'quasiquote + ,(map (lambda (name) + `(,name + (,'unquote + ,(string->symbol name)))) + dependencies))))) + (synopsis ,description) ; nothing better to use + (description ,description) + (home-page ,home-page) + (license ,(match licenses + ((license) (license->symbol license)) + (_ (map license->symbol licenses)))))) + +(define* (gem->guix-package package-name #:optional 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")) + (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 + description dependencies licenses))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index d0bdec1..6cd762a 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm new file mode 100644 index 0000000..9f8094f --- /dev/null +++ b/guix/scripts/import/gem.scm @@ -0,0 +1,91 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson <da...@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import gem) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import gem) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-gem)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (_ "Usage: guix import gem PACKAGE-NAME +Import and convert the RubyGems package for PACKAGE-NAME.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import pypi"))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-gem . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (gem->guix-package package-name))) + (unless sexp + (leave (_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) -- 2.4.3
