guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

import: gem: Rewrite to use a JSON mapping to records. 

* guix/import/gem.scm (<gem>, <gem-dependencies>, <gem-dependency>): New
record types with JSON mapping.
(json->gem-dependencies): New procedures.
(rubygems-fetch): Use it.
(hex-string->bytevector): Remove.
(make-gem-sexp): Expect HASH to be a bytevector.
(gem->guix-package): Adjust to use the new <gem> data type instead of an
alist.
(latest-release): Likewise.
version-1.1.0
Ludovic Courtès 2 years ago
parent
312df1d40c
commit
23db833335
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
1 changed files with 68 additions and 74 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 142
      guix/import/gem.scm

142
guix/import/gem.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,28 +21,63 @@
(define-module (guix import gem)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1)
#:use-module (rnrs bytevectors)
#:use-module (json)
#:use-module (web uri)
#:use-module (guix 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)
#:use-module ((guix build-system ruby) #:select (rubygems-uri))
#:export (gem->guix-package
%gem-updater
gem-recursive-import))
;; Gems as defined by the API at <https://rubygems.org/api/v1/gems>.
(define-json-mapping <gem> make-gem gem?
json->gem
(name gem-name) ;string
(platform gem-platform) ;string
(version gem-version) ;string
(authors gem-authors) ;string
(licenses gem-licenses "licenses" ;list of strings
vector->list)
(info gem-info)
(sha256 gem-sha256 "sha" ;bytevector
base16-string->bytevector)
(home-page gem-home-page "homepage_uri") ;string
(dependencies gem-dependencies "dependencies" ;<gem-dependencies>
json->gem-dependencies))
(define-json-mapping <gem-dependencies> make-gem-dependencies
gem-dependencies?
json->gem-dependencies
(development gem-dependencies-development ;list of <gem-dependency>
"development"
json->gem-dependency-list)
(runtime gem-dependencies-runtime ;list of <gem-dependency>
"runtime"
json->gem-dependency-list))
(define (json->gem-dependency-list vector)
(if 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) ;string
(requirements gem-dependency-requirements)) ;string
(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")))
"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
@ -50,41 +86,6 @@ the package."
(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 synopsis description
dependencies licenses)
"Return the `package' s-expression for a Ruby package with the given NAME,
@ -97,8 +98,7 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
(uri (rubygems-uri ,name version))
(sha256
(base32
,(bytevector->nix-base32-string
(hex-string->bytevector hash))))))
,(bytevector->nix-base32-string hash)))))
(build-system ruby-build-system)
,@(if (null? dependencies)
'()
@ -120,31 +120,25 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
(define* (gem->guix-package package-name #:optional (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 ((package (rubygems-fetch package-name)))
(and package
(let* ((name (assoc-ref package "name"))
(version (assoc-ref package "version"))
(hash (assoc-ref package "sha"))
(synopsis (assoc-ref package "info")) ; nothing better to use
(description (beautify-description
(assoc-ref package "info")))
(home-page (assoc-ref package "homepage_uri"))
(dependencies-names (map (lambda (dep) (assoc-ref dep "name"))
(vector->list
(assoc-ref* package
"dependencies"
"runtime"))))
(dependencies (map (lambda (dep)
(if (string=? dep "bundler")
"bundler" ; special case, no prefix
(ruby-package-name dep)))
dependencies-names))
(licenses (map string->license
(vector->list
(assoc-ref package "licenses")))))
(values (make-gem-sexp name version hash home-page synopsis
description dependencies licenses)
dependencies-names)))))
(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" ; special case, no prefix
(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
@ -185,9 +179,9 @@ package on RubyGems."
(define (latest-release package)
"Return an <upstream-source> for the latest release of PACKAGE."
(let* ((gem-name (guix-package->gem-name package))
(metadata (rubygems-fetch gem-name))
(version (assoc-ref metadata "version"))
(url (rubygems-uri gem-name version)))
(gem (rubygems-fetch gem-name))
(version (gem-version gem))
(url (rubygems-uri gem-name version)))
(upstream-source
(package (package-name package))
(version version)

Write Preview
Loading…
Cancel
Save