me/guix
Archived
1
0
Fork 0
Code Activity

import: Add hex.pm importer.

Browse source 
hex.pm is a package repository for Erlang and Elixir.

* guix/scripts/import.scm (importers): Add "hexpm".
* guix/scripts/import/hexpm.scm, guix/import/hexpm.scm,
  guix/hexpm-download.scm: New files.
* guix/import/utils.scm (source-spec->object): Add "hexpm-fetch" to list of
  fetch methods.
* guix/upstream.scm (package-update/hexpm-fetch): New function.
  (%method-updates) Add it.
* Makefile.am: Add them.
This commit is contained in:
Hartmut Goebel 2020-05-24 22:17:30 +02:00
parent f63c79bf76
commit d780d0a2bb
No known key found for this signature in database
GPG key ID: 634A8DFFD3F631DF
7 changed files with 504 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -99,6 +99,7 @@ MODULES = \
guix/extracting-download.scm \ guix/extracting-download.scm \
guix/git-download.scm \ guix/git-download.scm \
guix/hg-download.scm \ guix/hg-download.scm \
guix/hexpm-download.scm \
guix/swh.scm \ guix/swh.scm \
guix/monads.scm \ guix/monads.scm \
guix/monad-repl.scm \ guix/monad-repl.scm \
@ -262,6 +263,7 @@ MODULES = \
guix/import/gnu.scm \ guix/import/gnu.scm \
guix/import/go.scm \ guix/import/go.scm \
guix/import/hackage.scm \ guix/import/hackage.scm \
guix/import/hexpm.scm \
guix/import/json.scm \ guix/import/json.scm \
guix/import/kde.scm \ guix/import/kde.scm \
guix/import/launchpad.scm \ guix/import/launchpad.scm \
@ -309,6 +311,7 @@ MODULES = \
guix/scripts/import/gnu.scm \ guix/scripts/import/gnu.scm \
guix/scripts/import/go.scm \ guix/scripts/import/go.scm \
guix/scripts/import/hackage.scm \ guix/scripts/import/hackage.scm \
guix/scripts/import/hexpm.scm \
guix/scripts/import/json.scm \ guix/scripts/import/json.scm \
guix/scripts/import/minetest.scm \ guix/scripts/import/minetest.scm \
guix/scripts/import/opam.scm \ guix/scripts/import/opam.scm \

76
guix/hexpm-download.scm Normal file
View file

@ -0,0 +1,76 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix hexpm-download)
#:use-module (ice-9 match)
#:use-module (guix extracting-download)
#:use-module (guix packages) ;; for %current-system
#:use-module (srfi srfi-26)
#:export (hexpm-fetch
%hexpm-repo-url
hexpm-url
hexpm-url?
hexpm-uri))
;;;
;;; An <origin> method that fetches a package from the hex.pm repository,
;;; unwrapping the actual content from the download tarball.
;;;
;; URL and paths from
;; https://github.com/hexpm/specifications/blob/master/endpoints.md
(define %hexpm-repo-url
(make-parameter "https://repo.hex.pm"))
(define hexpm-url
(string-append (%hexpm-repo-url) "/tarballs/"))
(define hexpm-url?
(cut string-prefix? hexpm-url <>))
(define (hexpm-uri name version)
"Return a URI string for the package hosted at hex.pm corresponding to NAME
and VERSION."
(string-append hexpm-url name "-" version ".tar"))
(define* (hexpm-fetch url hash-algo hash
#:optional name
#:key
(filename-to-extract "contents.tar.gz")
(system (%current-system))
(guile (default-guile)))
"Return a fixed-output derivation that fetches URL and extracts
\"contents.tar.gz\". The output is expected to have hash HASH of type
HASH-ALGO (a symbol). By default, the file name is the base name of URL;
optionally, NAME can specify a different file name. By default, the file name
is the base name of URL with \".gz\" appended; optionally, NAME can specify a
different file name."
(define file-name
(match url
((head _ ...)
(basename head))
(_
(basename url))))
(http-fetch/extract url "contents.tar.gz" hash-algo hash
;; urls typically end with .tar, but contents is .tar.gz
(or name (string-append file-name ".gz"))
#:system system #:guile guile))

290
guix/import/hexpm.scm Normal file
View file

@ -0,0 +1,290 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import hexpm)
#:use-module (guix base32)
#:use-module ((guix download) #:prefix download:)
#:use-module (guix hexpm-download)
#:use-module (gcrypt hash)
#:use-module (guix http-client)
#:use-module (json)
#:use-module (guix import utils)
#:use-module ((guix import json) #:select (json-fetch))
#:use-module ((guix build utils)
#:select ((package-name->name+version
. hyphen-package-name->name+version)
dump-port))
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 popen)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#:export (hexpm->guix-package
guix-package->hexpm-name
strings->licenses
hexpm-recursive-import
%hexpm-updater))
;;;
;;; Interface to https://hex.pm/api, version 2.
;;; https://github.com/hexpm/specifications/blob/master/apiary.apib
;;; https://github.com/hexpm/specifications/blob/master/endpoints.md
;;;
(define %hexpm-api-url
(make-parameter "https://hex.pm/api"))
(define (package-url name)
(string-append (%hexpm-api-url) "/packages/" name))
;; Hexpm Package. /api/packages/${name}
;; It can have several "releases", each of which has its own set of
;; requirements, buildtool, etc. - see <hexpm-release> below.
(define-json-mapping <hexpm-pkgdef> make-hexpm-pkgdef hexpm-pkgdef?
json->hexpm
(name hexpm-name) ;string
(html-url hexpm-html-url "html_url") ;string
(docs-html-url hexpm-docs-html-url "docs_html_url") ;string | #nil
(meta hexpm-meta "meta" json->hexpm-meta)
(versions hexpm-versions "releases" ;list of <hexpm-version>
(lambda (vector)
(map json->hexpm-version
(vector->list vector)))))
;; Hexpm meta.
(define-json-mapping <hexpm-meta> make-hexpm-meta hexpm-meta?
json->hexpm-meta
(description hexpm-meta-description) ;string
(licenses hexpm-meta-licenses "licenses" ;list of strings
(lambda (vector)
(or (and vector (vector->list vector))
#f))))
;; Hexpm version.
(define-json-mapping <hexpm-version> make-hexpm-version hexpm-version?
json->hexpm-version
(number hexpm-version-number "version") ;string
(url hexpm-version-url)) ;string
(define (lookup-hexpm name)
"Look up NAME on https://hex.pm and return the corresopnding <hexpm>
record or #f if it was not found."
(let ((json (json-fetch (package-url name))))
(and json
(json->hexpm json))))
;; Hexpm release. /api/packages/${name}/releases/${version}
(define-json-mapping <hexpm-release> make-hexpm-release hexpm-release?
json->hexpm-release
(number hexpm-release-number "version") ;string
(url hexpm-release-url) ;string
(requirements hexpm-requirements "requirements")) ;list of <hexpm-dependency>
;; meta:build_tools -> alist
;; Hexpm dependency. Each dependency (each edge in the graph) is annotated as
;; being a "normal" dependency or a development dependency. There also
;; information about the minimum required version, such as "^0.0.41".
(define-json-mapping <hexpm-dependency> make-hexpm-dependency
hexpm-dependency?
json->hexpm-dependency
(app hexpm-dependency-app "app") ;string
(optional hexpm-dependency-optional) ;bool
(requirement hexpm-dependency-requirement)) ;string
(define (hexpm-release-dependencies release)
"Return the list of dependency names of RELEASE, a <hexpm-release>."
(let ((reqs (or (hexpm-requirements release) '#())))
(map first reqs))) ;; TODO: also return required version
(define (lookup-hexpm-release version*)
"Look up RELEASE on hexpm-version-url and return the corresopnding
<hexpm-release> record or #f if it was not found."
(let* ((url (hexpm-version-url version*))
(json (json-fetch url)))
(json->hexpm-release json)))
;;;
;;; Converting hex.pm packages to Guix packages.
;;;
(define* (make-hexpm-sexp #:key name version tarball-url
home-page synopsis description license
#:allow-other-keys)
"Return the `package' s-expression for a rust package with the given NAME,
VERSION, tarball-url, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(call-with-temporary-directory
(lambda (directory)
(let ((port (http-fetch tarball-url))
(tar (open-pipe* OPEN_WRITE "tar" "-C" directory
"-xf" "-" "contents.tar.gz")))
(dump-port port tar)
(close-port port)
(let ((status (close-pipe tar)))
(unless (zero? status)
(error "tar extraction failure" status))))
(let ((guix-name (hexpm-name->package-name name))
(sha256 (bytevector->nix-base32-string
(call-with-input-file
(string-append directory "/contents.tar.gz")
port-sha256))))
`(package
(name ,guix-name)
(version ,version)
(source (origin
(method hexpm-fetch)
(uri (hexpm-uri ,name version))
(sha256 (base32 ,sha256))))
(build-system ,'rebar3-build-system)
(home-page ,(match home-page
(() "")
(_ home-page)))
(synopsis ,synopsis)
(description ,(beautify-description description))
(license ,(match license
(() #f)
((license) license)
(_ `(list ,@license)))))))))
(define (strings->licenses strings)
(filter-map (lambda (license)
(and (not (string-null? license))
(not (any (lambda (elem) (string=? elem license))
'("AND" "OR" "WITH")))
(or (spdx-string->license license)
license)))
strings))
(define (hexpm-latest-version package)
(let ((versions (map hexpm-version-number (hexpm-versions package))))
(fold (lambda (a b)
(if (version>? a b) a b)) (car versions) versions)))
(define* (hexpm->guix-package package-name #:key repo version)
"Fetch the metadata for PACKAGE-NAME from hexpms.io, and return the
`package' s-expression corresponding to that package, or #f on failure.
When VERSION is specified, attempt to fetch that version; otherwise fetch the
latest version of PACKAGE-NAME."
(define package
(lookup-hexpm package-name))
(define version-number
(and package
(or version
(hexpm-latest-version package))))
(define version*
(and package
(find (lambda (version)
(string=? (hexpm-version-number version)
version-number))
(hexpm-versions package))))
(define release
(and package version*
(lookup-hexpm-release version*)))
(and package version*
(let ((dependencies (hexpm-release-dependencies release))
(pkg-meta (hexpm-meta package)))
(values
(make-hexpm-sexp
#:name package-name
#:version version-number
#:home-page (or (hexpm-docs-html-url package)
;; TODO: Homepage?
(hexpm-html-url package))
#:synopsis (hexpm-meta-description pkg-meta)
#:description (hexpm-meta-description pkg-meta)
#:license (or (and=> (hexpm-meta-licenses pkg-meta)
strings->licenses))
#:tarball-url (hexpm-uri package-name version-number))
dependencies))))
(define* (hexpm-recursive-import pkg-name #:optional version)
(recursive-import pkg-name
#:version version
#:repo->guix-package hexpm->guix-package
#:guix-name hexpm-name->package-name))
(define (guix-package->hexpm-name package)
"Return the hex.pm name of PACKAGE."
(define (url->hexpm-name url)
(hyphen-package-name->name+version
(basename (file-sans-extension url))))
(match (and=> (package-source package) origin-uri)
((? string? url)
(url->hexpm-name url))
((lst ...)
(any url->hexpm-name lst))
(#f #f)))
(define (hexpm-name->package-name name)
(string-append "erlang-" (string-join (string-split name #\_) "-")))
;;;
;;; Updater
;;;
(define (hexpm-package? package)
"Return true if PACKAGE is a package from hex.pm."
(let ((source-url (and=> (package-source package) origin-uri))
(fetch-method (and=> (package-source package) origin-method)))
(and (eq? fetch-method hexpm-fetch)
(match source-url
((? string?)
(hexpm-url? source-url))
((source-url ...)
(any hexpm-url? source-url))))))
(define (latest-release package)
"Return an <upstream-source> for the latest release of PACKAGE."
(let* ((hexpm-name (guix-package->hexpm-name package))
(hexpm (lookup-hexpm hexpm-name))
(version (hexpm-latest-version hexpm))
(url (hexpm-uri hexpm-name version)))
(upstream-source
(package (package-name package))
(version version)
(urls (list url)))))
(define %hexpm-updater
(upstream-updater
(name 'hexpm)
(description "Updater for hex.pm packages")
(pred hexpm-package?)
(latest latest-release)))

1
guix/import/utils.scm
View file

@ -359,6 +359,7 @@ the expected fields of an <origin> object."
("git-fetch" (@ (guix git-download) git-fetch)) ("git-fetch" (@ (guix git-download) git-fetch))
("svn-fetch" (@ (guix svn-download) svn-fetch)) ("svn-fetch" (@ (guix svn-download) svn-fetch))
("hg-fetch" (@ (guix hg-download) hg-fetch)) ("hg-fetch" (@ (guix hg-download) hg-fetch))
("hexpm-fetch" (@ (guix hexpm-download) hexpm-fetch))
(_ #f))) (_ #f)))
(uri (assoc-ref orig "uri")) (uri (assoc-ref orig "uri"))
(sha256 sha)))))) (sha256 sha))))))

2
guix/scripts/import.scm
View file

@ -79,7 +79,7 @@ rather than \\n."
;;; ;;;
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
"gem" "go" "cran" "crate" "texlive" "json" "opam" "gem" "go" "cran" "crate" "texlive" "json" "opam" "hexpm"
"minetest")) "minetest"))
(define (resolve-importer name) (define (resolve-importer name)

114
guix/scripts/import/hexpm.scm Normal file
View file

@ -0,0 +1,114 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts import hexpm)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import hexpm)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-hexpm))
;;;
;;; Command-line options.
;;;
(define %default-options
'())
(define (show-help)
(display (G_ "Usage: guix import hexpm PACKAGE-NAME
Import and convert the hex.pm package for PACKAGE-NAME.\n"))
(display (G_ "
-r, --recursive import packages recursively"))
(newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
;; Specification of the command-line options.
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import hexpm")))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
%standard-import-options))
;;;
;;; Entry point.
;;;
(define (guix-import-hexpm . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
(leave (G_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
value)
(_ #f))
(reverse opts))))
(match args
((spec)
(define-values (name version)
(package-name->name+version spec))
(if (assoc-ref opts 'recursive)
(map (match-lambda
((and ('package ('name name) . rest) pkg)
`(define-public ,(string->symbol name)
,pkg))
(_ #f))
(hexpm-recursive-import name version))
(let ((sexp (hexpm->guix-package name #:version version)))
(unless sexp
(leave (G_ "failed to download meta-data for package '~a'~%")
(if version
(string-append name "@" version)
name)))
sexp)))
(()
(leave (G_ "too few arguments~%")))
((many ...)
(leave (G_ "too many arguments~%"))))))

20
guix/upstream.scm
View file

@ -24,6 +24,10 @@
#:use-module (guix discovery) #:use-module (guix discovery)
#:use-module ((guix download) #:use-module ((guix download)
#:select (download-to-store url-fetch)) #:select (download-to-store url-fetch))
#:use-module ((guix hexpm-download)
#:select (hexpm-fetch))
#:use-module ((guix extracting-download)
#:select (download-to-store/extract))
#:use-module (guix gnupg) #:use-module (guix gnupg)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix diagnostics) #:use-module (guix diagnostics)
@ -430,9 +434,23 @@ SOURCE, an <upstream-source>."
#:key-download key-download))) #:key-download key-download)))
(values version tarball source)))))) (values version tarball source))))))
(define* (package-update/hexpm-fetch store package source
#:key key-download)
"Return the version, tarball, and SOURCE, to update PACKAGE to
SOURCE, an <upstream-source>."
(match source
(($ <upstream-source> _ version urls signature-urls)
(let* ((url (first urls))
(name (or (origin-file-name (package-source package))
(string-append (basename url) ".gz")))
(tarball (download-to-store/extract
store url "contents.tar.gz" name)))
(values version tarball source)))))
(define %method-updates (define %method-updates
;; Mapping of origin methods to source update procedures. ;; Mapping of origin methods to source update procedures.
`((,url-fetch . ,package-update/url-fetch))) `((,url-fetch . ,package-update/url-fetch)
(,hexpm-fetch . ,package-update/hexpm-fetch)))
(define* (package-update store package (define* (package-update store package
#:optional (updaters (force %updaters)) #:optional (updaters (force %updaters))