diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | doc/contributing.texi | 4 | ||||
| -rw-r--r-- | doc/guix.texi | 25 | ||||
| -rw-r--r-- | guix/import/elm.scm | 210 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 3 | ||||
| -rw-r--r-- | guix/scripts/import/elm.scm | 107 | ||||
| -rw-r--r-- | tests/elm.scm | 171 |
7 files changed, 519 insertions, 3 deletions
diff --git a/Makefile.am b/Makefile.am index 9ca92c407c..5a42bb90b2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -259,6 +259,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/crate.scm \ guix/import/egg.scm \ + guix/import/elm.scm \ guix/import/elpa.scm \ guix/import/gem.scm \ guix/import/git.scm \ @@ -310,6 +311,7 @@ MODULES = \ guix/scripts/import/crate.scm \ guix/scripts/import/cran.scm \ guix/scripts/import/egg.scm \ + guix/scripts/import/elm.scm \ guix/scripts/import/elpa.scm \ guix/scripts/import/gem.scm \ guix/scripts/import/gnu.scm \ diff --git a/doc/contributing.texi b/doc/contributing.texi index 555b9bb961..2354874cb0 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -919,8 +919,8 @@ prefix unless the name would already begin with @code{elm-}. In many cases we can reconstruct an Elm package's upstream name heuristically, but, since conversion to a Guix-style name involves a loss of information, this is not always possible. Care should be taken to add the -@code{'upstream-name} property when necessary so that tools -will work correctly. The most notable scenarios +@code{'upstream-name} property when necessary so that @samp{guix import elm} +will work correctly (@pxref{Invoking guix import}). The most notable scenarios when explicitly specifying the upstream name is necessary are: @enumerate diff --git a/doc/guix.texi b/doc/guix.texi index 3eff660f0e..5a07c995b9 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -13157,6 +13157,31 @@ and generate package expressions for all those packages that are not yet in Guix. @end table +@item elm +@cindex elm +Import metadata from the Elm package repository +@uref{https://package.elm-lang.org, package.elm-lang.org}, as in this example: + +@example +guix import elm elm-explorations/webgl +@end example + +The Elm importer also allows you to specify a version string: + +@example +guix import elm elm-explorations/webgl@@1.1.3 +@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 opam @cindex OPAM @cindex OCaml diff --git a/guix/import/elm.scm b/guix/import/elm.scm new file mode 100644 index 0000000000..74902b8617 --- /dev/null +++ b/guix/import/elm.scm @@ -0,0 +1,210 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.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 elm) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (guix utils) + #:use-module (guix base32) + #:use-module (guix hash) + #:use-module (guix http-client) + #:use-module (guix memoization) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + #:use-module ((guix ui) #:select (display-hint)) + #:use-module ((guix build utils) + #:select ((package-name->name+version + . hyphen-package-name->name+version) + find-files + invoke)) + #:use-module (guix import utils) + #:use-module (guix git) + #:use-module (guix import json) + #:autoload (gcrypt hash) (hash-algorithm sha256) + #:use-module (json) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix build-system elm) + #:export (elm-recursive-import + %elm-package-registry + %current-elm-checkout + elm->guix-package)) + +(define %registry-url + ;; It is much nicer to fetch this small (< 40 KB gzipped) + ;; file once than to do many HTTP requests. + "https://package.elm-lang.org/all-packages") + +(define %elm-package-registry + ;; This is a parameter to support both testing and memoization. + ;; In pseudo-code, it has the contract: + ;; (parameter/c (-> json/c) + ;; (promise/c (vhash/c string? (listof string?)))) + ;; To set the parameter, provide a thunk that returns a value suitable + ;; as an argument to 'json->registry-vhash'. Accessing the parameter + ;; returns a promise wrapping the resulting vhash. + (make-parameter + (lambda () + (cond + ((json-fetch %registry-url #:http-fetch http-fetch/cached)) + (else + (raise (formatted-message + (G_ "error downloading Elm package registry from ~a") + %registry-url))))) + (lambda (thunk) + (delay (json->registry-vhash (thunk)))))) + +(define (json->registry-vhash jsobject) + "Parse the '(json)' module's representation of the Elm package registry to a +vhash mapping package names to lists of available versions, sorted from latest +to oldest." + (fold (lambda (entry vh) + (match entry + ((name . vec) + (vhash-cons name + (sort (vector->list vec) version>?) + vh)))) + vlist-null + jsobject)) + +(define (json->direct-dependencies jsobject) + "Parse the '(json)' module's representation of an 'elm.json' file's +'dependencies' or 'test-dependencies' field to a list of strings naming direct +dependencies, handling both the 'package' and 'application' grammars." + (cond + ;; *unspecified* + ((not (pair? jsobject)) + '()) + ;; {"type":"application"} + ((every (match-lambda + (((or "direct" "indirect") (_ . _) ...) + #t) + (_ + #f)) + jsobject) + (map car (or (assoc-ref jsobject "direct") '()))) + ;; {"type":"package"} + (else + (map car jsobject)))) + +;; <project-info> handles both {"type":"package"} and {"type":"application"} +(define-json-mapping <project-info> make-project-info project-info? + json->project-info + (dependencies project-info-dependencies + "dependencies" json->direct-dependencies) + (test-dependencies project-info-test-dependencies + "test-dependencies" json->direct-dependencies) + ;; "synopsis" and "license" may be missing for {"type":"application"} + (synopsis project-info-synopsis + "summary" (lambda (x) + (if (string? x) + x + ""))) + (license project-info-license + "license" (lambda (x) + (if (string? x) + (spdx-string->license x) + #f)))) + +(define %current-elm-checkout + ;; This is a parameter for testing purposes. + (make-parameter + (lambda (name version) + (define-values (checkout _commit _relation) + ;; Elm requires that packages use this very specific format + (update-cached-checkout (string-append "https://github.com/" name) + #:ref `(tag . ,version))) + checkout))) + +(define (make-elm-package-sexp name version) + "Return two values: the `package' s-expression for the Elm package with the +given NAME and VERSION, and a list of Elm packages it depends on." + (define checkout + ((%current-elm-checkout) name version)) + (define info + (call-with-input-file (string-append checkout "/elm.json") + json->project-info)) + (define dependencies + (project-info-dependencies info)) + (define test-dependencies + (project-info-test-dependencies info)) + (define guix-name + (elm->package-name name)) + (values + `(package + (name ,guix-name) + (version ,version) + (source (elm-package-origin + ,name + version ;; no , + (base32 + ,(bytevector->nix-base32-string + (file-hash* checkout + #:algorithm (hash-algorithm sha256) + #:recursive? #t))))) + (build-system elm-build-system) + ,@(maybe-propagated-inputs (map elm->package-name dependencies)) + ,@(maybe-inputs (map elm->package-name test-dependencies)) + (home-page ,(string-append "https://package.elm-lang.org/packages/" + name "/" version)) + (synopsis ,(project-info-synopsis info)) + (description + ;; Try to use the first paragraph of README.md (which Elm requires), + ;; or fall back to synopsis otherwise. + ,(beautify-description + (match (chunk-lines (call-with-input-file + (string-append checkout "/README.md") + read-lines)) + ((_ par . _) + (string-join par " ")) + (_ + (project-info-synopsis info))))) + ,@(let ((inferred-name (infer-elm-package-name guix-name))) + (if (equal? inferred-name name) + '() + `((properties '((upstream-name . ,name)))))) + (license ,(project-info-license info))) + (append dependencies test-dependencies))) + +(define elm->guix-package + (memoize + (lambda* (package-name #:key repo version) + "Fetch the metadata for PACKAGE-NAME, an Elm package registered at +package.elm.org, and return two values: the `package' s-expression +corresponding to that package (or #f on failure) and a list of Elm +dependencies." + (cond + ((vhash-assoc package-name (force (%elm-package-registry))) + => (match-lambda + ((_found latest . _versions) + (make-elm-package-sexp package-name (or version latest))))) + (else + (values #f '())))))) + +(define* (elm-recursive-import package-name #:optional version) + (recursive-import package-name + #:version version + #:repo->guix-package elm->guix-package + #:guix-name elm->package-name)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 40fa6759ae..fa79f3211e 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -80,7 +81,7 @@ rather than \\n." (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" "gem" "go" "cran" "crate" "texlive" "json" "opam" - "minetest")) + "minetest" "elm")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/elm.scm b/guix/scripts/import/elm.scm new file mode 100644 index 0000000000..68dcbf1070 --- /dev/null +++ b/guix/scripts/import/elm.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.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 elm) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import elm) + #: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-elm)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import elm PACKAGE-NAME + +Import and convert the Elm package PACKAGE-NAME. Optionally, a version +can be specified after the arobas (@) character.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -r, --recursive import packages recursively")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import elm"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-elm . 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)) + (elm-recursive-import name version)) + ;; Single import + (let ((sexp (elm->guix-package name #:version version))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + name)) + sexp))))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/tests/elm.scm b/tests/elm.scm index 96f958f060..c30623da03 100644 --- a/tests/elm.scm +++ b/tests/elm.scm @@ -18,6 +18,13 @@ (define-module (test-elm) #:use-module (guix build-system elm) + #:use-module (guix import elm) + #:use-module (guix base32) + #:use-module (guix hash) + #:use-module (guix utils) + #:autoload (gcrypt hash) (hash-algorithm sha256) + #:use-module (json) + #:use-module (ice-9 match) #:use-module (srfi srfi-64)) (test-begin "elm") @@ -94,4 +101,168 @@ (test-not-inferred "gcc-toolchain") (test-not-inferred "font-adobe-source-sans-pro"))) +(define test-package-registry-json + ;; we intentionally list versions in different orders here + "{ + \"elm/core\": [\"1.0.0\", \"1.0.1\", \"1.0.2\", \"1.0.3\", \"1.0.4\"], + \"elm-guix/demo\": [\"2.0.0\", \"3.0.0\", \"1.0.0\"] +}") + +(define test-elm-core-json + "{ + \"type\": \"package\", + \"name\": \"elm/core\", + \"summary\": \"Elm's standard libraries\", + \"license\": \"BSD-3-Clause\", + \"version\": \"1.0.4\", + \"exposed-modules\": { + \"Primitives\": [ + \"Basics\", + \"String\", + \"Char\", + \"Bitwise\", + \"Tuple\" + ], + \"Collections\": [ + \"List\", + \"Dict\", + \"Set\", + \"Array\" + ], + \"Error Handling\": [ + \"Maybe\", + \"Result\" + ], + \"Debug\": [ + \"Debug\" + ], + \"Effects\": [ + \"Platform.Cmd\", + \"Platform.Sub\", + \"Platform\", + \"Process\", + \"Task\" + ] + }, + \"elm-version\": \"0.19.0 <= v < 0.20.0\", + \"dependencies\": {}, + \"test-dependencies\": {} +}") + +(define test-elm-core-readme + "# Core Libraries + +Every Elm project needs this package! + +It provides **basic functionality** like addition and subtraction as well as +**data structures** like lists, dictionaries, and sets.") + +(define test-elm-guix-demo-json + "{ + \"type\": \"package\", + \"name\": \"elm-guix/demo\", + \"summary\": \"A test for `(guix import elm)`\", + \"license\": \"GPL-3.0-or-later\", + \"version\": \"3.0.0\", + \"exposed-modules\": [ + \"Guix.Demo\" + ], + \"elm-version\": \"0.19.0 <= v < 0.20.0\", + \"dependencies\": { + \"elm/core\": \"1.0.0 <= v < 2.0.0\" + }, + \"test-dependencies\": { + \"elm/json\": \"1.0.0 <= v < 2.0.0\" + } +}") + +(define test-elm-guix-demo-readme + ;; intentionally left blank + "") + +(define (directory-sha256 directory) + "Returns the string representing the hash of DIRECTORY as would be used in a +package definition." + (bytevector->nix-base32-string + (file-hash* directory + #:algorithm (hash-algorithm sha256) + #:recursive? #t))) + +(test-group "(guix import elm)" + (call-with-temporary-directory + (lambda (dir) + ;; Initialize our fake git checkouts. + (define elm-core-dir + (string-append dir "/test-elm-core-1.0.4")) + (define elm-guix-demo-dir + (string-append dir "/test-elm-guix-demo-3.0.0")) + (for-each (match-lambda + ((dir json readme) + (mkdir dir) + (with-output-to-file (string-append dir "/elm.json") + (lambda () + (display json))) + (with-output-to-file (string-append dir "/README.md") + (lambda () + (display readme))))) + `((,elm-core-dir ,test-elm-core-json ,test-elm-core-readme) + (,elm-guix-demo-dir + ,test-elm-guix-demo-json + ,test-elm-guix-demo-readme))) + ;; Replace network resources with sample data. + (parameterize ((%elm-package-registry + (lambda () + (json-string->scm test-package-registry-json))) + (%current-elm-checkout + (lambda (name version) + (match (list name version) + (("elm/core" "1.0.4") + elm-core-dir) + (("elm-guix/demo" "3.0.0") + elm-guix-demo-dir))))) + (test-assert "(elm->guix-package \"elm/core\")" + (match (elm->guix-package "elm/core") + (`(package + (name "elm-core") + (version "1.0.4") + (source (elm-package-origin + "elm/core" + version + (base32 ,(? string? hash)))) + (build-system elm-build-system) + (home-page + "https://package.elm-lang.org/packages/elm/core/1.0.4") + (synopsis "Elm's standard libraries") + (description "Every Elm project needs this package!") + (license license:bsd-3)) + (equal? (directory-sha256 elm-core-dir) + hash)) + (x + (raise-exception x)))) + (test-assert "(elm-recursive-import \"elm-guix/demo\")" + (match (elm-recursive-import "elm-guix/demo") + (`((package + (name "elm-guix-demo") + (version "3.0.0") + (source (elm-package-origin + "elm-guix/demo" + version + (base32 ,(? string? hash)))) + (build-system elm-build-system) + (propagated-inputs + ,'`(("elm-core" ,elm-core))) + (inputs + ,'`(("elm-json" ,elm-json))) + (home-page + "https://package.elm-lang.org/packages/elm-guix/demo/3.0.0") + (synopsis "A test for `(guix import elm)`") + (description + "This package provides a test for `(guix import elm)`") + (properties '((upstream-name . "elm-guix/demo"))) + (license license:gpl3+))) + (equal? (directory-sha256 elm-guix-demo-dir) + hash)) + (x + (raise-exception x)))))))) + (test-end "elm") |