123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197 |
- (define-module (guix import gem)
- #:use-module (ice-9 match)
- #:use-module (srfi srfi-1)
- #:use-module (json)
- #:use-module ((guix download) #:prefix download:)
- #:use-module (guix import utils)
- #:use-module (guix import json)
- #:use-module (guix packages)
- #:use-module (guix upstream)
- #:use-module ((guix licenses) #:prefix license:)
- #:use-module (guix base16)
- #:use-module (guix base32)
- #:use-module ((guix build-system ruby) #:select (rubygems-uri))
- #:export (gem->guix-package
- %gem-updater
- gem-recursive-import))
- (define-json-mapping <gem> make-gem gem?
- json->gem
- (name gem-name)
- (platform gem-platform)
- (version gem-version)
- (authors gem-authors)
- (licenses gem-licenses "licenses"
- (lambda (licenses)
-
-
- (cond ((not licenses) '())
- ((unspecified? licenses) '())
- ((vector? licenses) (vector->list licenses))
- (else '()))))
- (info gem-info)
- (sha256 gem-sha256 "sha"
- base16-string->bytevector)
- (home-page gem-home-page "homepage_uri")
- (dependencies gem-dependencies "dependencies"
- json->gem-dependencies))
- (define-json-mapping <gem-dependencies> make-gem-dependencies
- gem-dependencies?
- json->gem-dependencies
- (development gem-dependencies-development
- "development"
- json->gem-dependency-list)
- (runtime gem-dependencies-runtime
- "runtime"
- json->gem-dependency-list))
- (define (json->gem-dependency-list vector)
- (if (and vector (not (unspecified? vector)))
- (map json->gem-dependency (vector->list vector))
- '()))
- (define-json-mapping <gem-dependency> make-gem-dependency gem-dependency?
- json->gem-dependency
- (name gem-dependency-name)
- (requirements gem-dependency-requirements))
- (define (rubygems-fetch name)
- "Return a <gem> record for the package NAME, or #f on failure."
- (and=> (json-fetch
- (string-append "https://rubygems.org/api/v1/gems/" name ".json"))
- json->gem))
- (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 (make-gem-sexp name version hash home-page synopsis 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 hash)))))
- (build-system ruby-build-system)
- ,@(if (null? dependencies)
- '()
- `((propagated-inputs
- (,'quasiquote
- ,(map (lambda (name)
- `(,name
- (,'unquote
- ,(string->symbol name))))
- dependencies)))))
- (synopsis ,synopsis)
- (description ,description)
- (home-page ,home-page)
- (license ,(match licenses
- (() #f)
- ((license) (license->symbol license))
- (_ `(list ,@(map license->symbol 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)))
- (if gem
- (let* ((dependencies-names (map gem-dependency-name
- (gem-dependencies-runtime
- (gem-dependencies gem))))
- (dependencies (map (lambda (dep)
- (if (string=? dep "bundler")
- "bundler"
- (ruby-package-name dep)))
- dependencies-names))
- (licenses (map string->license (gem-licenses gem))))
- (values (make-gem-sexp (gem-name gem) (gem-version gem)
- (gem-sha256 gem) (gem-home-page gem)
- (gem-info gem)
- (beautify-description (gem-info gem))
- dependencies
- licenses)
- dependencies-names))
- (values #f '()))))
- (define (guix-package->gem-name package)
- "Given a PACKAGE built from rubygems.org, return the name of the
- package on RubyGems."
- (let ((source-url (and=> (package-source package) origin-uri)))
-
-
-
-
- (substring source-url 31 (string-rindex source-url #\-))))
- (define (string->license str)
- "Convert the string STR into a license object."
- (match str
- ("GNU LGPL" license:lgpl2.0)
- ("GPL" license:gpl3)
- ((or "BSD" "BSD License") license:bsd-3)
- ((or "MIT" "MIT license" "Expat license") license:expat)
- ("Public domain" license:public-domain)
- ((or "Apache License, Version 2.0" "Apache 2.0") license:asl2.0)
- (_ #f)))
- (define gem-package?
- (url-prefix-predicate "https://rubygems.org/downloads/"))
- (define (latest-release package)
- "Return an <upstream-source> for the latest release of PACKAGE."
- (let* ((gem-name (guix-package->gem-name package))
- (gem (rubygems-fetch gem-name))
- (version (gem-version gem))
- (url (rubygems-uri gem-name version)))
- (upstream-source
- (package (package-name package))
- (version version)
- (urls (list url)))))
- (define %gem-updater
- (upstream-updater
- (name 'gem)
- (description "Updater for RubyGem packages")
- (pred gem-package?)
- (latest latest-release)))
- (define* (gem-recursive-import package-name #:optional version)
- (recursive-import package-name
- #:repo '()
- #:repo->guix-package gem->guix-package
- #:guix-name ruby-package-name))
|