import: Add hex.pm importer.
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.
parent
97586ca1cb
commit
0d9f1f15cb
|
@ -275,6 +275,7 @@ MODULES = \
|
|||
guix/import/gnu.scm \
|
||||
guix/import/go.scm \
|
||||
guix/import/hackage.scm \
|
||||
guix/import/hexpm.scm \
|
||||
guix/import/json.scm \
|
||||
guix/import/kde.scm \
|
||||
guix/import/launchpad.scm \
|
||||
|
@ -326,6 +327,7 @@ MODULES = \
|
|||
guix/scripts/import/gnu.scm \
|
||||
guix/scripts/import/go.scm \
|
||||
guix/scripts/import/hackage.scm \
|
||||
guix/scripts/import/hexpm.scm \
|
||||
guix/scripts/import/json.scm \
|
||||
guix/scripts/import/minetest.scm \
|
||||
guix/scripts/import/opam.scm \
|
||||
|
|
|
@ -48,7 +48,7 @@ Copyright @copyright{} 2017 Thomas Danckaert@*
|
|||
Copyright @copyright{} 2017 humanitiesNerd@*
|
||||
Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@*
|
||||
Copyright @copyright{} 2017, 2018, 2019, 2020, 2021, 2022 Marius Bakke@*
|
||||
Copyright @copyright{} 2017, 2019, 2020 Hartmut Goebel@*
|
||||
Copyright @copyright{} 2017, 2019, 2020, 2022 Hartmut Goebel@*
|
||||
Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@*
|
||||
Copyright @copyright{} 2017–2022 Tobias Geerinckx-Rice@*
|
||||
Copyright @copyright{} 2017 George Clemmer@*
|
||||
|
@ -13453,6 +13453,33 @@ guix import egg arrays@@1.0
|
|||
@end example
|
||||
|
||||
Additional options include:
|
||||
@table @code
|
||||
@item --recursive
|
||||
@itemx -r
|
||||
Traverse the dependency graph of the given upstream package recursively
|
||||
and generate package expressions for all those packages that are not yet
|
||||
in Guix.
|
||||
@end table
|
||||
|
||||
@item hexpm
|
||||
@cindex hexpm
|
||||
Import metadata from the hex.pm Erlang and Elixir package repository
|
||||
@uref{https://hex.pm, hex.pm}, as in this example:
|
||||
|
||||
@example
|
||||
guix import hexpm stun
|
||||
@end example
|
||||
|
||||
The importer tries to determine the build system used by the package.
|
||||
|
||||
The hexpm importer also allows you to specify a version string:
|
||||
|
||||
@example
|
||||
guix import hexpm cf@@0.3.0
|
||||
@end example
|
||||
|
||||
Additional options include:
|
||||
|
||||
@table @code
|
||||
@item --recursive
|
||||
@itemx -r
|
||||
|
|
|
@ -26,20 +26,35 @@
|
|||
#:use-module (guix search-paths)
|
||||
#:use-module (guix build-system)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module ((guix hexpm-download) #:select (hexpm-uri) #:prefix dl:)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (hexpm-uri
|
||||
hexpm-package-url
|
||||
%rebar-build-system-modules
|
||||
rebar-build
|
||||
rebar-build-system))
|
||||
|
||||
;;;
|
||||
;;; Definitions for the hex.pm repository,
|
||||
;;;
|
||||
|
||||
;; 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-package-url
|
||||
(string-append (%hexpm-repo-url) "/tarballs/"))
|
||||
|
||||
(define (hexpm-uri name version)
|
||||
"Return a URI string for the package hosted at hex.pm corresponding to NAME
|
||||
and VERSION."
|
||||
(string-append hexpm-package-url name "-" version ".tar"))
|
||||
|
||||
;;
|
||||
;; Standard build procedure for Erlang packages using Rebar.
|
||||
;;
|
||||
|
||||
(define hexpm-uri dl:hexpm-uri)
|
||||
|
||||
(define %rebar-build-system-modules
|
||||
;; Build-side modules imported by default.
|
||||
`((guix build rebar-build-system)
|
||||
|
|
|
@ -0,0 +1,347 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2016 David Craven <david@craven.ch>
|
||||
;;; Copyright © 2017, 2019-2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
|
||||
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2020-2022 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 (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)
|
||||
#:use-module (guix build-system rebar)
|
||||
#:export (hexpm->guix-package
|
||||
guix-package->hexpm-name
|
||||
strings->licenses ;; why used here?
|
||||
hexpm-recursive-import
|
||||
%hexpm-updater))
|
||||
|
||||
;;;
|
||||
;;; Interface to https://hex.pm/api, version 2.
|
||||
;;; REST-API end-points:
|
||||
;;; https://github.com/hexpm/specifications/blob/master/apiary.apib
|
||||
;;; Repository end-points:
|
||||
;;; 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. /packages/${name}
|
||||
;; https://github.com/hexpm/specifications/blob/master/apiary.apib#Package
|
||||
;;
|
||||
;; Each package can have several "releases", each of which has its own set of
|
||||
;; requirements, build-tool, 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 | 'null
|
||||
(meta hexpm-meta "meta" json->hexpm-meta)
|
||||
(versions hexpm-versions "releases" ; list of <hexpm-version>
|
||||
(lambda (vector)
|
||||
(map json->hexpm-version
|
||||
(vector->list vector))))
|
||||
;; "latest_version" and "latest_stable_version" are not named in the
|
||||
;; specification, butt seen in practice.
|
||||
(latest-version hexpm-latest-version "latest_version") ; string
|
||||
(latest-stable hexpm-latest-stable "latest_stable_version")) ; string
|
||||
|
||||
;; Hexpm package metadata.
|
||||
(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 package versions.
|
||||
(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 hex.pm and return the corresopnding <hexpm> record
|
||||
or #f if it was not found."
|
||||
(and=> (json-fetch (package-url name))
|
||||
json->hexpm))
|
||||
|
||||
;;
|
||||
;; Hexpm release. /packages/${name}/releases/${version}
|
||||
;; https://github.com/hexpm/specifications/blob/master/apiary.apib#Release
|
||||
;;
|
||||
(define-json-mapping <hexpm-release> make-hexpm-release hexpm-release?
|
||||
json->hexpm-release
|
||||
(version hexpm-release-version) ; string
|
||||
(url hexpm-release-url) ; string
|
||||
(meta hexpm-release-meta "meta" json->hexpm-release-meta)
|
||||
;; Specification names the next fields "dependencies", but in practice it is
|
||||
;; "requirements".
|
||||
(dependencies hexpm-requirements "requirements")) ; list of <hexpm-dependency>
|
||||
|
||||
;; Hexpm release meta.
|
||||
;; https://github.com/hexpm/specifications/blob/main/package_metadata.md
|
||||
(define-json-mapping <hexpm-release-meta>
|
||||
make-hexpm-release-meta hexpm-release-meta?
|
||||
json->hexpm-release-meta
|
||||
(app hexpm-release-meta-app) ; string
|
||||
(elixir hexpm-release-meta-elixir) ; string
|
||||
(build-tools hexpm-release-meta-build-tools "build_tools" ; list of strings
|
||||
(lambda (vector)
|
||||
(or (and vector (vector->list vector))
|
||||
(list)))))
|
||||
|
||||
;; Hexpm dependency. Each requirement has information about the required
|
||||
;; version, such as "~> 2.1.2" or ">= 2.1.2 and < 2.2.0", see
|
||||
;; <https://hexdocs.pm/elixir/Version.html#module-requirements>, and whether
|
||||
;; the dependency is optional.
|
||||
(define-json-mapping <hexpm-dependency> make-hexpm-dependency
|
||||
hexpm-dependency?
|
||||
json->hexpm-dependency
|
||||
(name hexpm-dependency-name "app") ; string
|
||||
(requirement hexpm-dependency-requirement) ; string
|
||||
(optional hexpm-dependency-optional)) ; bool
|
||||
|
||||
(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."
|
||||
(and=> (json-fetch (hexpm-version-url version*))
|
||||
json->hexpm-release))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Converting hex.pm packages to Guix packages.
|
||||
;;;
|
||||
|
||||
(define (maybe-inputs package-inputs input-type)
|
||||
"Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
|
||||
package definition. INPUT-TYPE, a symbol, is used to populate the name of
|
||||
the input field."
|
||||
(match package-inputs
|
||||
(()
|
||||
'())
|
||||
((package-inputs ...)
|
||||
`((,input-type (list ,@package-inputs))))))
|
||||
|
||||
(define (dependencies->package-names names)
|
||||
"Given a list of hexpm package NAMES, returns a list of guix package names
|
||||
as symbols."
|
||||
;; TODO: Base name on language of dependency.
|
||||
;; The language used for implementing the dependency is not know without
|
||||
;; recursing the dependencies. So for now assume more packages are based on
|
||||
;; Erlang and prefix all dependencies with "erlang-" (the default).
|
||||
(map string->symbol
|
||||
(map hexpm-name->package-name
|
||||
(sort names string-ci<?))))
|
||||
|
||||
(define* (make-hexpm-sexp #:key name version tarball-url
|
||||
home-page synopsis description license
|
||||
language build-system dependencies
|
||||
#:allow-other-keys)
|
||||
"Return the `package' s-expression for a hexpm package with the given NAME,
|
||||
VERSION, TARBALL-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE. The
|
||||
created package's name will stem from LANGUAGE. BUILD-SYSTEM defined the
|
||||
build-system, and DEPENDENCIES the inputs for the package."
|
||||
(call-with-temporary-output-file
|
||||
(lambda (temp port)
|
||||
(and (url-fetch tarball-url temp)
|
||||
(values
|
||||
`(package
|
||||
(name ,(hexpm-name->package-name name language))
|
||||
(version ,version)
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (hexpm-uri ,name version))
|
||||
(sha256 (base32 ,(guix-hash-url temp)))))
|
||||
(build-system ,build-system)
|
||||
,@(maybe-inputs (dependencies->package-names dependencies) 'inputs)
|
||||
(synopsis ,synopsis)
|
||||
(description ,(beautify-description description))
|
||||
(home-page ,(match home-page
|
||||
(() "")
|
||||
(_ home-page)))
|
||||
(license ,(match license
|
||||
(() #f)
|
||||
((license) license)
|
||||
(_ `(list ,@license))))))))))
|
||||
|
||||
(define (strings->licenses strings)
|
||||
"Convert the list of STRINGS into a list of license objects."
|
||||
(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-release package)
|
||||
"Return the version string for the latest stable release of PACKAGE."
|
||||
;; Use latest-stable if specified (see comment in hexpm-pkgdef above),
|
||||
;; otherwise compare the lists of release versions.
|
||||
(let ((latest-stable (hexpm-latest-stable package)))
|
||||
(if (not (unspecified? latest-stable))
|
||||
latest-stable
|
||||
(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-release 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*)))
|
||||
|
||||
(define release-meta
|
||||
(and package version*
|
||||
(hexpm-release-meta release)))
|
||||
|
||||
(define build-system
|
||||
(and package version*
|
||||
(let ((build-tools (hexpm-release-meta-build-tools release-meta)))
|
||||
(cond
|
||||
((member "rebar3" build-tools) 'rebar-build-system)
|
||||
((member "mix" build-tools) 'mix-build-system)
|
||||
((member "make" build-tools) 'gnu-build-system)
|
||||
(else #f)))))
|
||||
|
||||
(define language
|
||||
(and package version*
|
||||
(let ((elixir (hexpm-release-meta-elixir release-meta)))
|
||||
(cond
|
||||
((and (string? elixir) (not (string-null? elixir))) "elixir")
|
||||
(else "erlang")))))
|
||||
|
||||
(and package version*
|
||||
(let ((dependencies (hexpm-release-dependencies release))
|
||||
(pkg-meta (hexpm-meta package))
|
||||
(docs-html-url (hexpm-docs-html-url package)))
|
||||
(values
|
||||
(make-hexpm-sexp
|
||||
#:language language
|
||||
#:build-system build-system
|
||||
#:name package-name
|
||||
#:version version-number
|
||||
#:dependencies dependencies
|
||||
#:home-page (or (and (not (eq? docs-html-url 'null))
|
||||
docs-html-url)
|
||||
;; 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 #:optional (language "erlang"))
|
||||
(string-append language "-" (string-join (string-split name #\_) "-")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Updater
|
||||
;;;
|
||||
|
||||
(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-release 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 (url-prefix-predicate hexpm-package-url))
|
||||
(latest latest-release)))
|
|
@ -50,7 +50,7 @@
|
|||
|
||||
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
|
||||
"gem" "go" "cran" "crate" "texlive" "json" "opam"
|
||||
"minetest" "elm"))
|
||||
"minetest" "elm" "hexpm"))
|
||||
|
||||
(define (resolve-importer name)
|
||||
(let ((module (resolve-interface
|
||||
|
|
|
@ -0,0 +1,105 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2020, 2022 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-37)
|
||||
#:use-module (srfi srfi-71)
|
||||
#: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_ "
|
||||
-h, --help display this help and exit"))
|
||||
(display (G_ "
|
||||
-V, --version display version information and exit"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-r, --recursive import packages recursively"))
|
||||
(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.
|
||||
(parse-command-line args %options (list %default-options)
|
||||
#:build-options? #f))
|
||||
|
||||
(let* ((opts (parse-options))
|
||||
(args (filter-map (match-lambda
|
||||
(('argument . value)
|
||||
value)
|
||||
(_ #f))
|
||||
(reverse opts))))
|
||||
(match args
|
||||
((spec)
|
||||
(with-error-handling
|
||||
(let ((name version (package-name->name+version spec)))
|
||||
(if (assoc-ref opts 'recursive)
|
||||
;; Recursive import
|
||||
(map (match-lambda
|
||||
((and ('package ('name name) . rest) pkg)
|
||||
`(define-public ,(string->symbol name)
|
||||
,pkg))
|
||||
(_ #f))
|
||||
(hexpm-recursive-import name version))
|
||||
;; Single import
|
||||
(let ((sexp (hexpm->guix-package name #:version version)))
|
||||
(unless sexp
|
||||
(leave (G_ "failed to download meta-data for package '~a'~%")
|
||||
spec))
|
||||
sexp)))))
|
||||
(()
|
||||
(leave (G_ "too few arguments~%")))
|
||||
((many ...)
|
||||
(leave (G_ "too many arguments~%"))))))
|
|
@ -464,6 +464,7 @@ SOURCE, an <upstream-source>."
|
|||
#:key-download key-download)))
|
||||
(values version tarball source))))))
|
||||
|
||||
|
||||
(define* (package-update/git-fetch store package source #:key key-download)
|
||||
"Return the version, checkout, and SOURCE, to update PACKAGE to
|
||||
SOURCE, an <upstream-source>."
|
||||
|
|
|
@ -0,0 +1,253 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 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 (test-hexpm)
|
||||
#:use-module (guix import hexpm)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (gcrypt hash)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
(define test-bla-package
|
||||
"{\"name\": \"bla\",
|
||||
\"html_url\": \"https://hex.pm/packages/bla\",
|
||||
\"docs_html_url\": null,
|
||||
\"meta\": {
|
||||
\"description\": \"A cool package\",
|
||||
\"licenses\": [\"MIT\", \"Apache-2.0\"]
|
||||
},
|
||||
\"releases\": [
|
||||
{\"url\": \"https://hex.pm/api/packages/bla/releases/1.5.0\",
|
||||
\"version\": \"1.5.0\"},
|
||||
{\"url\": \"https://hex.pm/api/packages/bla/releases/1.4.7\",
|
||||
\"version\": \"1.4.7\"}
|
||||
]
|
||||
}")
|
||||
|
||||
(define test-bla-release
|
||||
"{
|
||||
\"version\": \"1.5.0\",
|
||||
\"url\": \"https://hex.pm/api/packages/bla/releases/1.5.0\",
|
||||
\"requirements\": {
|
||||
\"blubb\":{\"app\": \"blubb\",
|
||||
\"optional\": false,
|
||||
\"requirement\": \"~>0.3\"
|
||||
},
|
||||
\"fasel\":{\"app\": \"fasel\",
|
||||
\"optional\": false,
|
||||
\"requirement\": \"~>1.0\"
|
||||
}
|
||||
},
|
||||
\"meta\":{ \"build_tools\":[\"mix\", \"make\", \"rebar3\"] }
|
||||
}")
|
||||
|
||||
(define test-blubb-package
|
||||
"{\"name\": \"blubb\",
|
||||
\"latest_stable_version\": \"0.3.1\",
|
||||
\"latest_version\": \"0.3.1\",
|
||||
\"html_url\": \"https://hex.pm/packages/blubb\",
|
||||
\"docs_html_url\": null,
|
||||
\"meta\": {
|
||||
\"description\": \"Another cool package\",
|
||||
\"licenses\": [\"MIT\"]
|
||||
},
|
||||
\"releases\": [
|
||||
{\"url\": \"https://hex.pm/api/packages/blubb/releases/0.3.1\",
|
||||
\"version\": \"0.3.1\"},
|
||||
{\"url\": \"https://hex.pm/api/packages/blubb/releases/0.3.0\",
|
||||
\"version\": \"0.3.0\"}
|
||||
]
|
||||
}")
|
||||
|
||||
(define test-blubb-release
|
||||
"{
|
||||
\"version\": \"0.3.1\",
|
||||
\"url\": \"https://hex.pm/api/packages/blubb/releases/0.3.1\",
|
||||
\"requirements\": {
|
||||
\"fasel\":{\"app\": \"fasel\",
|
||||
\"optional\": false,
|
||||
\"requirement\": \"~>1.0\"
|
||||
}
|
||||
},
|
||||
\"meta\": { \"build_tools\":[\"mix\"] }
|
||||
}")
|
||||
|
||||
(define test-fasel-package
|
||||
"{\"name\": \"fasel\",
|
||||
\"latest_stable_version\": \"1.2.1\",
|
||||
\"latest_version\": \"1.2.1\",
|
||||
\"html_url\": \"https://hex.pm/packages/fasel\",
|
||||
\"docs_html_url\": null,
|
||||
\"meta\": {
|
||||
\"description\": \"Yet another cool package\",
|
||||
\"licenses\": [\"GPL\"]
|
||||
},
|
||||
\"releases\": [
|
||||
{\"url\": \"https://hex.pm/api/packages/fasel/releases/1.2.1\",
|
||||
\"version\": \"1.2.1\"}
|
||||
]
|
||||
}")
|
||||
|
||||
(define test-fasel-release
|
||||
"{
|
||||
\"version\": \"1.2.1\",
|
||||
\"url\": \"https://hex.pm/api/packages/fasel/releases/1.2.1\",
|
||||
\"requirements\" :{},
|
||||
\"meta\":{ \"build_tools\":[\"make\"] }
|
||||
}")
|
||||
|
||||
(test-begin "hexpm")
|
||||
|
||||
(test-assert "hexpm->guix-package"
|
||||
;; Replace network resources with sample data.
|
||||
(mock ((guix http-client) http-fetch
|
||||
(lambda (url . rest)
|
||||
(match url
|
||||
("https://hex.pm/api/packages/bla"
|
||||
(values (open-input-string test-bla-package)
|
||||
(string-length test-bla-package)))
|
||||
("https://hex.pm/api/packages/bla/releases/1.5.0"
|
||||
(values (open-input-string test-bla-release)
|
||||
(string-length test-bla-release)))
|
||||
(_ (error "http-fetch got unexpected URL: " url)))))
|
||||
(mock ((guix build download) url-fetch
|
||||
(lambda* (url file-name
|
||||
#:key
|
||||
(mirrors '()) verify-certificate?)
|
||||
(with-output-to-file file-name
|
||||
(lambda ()
|
||||
(display
|
||||
(match url
|
||||
("https://repo.hex.pm/tarballs/bla-1.5.0.tar"
|
||||
"source")
|
||||
(_ (error "url-fetch got unexpected URL: " url))))))))
|
||||
(match (hexpm->guix-package "bla")
|
||||
(('package
|
||||
('name "erlang-bla")
|
||||
('version "1.5.0")
|
||||
('source
|
||||
('origin
|
||||
('method 'url-fetch)
|
||||
('uri ('hexpm-uri "bla" 'version))
|
||||
('sha256
|
||||
('base32
|
||||
"0zcl4dgcmqwl1g5xb901pd6dz61r1xgmac9mqlwvh022paa6gks1"))))
|
||||
('build-system 'rebar-build-system)
|
||||
('inputs ('list 'erlang-blubb 'erlang-fasel))
|
||||
('synopsis "A cool package")
|
||||
('description "This package provides a cool package")
|
||||
('home-page "https://hex.pm/packages/bla")
|
||||
('license ('list 'license:expat 'license:asl2.0)))
|
||||
#t)
|
||||
(x
|
||||
(pk 'fail x #f))))))
|
||||
|
||||
(test-assert "hexpm-recursive-import"
|
||||
;; Replace network resources with sample data.
|
||||
(mock ((guix http-client) http-fetch
|
||||
(lambda (url . rest)
|
||||
(match url
|
||||
("https://hex.pm/api/packages/bla"
|
||||
(values (open-input-string test-bla-package)
|
||||
(string-length test-bla-package)))
|
||||
("https://hex.pm/api/packages/bla/releases/1.5.0"
|
||||
(values (open-input-string test-bla-release)
|
||||
(string-length test-bla-release)))
|
||||
("https://hex.pm/api/packages/blubb"
|
||||
(values (open-input-string test-blubb-package)
|
||||
(string-length test-blubb-package)))
|
||||
("https://hex.pm/api/packages/blubb/releases/0.3.1"
|
||||
(values (open-input-string test-blubb-release)
|
||||
(string-length test-blubb-release)))
|
||||
("https://hex.pm/api/packages/fasel"
|
||||
(values (open-input-string test-fasel-package)
|
||||
(string-length test-fasel-package)))
|
||||
("https://hex.pm/api/packages/fasel/releases/1.2.1"
|
||||
(values (open-input-string test-fasel-release)
|
||||
(string-length test-fasel-release)))
|
||||
(_ (error "http-fetch got unexpected URL: " url)))))
|
||||
(mock ((guix build download) url-fetch
|
||||
(lambda* (url file-name
|
||||
#:key
|
||||
(mirrors '()) verify-certificate?)
|
||||
(with-output-to-file file-name
|
||||
(lambda ()
|
||||
(display
|
||||
(match url
|
||||
("https://repo.hex.pm/tarballs/bla-1.5.0.tar"
|
||||
"bla-source")
|
||||
("https://repo.hex.pm/tarballs/blubb-0.3.1.tar"
|
||||
"blubb-source")
|
||||
("https://repo.hex.pm/tarballs/fasel-1.2.1.tar"
|
||||
"fasel-source")
|
||||
(_ (error "url-fetch got unexpected URL: " url))))))))
|
||||
(match (hexpm-recursive-import "bla")
|
||||
((('package
|
||||
('name "erlang-blubb")
|
||||
('version "0.3.1")
|
||||
('source
|
||||
('origin
|
||||
('method 'url-fetch)
|
||||
('uri ('hexpm-uri "blubb" 'version))
|
||||
('sha256
|
||||
('base32
|
||||
"17y88b5y8ld7s1c2bcwwwa04pf1cl4402i9zk3inna221ps3ppj2"))))
|
||||
('build-system 'mix-build-system)
|
||||
('inputs ('list 'erlang-fasel))
|
||||
('synopsis "Another cool package")
|
||||
('description "Another cool package")
|
||||
('home-page "https://hex.pm/packages/blubb")
|
||||
('license 'license:expat))
|
||||
('package
|
||||
('name "erlang-fasel")
|
||||
('version "1.2.1")
|
||||
('source
|
||||
('origin
|
||||
('method 'url-fetch)
|
||||
('uri ('hexpm-uri "fasel" 'version))
|
||||
('sha256
|
||||
('base32
|
||||
"1k6d70mxwqgq78jrbr7yqnw187yki74jnagybi7nacrj4a67qjha"))))
|
||||
('build-system 'gnu-build-system)
|
||||
('synopsis "Yet another cool package")
|
||||
('description "Yet another cool package")
|
||||
('home-page "https://hex.pm/packages/fasel")
|
||||
('license "GPL"))
|
||||
('package
|
||||
('name "erlang-bla")
|
||||
('version "1.5.0")
|
||||
('source
|
||||
('origin
|
||||
('method 'url-fetch)
|
||||
('uri ('hexpm-uri "bla" 'version))
|
||||
('sha256
|
||||
('base32
|
||||
"0d3gj746c4swbb1m6ycylxb239jsavvdcizag6bfbg2aqccxwij8"))))
|
||||
('build-system 'rebar-build-system)
|
||||
('inputs ('list 'erlang-blubb 'erlang-fasel))
|
||||
('synopsis "A cool package")
|
||||
('description "This package provides a cool package")
|
||||
('home-page "https://hex.pm/packages/bla")
|
||||
('license ('list 'license:expat 'license:asl2.0))))
|
||||
#t)
|
||||
(x
|
||||
(pk 'fail x #f))))))
|
||||
|
||||
(test-end "hexpm")
|
Reference in New Issue