guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#54796] [PATCH v4 01/22] import: Add hex.pm importer.


From: Hartmut Goebel
Subject: [bug#54796] [PATCH v4 01/22] import: Add hex.pm importer.
Date: Sun, 10 Apr 2022 20:56:59 +0200

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.
---
 Makefile.am                   |   3 +
 doc/guix.texi                 |  29 ++-
 guix/hexpm-download.scm       |  40 ++++
 guix/import/hexpm.scm         | 347 ++++++++++++++++++++++++++++++++++
 guix/scripts/import.scm       |   2 +-
 guix/scripts/import/hexpm.scm | 109 +++++++++++
 guix/upstream.scm             |   1 +
 tests/hexpm.scm               | 257 +++++++++++++++++++++++++
 8 files changed, 786 insertions(+), 2 deletions(-)
 create mode 100644 guix/hexpm-download.scm
 create mode 100644 guix/import/hexpm.scm
 create mode 100644 guix/scripts/import/hexpm.scm
 create mode 100644 tests/hexpm.scm

diff --git a/Makefile.am b/Makefile.am
index aedb514ee1..46481dac2c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -100,6 +100,7 @@ MODULES =                                   \
   guix/git-download.scm                                \
   guix/hg-download.scm                         \
   guix/hash.scm                                        \
+  guix/hexpm-download.scm                      \
   guix/swh.scm                                 \
   guix/monads.scm                              \
   guix/monad-repl.scm                          \
@@ -263,6 +264,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                    \
@@ -311,6 +313,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 e8ef4286be..6c17b26d70 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@*
@@ -12817,6 +12817,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
diff --git a/guix/hexpm-download.scm b/guix/hexpm-download.scm
new file mode 100644
index 0000000000..e2f0eb22a8
--- /dev/null
+++ b/guix/hexpm-download.scm
@@ -0,0 +1,40 @@
+;;; 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 hexpm-download)
+  #:use-module (srfi srfi-26)
+  #:export (hexpm-package-url
+            hexpm-uri))
+
+;;;
+;;; Definitions for the hex.pm repository,
+;;; combined here since different build-systems use it.
+;;;
+
+;; 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"))
diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm
new file mode 100644
index 0000000000..39ac9ed5db
--- /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 (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   ;;  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) 'rebar3-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 40fa6759ae..aaadad4adf 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -79,7 +79,7 @@ rather than \\n."
 ;;;
 
 (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"))
 
 (define (resolve-importer name)
diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm
new file mode 100644
index 0000000000..b49d263f9e
--- /dev/null
+++ b/guix/scripts/import/hexpm.scm
@@ -0,0 +1,109 @@
+;;; 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, 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-11)
+  #: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..84d126c821
--- /dev/null
+++ b/tests/hexpm.scm
@@ -0,0 +1,257 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; 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 'rebar3-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 'rebar3-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")
-- 
2.30.2






reply via email to

[Prev in Thread] Current Thread [Next in Thread]