summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHartmut Goebel <h.goebel@crazy-compilers.com>2022-03-04 19:32:32 +0100
committerHartmut Goebel <h.goebel@crazy-compilers.com>2022-06-15 10:18:34 +0200
commit0d9f1f15cb0ce1e71943bff9a68e6839d0eae497 (patch)
tree448fb02a1b01282e1118e4115ff528a13687f656
parent97586ca1cb25aed9da13c9cc7de152346be0a093 (diff)
downloadguix-patches-0d9f1f15cb0ce1e71943bff9a68e6839d0eae497.tar
guix-patches-0d9f1f15cb0ce1e71943bff9a68e6839d0eae497.tar.gz
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.
-rw-r--r--Makefile.am2
-rw-r--r--doc/guix.texi29
-rw-r--r--guix/build-system/rebar.scm21
-rw-r--r--guix/import/hexpm.scm347
-rw-r--r--guix/scripts/import.scm2
-rw-r--r--guix/scripts/import/hexpm.scm105
-rw-r--r--guix/upstream.scm1
-rw-r--r--tests/hexpm.scm253
8 files changed, 755 insertions, 5 deletions
diff --git a/Makefile.am b/Makefile.am
index 5a496aeeb3..ade53866b3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/doc/guix.texi b/doc/guix.texi
index 826e83007f..749b2236b5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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@*
@@ -13460,6 +13460,33 @@ 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
+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
@end table
The structure of the @command{guix import} code is modular. It would be
diff --git a/guix/build-system/rebar.scm b/guix/build-system/rebar.scm
index 8a8fb7708c..6ca5abe4d6 100644
--- a/guix/build-system/rebar.scm
+++ b/guix/build-system/rebar.scm
@@ -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)
diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm
new file mode 100644
index 0000000000..2a7a9f3d82
--- /dev/null
+++ b/guix/import/hexpm.scm
@@ -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)))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 62aa7bdbc5..71ab4b4fed 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -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
diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm
new file mode 100644
index 0000000000..eb9a1b0af5
--- /dev/null
+++ b/guix/scripts/import/hexpm.scm
@@ -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~%"))))))
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 6666803a92..b0f77fb7d0 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -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>."
diff --git a/tests/hexpm.scm b/tests/hexpm.scm
new file mode 100644
index 0000000000..e9f899f166
--- /dev/null
+++ b/tests/hexpm.scm
@@ -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")