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