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