me
/
guix
Archived
1
0
Fork 0
Code

import: Add Elm importer. 

* guix/import/elm.scm, guix/scripts/import/elm.scm: New files.
* Makefile.am (MODULES): Add them.
* guix/scripts/import.scm (importers): Add "elm".
* doc/guix.texi (Invoking guix import): Document Elm importer.
* doc/contributing.texi (Elm Packages): Mention it.
* tests/elm.scm ("(guix import elm)"): New test group.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Philip McGrath 2022-05-18 14:10:56 -04:00 committed by Ludovic Courtès
parent 9a47fd56dd
commit 903c82583e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
7 changed files with 519 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -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 \

4
doc/contributing.texi
View File

@ -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

25
doc/guix.texi
View File

@ -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

210
guix/import/elm.scm 100644
View File

@ -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))

3
guix/scripts/import.scm
View File

@ -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

107
guix/scripts/import/elm.scm 100644
View File

@ -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~%"))))))

171
tests/elm.scm
View File

@ -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")