guix/import/gem.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
   3 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
   4 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
   5 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (guix import gem)
  23   #:use-module (ice-9 match)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (guix json)
  26   #:use-module ((guix download) #:prefix download:)
  27   #:use-module (guix import utils)
  28   #:use-module (guix import json)
  29   #:use-module (guix packages)
  30   #:use-module (guix upstream)
  31   #:use-module ((guix licenses) #:prefix license:)
  32   #:use-module (guix base16)
  33   #:use-module (guix base32)
  34   #:use-module ((guix build-system ruby) #:select (rubygems-uri))
  35   #:export (gem->guix-package
  36             %gem-updater
  37             gem-recursive-import))
  38
  39 ;; Gems as defined by the API at <https://rubygems.org/api/v1/gems>.
  40 (define-json-mapping <gem> make-gem gem?
  41   json->gem
  42   (name          gem-name)                        ;string
  43   (platform      gem-platform)                    ;string
  44   (version       gem-version)                     ;string
  45   (authors       gem-authors)                     ;string
  46   (licenses      gem-licenses "licenses"          ;list of strings
  47                  vector->list)
  48   (info          gem-info)
  49   (sha256        gem-sha256 "sha"                 ;bytevector
  50                  base16-string->bytevector)
  51   (home-page     gem-home-page "homepage_uri")    ;string
  52   (dependencies  gem-dependencies "dependencies"  ;<gem-dependencies>
  53                  json->gem-dependencies))
  54
  55 (define-json-mapping <gem-dependencies> make-gem-dependencies
  56   gem-dependencies?
  57   json->gem-dependencies
  58   (development   gem-dependencies-development     ;list of <gem-dependency>
  59                  "development"
  60                  json->gem-dependency-list)
  61   (runtime       gem-dependencies-runtime         ;list of <gem-dependency>
  62                  "runtime"
  63                  json->gem-dependency-list))
  64
  65 (define (json->gem-dependency-list vector)
  66   (if vector
  67       (map json->gem-dependency (vector->list vector))
  68       '()))
  69
  70 (define-json-mapping <gem-dependency> make-gem-dependency gem-dependency?
  71   json->gem-dependency
  72   (name          gem-dependency-name)             ;string
  73   (requirements  gem-dependency-requirements))    ;string
  74
  75 \f
  76 (define (rubygems-fetch name)
  77   "Return a <gem> record for the package NAME, or #f on failure."
  78   (and=> (json-fetch
  79           (string-append "https://rubygems.org/api/v1/gems/" name ".json"))
  80          json->gem))
  81
  82 (define (ruby-package-name name)
  83   "Given the NAME of a package on RubyGems, return a Guix-compliant name for
  84 the package."
  85   (if (string-prefix? "ruby-" name)
  86       (snake-case name)
  87       (string-append "ruby-" (snake-case name))))
  88
  89 (define (make-gem-sexp name version hash home-page synopsis description
  90                        dependencies licenses)
  91   "Return the `package' s-expression for a Ruby package with the given NAME,
  92 VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
  93   `(package
  94      (name ,(ruby-package-name name))
  95      (version ,version)
  96      (source (origin
  97                (method url-fetch)
  98                (uri (rubygems-uri ,name version))
  99                (sha256
 100                 (base32
 101                  ,(bytevector->nix-base32-string hash)))))
 102      (build-system ruby-build-system)
 103      ,@(if (null? dependencies)
 104            '()
 105            `((propagated-inputs
 106               (,'quasiquote
 107                ,(map (lambda (name)
 108                        `(,name
 109                          (,'unquote
 110                           ,(string->symbol name))))
 111                      dependencies)))))
 112      (synopsis ,synopsis)
 113      (description ,description)
 114      (home-page ,home-page)
 115      (license ,(match licenses
 116                  (() #f)
 117                  ((license) (license->symbol license))
 118                  (_ `(list ,@(map license->symbol licenses)))))))
 119
 120 (define* (gem->guix-package package-name #:optional (repo 'rubygems) version)
 121   "Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the
 122 `package' s-expression corresponding to that package, or #f on failure."
 123   (let ((gem (rubygems-fetch package-name)))
 124     (if gem
 125         (let* ((dependencies-names (map gem-dependency-name
 126                                         (gem-dependencies-runtime
 127                                          (gem-dependencies gem))))
 128                (dependencies (map (lambda (dep)
 129                                     (if (string=? dep "bundler")
 130                                         "bundler" ; special case, no prefix
 131                                         (ruby-package-name dep)))
 132                                   dependencies-names))
 133                (licenses     (map string->license (gem-licenses gem))))
 134           (values (make-gem-sexp (gem-name gem) (gem-version gem)
 135                                  (gem-sha256 gem) (gem-home-page gem)
 136                                  (gem-info gem)
 137                                  (beautify-description (gem-info gem))
 138                                  dependencies
 139                                  licenses)
 140                   dependencies-names))
 141         (values #f '()))))
 142
 143 (define (guix-package->gem-name package)
 144   "Given a PACKAGE built from rubygems.org, return the name of the
 145 package on RubyGems."
 146   (let ((source-url (and=> (package-source package) origin-uri)))
 147     ;; The URL has the form:
 148     ;; 'https://rubygems.org/downloads/' +
 149     ;; package name + '-' + version + '.gem'
 150     ;; e.g. "https://rubygems.org/downloads/hashery-2.1.1.gem"
 151     (substring source-url 31 (string-rindex source-url #\-))))
 152
 153 (define (string->license str)
 154   "Convert the string STR into a license object."
 155   (match str
 156     ("GNU LGPL" license:lgpl2.0)
 157     ("GPL" license:gpl3)
 158     ((or "BSD" "BSD License") license:bsd-3)
 159     ((or "MIT" "MIT license" "Expat license") license:expat)
 160     ("Public domain" license:public-domain)
 161     ((or "Apache License, Version 2.0" "Apache 2.0") license:asl2.0)
 162     (_ #f)))
 163
 164 (define (gem-package? package)
 165   "Return true if PACKAGE is a gem package from RubyGems."
 166
 167   (define (rubygems-url? url)
 168     (string-prefix? "https://rubygems.org/downloads/" url))
 169
 170   (let ((source-url (and=> (package-source package) origin-uri))
 171         (fetch-method (and=> (package-source package) origin-method)))
 172     (and (eq? fetch-method download:url-fetch)
 173          (match source-url
 174            ((? string?)
 175             (rubygems-url? source-url))
 176            ((source-url ...)
 177             (any rubygems-url? source-url))))))
 178
 179 (define (latest-release package)
 180   "Return an <upstream-source> for the latest release of PACKAGE."
 181   (let* ((gem-name (guix-package->gem-name package))
 182          (gem      (rubygems-fetch gem-name))
 183          (version  (gem-version gem))
 184          (url      (rubygems-uri gem-name version)))
 185     (upstream-source
 186      (package (package-name package))
 187      (version version)
 188      (urls (list url)))))
 189
 190 (define %gem-updater
 191   (upstream-updater
 192    (name 'gem)
 193    (description "Updater for RubyGem packages")
 194    (pred gem-package?)
 195    (latest latest-release)))
 196
 197 (define* (gem-recursive-import package-name #:optional version)
 198   (recursive-import package-name '()
 199                     #:repo->guix-package gem->guix-package
 200                     #:guix-name ruby-package-name))