ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2020-02-05 15:52:33 +01:00
parent 312df1d40c
commit 23db833335
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 68 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

130
guix/import/gem.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,28 +21,63 @@
(define-module (guix import gem) (define-module (guix import gem)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (rnrs bytevectors) #:use-module (guix json)
#:use-module (json)
#:use-module (web uri)
#:use-module ((guix download) #:prefix download:) #:use-module ((guix download) #:prefix download:)
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix import json) #:use-module (guix import json)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix base16)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix build-system ruby) #:use-module ((guix build-system ruby) #:select (rubygems-uri))
#:export (gem->guix-package #:export (gem->guix-package
%gem-updater %gem-updater
gem-recursive-import)) 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) (define (rubygems-fetch name)
"Return an alist representation of the RubyGems metadata for the package NAME, "Return a <gem> record for the package NAME, or #f on failure."
or #f on failure." (and=> (json-fetch
(json-fetch (string-append "https://rubygems.org/api/v1/gems/" name ".json"))
(string-append "https://rubygems.org/api/v1/gems/" name ".json"))) json->gem))
(define (ruby-package-name name) (define (ruby-package-name name)
"Given the NAME of a package on RubyGems, return a Guix-compliant name for "Given the NAME of a package on RubyGems, return a Guix-compliant name for
@ -50,41 +86,6 @@ (define (ruby-package-name name)
(snake-case name) (snake-case name)
(string-append "ruby-" (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 (define (make-gem-sexp name version hash home-page synopsis description
dependencies licenses) dependencies licenses)
"Return the `package' s-expression for a Ruby package with the given NAME, "Return the `package' s-expression for a Ruby package with the given NAME,
@ -97,8 +98,7 @@ (define (make-gem-sexp name version hash home-page synopsis description
(uri (rubygems-uri ,name version)) (uri (rubygems-uri ,name version))
(sha256 (sha256
(base32 (base32
,(bytevector->nix-base32-string ,(bytevector->nix-base32-string hash)))))
(hex-string->bytevector hash))))))
(build-system ruby-build-system) (build-system ruby-build-system)
,@(if (null? dependencies) ,@(if (null? dependencies)
'() '()
@ -120,31 +120,25 @@ (define (make-gem-sexp name version hash home-page synopsis description
(define* (gem->guix-package package-name #:optional (repo 'rubygems) version) (define* (gem->guix-package package-name #:optional (repo 'rubygems) version)
"Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the "Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the
`package' s-expression corresponding to that package, or #f on failure." `package' s-expression corresponding to that package, or #f on failure."
(let ((package (rubygems-fetch package-name))) (let ((gem (rubygems-fetch package-name)))
(and package (if gem
(let* ((name (assoc-ref package "name")) (let* ((dependencies-names (map gem-dependency-name
(version (assoc-ref package "version")) (gem-dependencies-runtime
(hash (assoc-ref package "sha")) (gem-dependencies gem))))
(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) (dependencies (map (lambda (dep)
(if (string=? dep "bundler") (if (string=? dep "bundler")
"bundler" ; special case, no prefix "bundler" ; special case, no prefix
(ruby-package-name dep))) (ruby-package-name dep)))
dependencies-names)) dependencies-names))
(licenses (map string->license (licenses (map string->license (gem-licenses gem))))
(vector->list (values (make-gem-sexp (gem-name gem) (gem-version gem)
(assoc-ref package "licenses"))))) (gem-sha256 gem) (gem-home-page gem)
(values (make-gem-sexp name version hash home-page synopsis (gem-info gem)
description dependencies licenses) (beautify-description (gem-info gem))
dependencies-names))))) dependencies
licenses)
dependencies-names))
(values #f '()))))
(define (guix-package->gem-name package) (define (guix-package->gem-name package)
"Given a PACKAGE built from rubygems.org, return the name of the "Given a PACKAGE built from rubygems.org, return the name of the
@ -185,8 +179,8 @@ (define (rubygems-url? url)
(define (latest-release package) (define (latest-release package)
"Return an <upstream-source> for the latest release of PACKAGE." "Return an <upstream-source> for the latest release of PACKAGE."
(let* ((gem-name (guix-package->gem-name package)) (let* ((gem-name (guix-package->gem-name package))
(metadata (rubygems-fetch gem-name)) (gem (rubygems-fetch gem-name))
(version (assoc-ref metadata "version")) (version (gem-version gem))
(url (rubygems-uri gem-name version))) (url (rubygems-uri gem-name version)))
(upstream-source (upstream-source
(package (package-name package)) (package (package-name package))