futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

guix: Add elm-build-system.

Browse Source 
* gnu/packages/patches/elm-offline-package-registry.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/elm.scm (elm): Use it.
* guix/build-system/elm.scm, guix/build/elm-build-system.scm,
tests/elm.scm: New files.
* Makefile.scm (MODULES, SCM_TESTS): Add them.
* doc/guix.texi (Build Systems): Document 'elm-build-system'.
* doc/contributing.texi (Elm Packages): New section. Document naming
conventions and utilities.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Philip McGrath 2022-05-18 14:10:50 -04:00 committed by Ludovic Courtès
parent 0d480d4c62
commit aefcfdd0ae
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
9 changed files with 861 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile.am
View File

@ -141,6 +141,7 @@ MODULES = \
guix/build-system/cmake.scm \
guix/build-system/dub.scm \
guix/build-system/dune.scm \
guix/build-system/elm.scm \
guix/build-system/emacs.scm \
guix/build-system/font.scm \
guix/build-system/go.scm \
@ -192,6 +193,7 @@ MODULES = \
guix/build/cmake-build-system.scm \
guix/build/dub-build-system.scm \
guix/build/dune-build-system.scm \
guix/build/elm-build-system.scm \
guix/build/emacs-build-system.scm \
guix/build/meson-build-system.scm \
guix/build/minify-build-system.scm \
@ -472,6 +474,7 @@ SCM_TESTS = \
tests/derivations.scm \
tests/discovery.scm \
tests/egg.scm \
tests/elm.scm \
tests/elpa.scm \
tests/file-systems.scm \
tests/gem.scm \

82
doc/contributing.texi
View File

@ -447,6 +447,7 @@ needed is to review and apply the patch.
* Perl Modules:: Little pearls.
* Java Packages:: Coffee break.
* Rust Crates:: Beware of oxidation.
* Elm Packages:: Trees of browser code
* Fonts:: Fond of fonts.
@end menu
@ -898,6 +899,87 @@ developed for a different Operating System, depend on features from the Nightly
Rust compiler, or the test suite may have atrophied since it was released.
@node Elm Packages
@subsection Elm Packages
@cindex Elm
Elm applications can be named like other software: their names need not
mention Elm.
Packages in the Elm sense (see @code{elm-build-system} under @ref{Build
Systems}) are required use names of the format
@var{author}@code{/}@var{project}, where both the @var{author} and the
@var{project} may contain hyphens internally, and the @var{author} sometimes
contains uppercase letters.
To form the Guix package name from the upstream name, we follow a convention
similar to Python packages (@pxref{Python Modules}), adding an @code{elm-}
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
when explicitly specifying the upstream name is necessary are:
@enumerate
@item
When the @var{author} is @code{elm} and the @var{project} contains one or more
hyphens, as with @code{elm/virtual-dom}; and
@item
When the @var{author} contains hyphens or uppercase letters, as with
@code{Elm-Canvas/raster-shapes}---unless the @var{author} is
@code{elm-explorations}, which is handled as a special case, so packages like
@code{elm-explorations/markdown} do @emph{not} need to use the
@code{'upstream-name} property.
@end enumerate
The module @code{(guix build-system elm)} provides the following utilities for
working with names and related conventions:
@deffn {Scheme procedure} elm-package-origin @var{elm-name} @var{version} @
@var{hash}
Returns a Git origin using the repository naming and tagging regime required
for a published Elm package with the upstream name @var{elm-name} at version
@var{version} with sha256 checksum @var{hash}.
For example:
@lisp
(package
(name "elm-html")
(version "1.0.0")
(source
(elm-package-origin
"elm/html"
version
(base32 "15k1679ja57vvlpinpv06znmrxy09lbhzfkzdc89i01qa8c4gb4a")))
...)
@end lisp
@end deffn
@deffn {Scheme procedure} elm->package-name @var{elm-name}
Returns the Guix-style package name for an Elm package with upstream name
@var{elm-name}.
Note that there is more than one possible @var{elm-name} for which
@code{elm->package-name} will produce a given result.
@end deffn
@deffn {Scheme procedure} guix-package->elm-name @var{package}
Given an Elm @var{package}, returns the possibly-inferred upstream name, or
@code{#f} the upstream name is not specified via the @code{'upstream-name}
property and can not be inferred by @code{infer-elm-package-name}.
@end deffn
@deffn {Scheme procedure} infer-elm-package-name @var{guix-name}
Given the @var{guix-name} of an Elm package, returns the inferred upstream
name, or @code{#f} if the upstream name can't be inferred. If the result is
not @code{#f}, supplying it to @code{elm->package-name} would produce
@var{guix-name}.
@end deffn
@node Fonts
@subsection Fonts

52
doc/guix.texi
View File

@ -102,6 +102,7 @@ Copyright @copyright{} 2021 Sarah Morgensen@*
Copyright @copyright{} 2021 Josselin Poiret@*
Copyright @copyright{} 2022 Remco van 't Veer@*
Copyright @copyright{} 2022 Aleksandr Vityazev@*
Copyright @copyright{} 2022 Philip M@sup{c}Grath@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -8717,6 +8718,57 @@ only one of them. This is equivalent to passing the @code{-p} argument to
@end defvr
@defvr {Scheme variable} elm-build-system
This variable is exported by @code{(guix build-system elm)}. It implements a
build procedure for @url{https://elm-lang.org, Elm} packages similar to
@samp{elm install}.
The build system adds an Elm compiler package to the set of inputs. The
default compiler package (currently @code{elm}) can be overridden
using the @code{#:elm} argument. Additionally, Elm packages needed by the
build system itself are added as implicit inputs if they are not already
present: to suppress this behavior, use the
@code{#:implicit-elm-package-inputs?} argument, which is primarily useful for
bootstrapping.
The @code{"dependencies"} and @code{"test-dependencies"} in an Elm package's
@file{elm.json} file correspond to @code{propagated-inputs} and @code{inputs},
respectively.
Elm requires a particular structure for package names: @pxref{Elm Packages}
for more details, including utilities provided by @code{(guix build-system
elm)}.
There are currently a few noteworthy limitations to @code{elm-build-system}:
@itemize
@item
The build system is focused on @dfn{packages} in the Elm sense of the word:
Elm @dfn{projects} which declare @code{@{ "type": "package" @}} in their
@file{elm.json} files. Using @code{elm-build-system} to build Elm
@dfn{applications} (which declare @code{@{ "type": "application" @}}) is
possible, but requires ad-hoc modifications to the build phases.
@item
Elm supports multiple versions of a package coexisting simultaneously under
@env{ELM_HOME}, but this does not yet work well with @code{elm-build-system}.
This limitation primarily affects Elm applications, because they specify
exact versions for their dependencies, whereas Elm packages specify supported
version ranges. As a workaround, you can use
the @code{patch-application-dependencies} procedure provided by
@code{(guix build elm-build-system)} to rewrite their @file{elm.json} files to
refer to the package versions actually present in the build environment.
Alternatively, Guix package transformations (@pxref{Defining Package
Variants}) could be used to rewrite an application's entire dependency graph.
@item
We are not yet able to run tests for Elm projects because neither
@url{https://github.com/mpizenberg/elm-test-rs, @command{elm-test-rs}} nor the
Node.js-based @url{https://github.com/rtfeldman/node-test-runner,
@command{elm-test}} runner has been packaged for Guix yet.
@end itemize
@end defvr
@defvr {Scheme Variable} go-build-system
This variable is exported by @code{(guix build-system go)}. It
implements a build procedure for Go packages using the standard

1
gnu/local.mk
View File

@ -1024,6 +1024,7 @@ dist_patch_DATA = \
%D%/packages/patches/einstein-build.patch \
%D%/packages/patches/elfutils-tests-ptrace.patch \
%D%/packages/patches/elixir-path-length.patch \
%D%/packages/patches/elm-offline-package-registry.patch \
%D%/packages/patches/elm-reactor-static-files.patch \
%D%/packages/patches/elogind-revert-polkit-detection.patch \
%D%/packages/patches/emacs-exec-path.patch \

4
gnu/packages/elm.scm
View File

@ -25,6 +25,7 @@
#:use-module (gnu packages haskell-xyz)
#:use-module (gnu packages haskell-web)
#:use-module (guix build-system haskell)
#:use-module (guix build-system elm)
#:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
@ -53,7 +54,8 @@
(sha256
(base32 "1rdg3xp3js9xadclk3cdypkscm5wahgsfmm4ldcw3xswzhw6ri8w"))
(patches
(search-patches "elm-reactor-static-files.patch"))))
(search-patches "elm-reactor-static-files.patch"
"elm-offline-package-registry.patch"))))
(build-system haskell-build-system)
(arguments
(list

71
gnu/packages/patches/elm-offline-package-registry.patch Normal file
View File

@ -0,0 +1,71 @@
From 06563409e6f2b1cca7bc1b27e31efd07a7569da8 Mon Sep 17 00:00:00 2001
From: Philip McGrath <philip@philipmcgrath.com>
Date: Thu, 14 Apr 2022 22:41:04 -0400
Subject: [PATCH] minimal support for offline builds
Normally, Elm performs HTTP requests before building to obtain or
update its list of all registed packages and their versions.
This is problematic in the Guix build environment.
This patch causes Elm to check if the `GUIX_ELM_OFFLINE_REGISTRY_FILE`
is set and, if so, to use the contents of the file it specifies as
though it were the response from
https://package.elm-lang.org/all-packages.
This patch does not attempt to add more general support for offline
builds. In particular, it does not attempt to support incremental
updates to the package registry cache file. See also discussion at
https://discourse.elm-lang.org/t/private-package-tool-spec/6779/25.
---
builder/src/Deps/Registry.hs | 25 +++++++++++++++++++++----
1 file changed, 21 insertions(+), 4 deletions(-)
diff --git a/builder/src/Deps/Registry.hs b/builder/src/Deps/Registry.hs
index 8d7def98..70cf3622 100644
--- a/builder/src/Deps/Registry.hs
+++ b/builder/src/Deps/Registry.hs
@@ -18,6 +18,8 @@ import Control.Monad (liftM2)
import Data.Binary (Binary, get, put)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
+import System.Environment as Env
+import qualified Data.ByteString as BS
import qualified Deps.Website as Website
import qualified Elm.Package as Pkg
@@ -190,13 +192,28 @@ getVersions' name (Registry _ versions) =
post :: Http.Manager -> String -> D.Decoder x a -> (a -> IO b) -> IO (Either Exit.RegistryProblem b)
post manager path decoder callback =
let
- url = Website.route path []
- in
- Http.post manager url [] Exit.RP_Http $
- \body ->
+ mkBodyCallback url body =
case D.fromByteString decoder body of
Right a -> Right <$> callback a
Left _ -> return $ Left $ Exit.RP_Data url body
+ postOnline url cb =
+ Http.post manager url [] Exit.RP_Http cb
+ performPost f url =
+ f url (mkBodyCallback url)
+ in
+ do
+ maybeFile <- Env.lookupEnv "GUIX_ELM_OFFLINE_REGISTRY_FILE"
+ case (path, maybeFile) of
+ ( "/all-packages", Just file ) ->
+ performPost postOffline file
+ ( _, _ ) ->
+ -- don't know how to handle other endpoints yet
+ performPost postOnline (Website.route path [])
+
+postOffline :: String -> (BS.ByteString -> IO a) -> IO a
+postOffline file callback = do
+ body <- BS.readFile file
+ callback body
--
2.32.0

172
guix/build-system/elm.scm Normal file
View File

@ -0,0 +1,172 @@
;;; 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 build-system elm)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix git-download)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (elm->package-name
guix-package->elm-name
infer-elm-package-name
elm-package-origin
%elm-build-system-modules
%elm-default-modules
elm-build
elm-build-system))
(define (elm->package-name name)
"Given the NAME of an Elm package, return a Guix-style package name."
(let ((converted
(string-join (string-split (string-downcase name) #\/) "-")))
(if (string-prefix? "elm-" converted)
converted
(string-append "elm-" converted))))
(define (guix-package->elm-name package)
"Given an Elm PACKAGE, return the possibly-inferred upstream name, or #f the
upstream name is not specified and can't be inferred."
(or (assoc-ref (package-properties package) 'upstream-name)
(infer-elm-package-name (package-name package))))
(define (infer-elm-package-name guix-name)
"Given the GUIX-NAME of an Elm package, return the inferred upstream name,
or #f if it can't be inferred. If the result is not #f, supplying it to
'elm->package-name' would produce GUIX-NAME.
See also 'guix-package->elm-name', which respects the 'upstream-name'
property."
(define (parts-join part0 parts)
(string-join (cons part0 parts) "-"))
(match (string-split guix-name #\-)
(("elm" "explorations" part0 parts ...)
(string-append "elm-explorations/"
(parts-join part0 parts)))
(("elm" owner part0 parts ...)
(string-append owner "/" (parts-join part0 parts)))
(("elm" repo)
(string-append "elm/" repo))
(_
#f)))
(define (elm-package-origin elm-name version hash)
"Return an origin for the Elm package with upstream name ELM-NAME at the
given VERSION with sha256 checksum HASH."
;; elm requires this very specific repository structure and tagging regime
(origin
(method git-fetch)
(uri (git-reference
(url (string-append "https://github.com/" elm-name))
(commit version)))
(file-name (git-file-name (elm->package-name elm-name) version))
(sha256 hash)))
(define %elm-build-system-modules
;; Build-side modules imported by default.
`((guix build elm-build-system)
(guix build json)
(guix build union)
,@%gnu-build-system-modules))
(define %elm-default-modules
;; Modules in scope in the build-side environment.
'((guix build elm-build-system)
(guix build utils)
(guix build json)
(guix build union)))
(define (default-elm)
"Return the default Elm package for builds."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((elm (resolve-interface '(gnu packages elm))))
(module-ref elm 'elm)))
(define* (lower name
#:key source inputs native-inputs outputs system target
(implicit-elm-package-inputs? #t)
(elm (default-elm))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:target #:implicit-elm-package-inputs? #:elm #:inputs #:native-inputs))
(cond
(target
;; Cross-compilation is not yet supported. It should be easy, though,
;; since the build products are all platform-independent.
#f)
(else
(bag
(name name)
(system system)
(host-inputs
`(,@(if source
`(("source" ,source))
'())
,@inputs
("elm" ,elm)
;; TODO: probably don't need most of (standard-packages)
,@(standard-packages)))
(outputs outputs)
(build elm-build)
(arguments (strip-keyword-arguments private-keywords arguments))))))
(define* (elm-build name inputs
#:key
source
(tests? #t)
(phases '%standard-phases)
(outputs '("out"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %elm-build-system-modules)
(modules %elm-default-modules))
"Build SOURCE using ELM."
(define builder
(with-imported-modules imported-modules
#~(begin
(use-modules #$@(sexp->gexp modules))
(elm-build #:name #$name
#:source #+source
#:system #$system
#:tests? #$tests?
#:phases #$phases
#:outputs #$(outputs->gexp outputs)
#:search-paths '#$(sexp->gexp
(map search-path-specification->sexp
search-paths))
#:inputs #$(input-tuples->gexp inputs)))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define elm-build-system
(build-system
(name 'elm)
(description "The Elm build system")
(lower lower)))

380
guix/build/elm-build-system.scm Normal file
View File

@ -0,0 +1,380 @@
;;; 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 build elm-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build utils)
#:use-module (guix build json)
#:use-module (guix build union)
#:use-module (ice-9 ftw)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-71)
#:export (%standard-phases
patch-application-dependencies
patch-json-string-escapes
read-offline-registry->vhash
elm-build))
;;; Commentary:
;;;
;;; Elm draws a sharp distinction between "projects" with `{"type":"package"}`
;;; vs. `{"type":"application"}` in the "elm.json" file: see
;;; <https://github.com/elm/compiler/blob/master/docs/elm.json/package.md> and
;;; <https://github.com/elm/compiler/blob/master/docs/elm.json/application.md>.
;;; For now, `elm-build-system` is designed for "package"s: packaging
;;; "application"s requires ad-hoc replacements for some phases---but see
;;; `patch-application-dependencies`, which helps to work around a known issue
;;; discussed below. It would be nice to add more streamlined support for
;;; "application"s one we have more experience building them in Guix. For
;;; example, we could incorporate the `uglifyjs` advice from
;;; <https://github.com/elm/compiler/blob/master/hints/optimize.md>.
;;;
;;; We want building an Elm "package" to produce:
;;;
;;; - a "docs.json" file with extracted documentation; and
;;;
;;; - an "artifacts.dat" file with compilation results for use in building
;;; "package"s and "application"s.
;;;
;;; Unfortunately, there isn't an entry point to the Elm compiler that builds
;;; those files directly. Building with `elm make` does something different,
;;; more oriented toward development, testing, and building "application"s.
;;; We work around this limitation by staging the "package" we're building as
;;; though it were already installed in ELM_HOME, generating a trivial Elm
;;; "application" that depends on the "package", and building the
;;; "application", which causes the files for the "package" to be built.
;;;
;;; Much of the ceremony involved is to avoid using `elm` in ways that would
;;; make it try to do network IO beyond the bare minimum functionality for
;;; which we've patched a replacement into our `elm`. On the other hand, we
;;; get to take advantage of the very regular structure required of Elm
;;; packages.
;;;
;;; *Known issue:* Elm itself supports multiple versions of "package"s
;;; coexisting simultaneously under ELM_HOME, but we do not support this yet.
;;; Sometimes, parallel versions coexisting causes `elm` to try to write to
;;; built "artifacts.dat" files. For now, two workarounds are possible:
;;;
;;; - Use `patch-application-dependencies` to rewrite an "application"'s
;;; "elm.json" file to refer to the versions of its inputs actually
;;; packaged in Guix.
;;;
;;; - Use a Guix package transformation to rewrite your "application"'s
;;; dependencies recursively, so that only one version of each Elm
;;; "package" is included in your "application"'s build environment.
;;;
;;; Patching `elm` more extensively---perhaps adding an `elm guix`
;;; subcommand`---might let us address these issues more directly.
;;;
;;; Code:
;;;
(define %essential-elm-packages
;; elm/json isn't essential in a fundamental sense,
;; but it's required for a {"type":"application"},
;; which we are generating to trigger the build
'("elm/core" "elm/json"))
(define* (target-elm-version #:optional elm)
"Return the version of ELM or whichever 'elm' is in $PATH.
Return #false if it cannot be determined."
(let* ((pipe (open-pipe* OPEN_READ
(or elm "elm")
"--version"))
(line (read-line pipe)))
(and (zero? (close-pipe pipe))
(string? line)
line)))
(define* (prepare-elm-home #:key native-inputs inputs #:allow-other-keys)
"Set the ELM_HOME environment variable and populate the indicated directory
with the union of the Elm \"package\" inputs. Also, set GUIX_ELM_VERSION to
the version of the Elm compiler in use."
(let* ((elm (search-input-file (or native-inputs inputs) "/bin/elm"))
(elm-version (target-elm-version elm)))
(setenv "GUIX_ELM_VERSION" elm-version)
(mkdir "../elm-home")
(with-directory-excursion "../elm-home"
(union-build elm-version
(search-path-as-list
(list (string-append "share/elm/" elm-version))
(map cdr inputs))
#:create-all-directories? #t)
(setenv "ELM_HOME" (getcwd)))))
(define* (stage #:key native-inputs inputs #:allow-other-keys)
"Extract the installable files from the Elm \"package\" into a staging
directory and link it into the ELM_HOME tree. Also, set GUIX_ELM_PKG_NAME and
GUIX_ELM_PKG_VERSION to the name and version, respectively, of the Elm package
being built, as defined in its \"elm.json\" file."
(let* ((elm-version (getenv "GUIX_ELM_VERSION"))
(elm-home (getenv "ELM_HOME"))
(info (match (call-with-input-file "elm.json" read-json)
(('@ . alist) alist)))
(name (assoc-ref info "name"))
(version (assoc-ref info "version"))
(rel-dir (string-append elm-version "/packages/" name "/" version))
(staged-dir (string-append elm-home "/../staged/" rel-dir)))
(setenv "GUIX_ELM_PKG_NAME" name)
(setenv "GUIX_ELM_PKG_VERSION" version)
(mkdir-p staged-dir)
(mkdir-p (string-append elm-home "/" (dirname rel-dir)))
(symlink staged-dir
(string-append elm-home "/" rel-dir))
(copy-recursively "src" (string-append staged-dir "/src"))
(install-file "elm.json" staged-dir)
(install-file "README.md" staged-dir)
(when (file-exists? "LICENSE")
(install-file "LICENSE" staged-dir))))
(define (patch-json-string-escapes file)
"Work around a bug in the Elm compiler's JSON parser by attempting to
replace REVERSE-SOLIDUS--SOLIDUS escape sequences in FILE with unescaped
SOLIDUS characters."
;; https://github.com/elm/compiler/issues/2255
(substitute* file
(("\\\\/")
"/")))
(define (directory-list dir)
"Like DIRECTORY-LIST from 'racket/base': lists the contents of DIR, not
including the special \".\" and \"..\" entries."
(scandir dir (lambda (f)
(not (member f '("." ".."))))))
(define* (make-offline-registry-file #:key inputs #:allow-other-keys)
"Generate an \"offline-package-registry.json\" file and set
GUIX_ELM_OFFLINE_REGISTRY_FILE to its path, cooperating with a patch to `elm`
to avoid attempting to download a list of all published Elm package names and
versions from the internet."
(let* ((elm-home (getenv "ELM_HOME"))
(elm-version (getenv "GUIX_ELM_VERSION"))
(registry-file
(string-append elm-home "/../offline-package-registry.json"))
(registry-alist
;; here, we don't need to look up entries, so we build the
;; alist directly, rather than using a vhash
(with-directory-excursion
(string-append elm-home "/" elm-version "/packages")
(append-map (lambda (org)
(with-directory-excursion org
(map (lambda (repo)
(cons (string-append org "/" repo)
(directory-list repo)))
(directory-list "."))))
(directory-list ".")))))
(call-with-output-file registry-file
(lambda (out)
(write-json `(@ ,@registry-alist) out)))
(patch-json-string-escapes registry-file)
(setenv "GUIX_ELM_OFFLINE_REGISTRY_FILE" registry-file)))
(define (read-offline-registry->vhash)
"Return a vhash mapping Elm \"package\" names to lists of available version
strings."
(alist->vhash
(match (call-with-input-file (getenv "GUIX_ELM_OFFLINE_REGISTRY_FILE")
read-json)
(('@ . alist) alist))))
(define (find-indirect-dependencies registry-vhash root-pkg root-version)
"Return the recursive dependencies of ROOT-PKG, an Elm \"package\" name, at
version ROOT-VERSION as an alist mapping Elm \"package\" names to (single)
versions. The resulting alist will not include entries for
%ESSENTIAL-ELM-PACKAGES or for ROOT-PKG itself. The REGISTRY-VHASH is used in
conjunction with the ELM_HOME environment variable to find dependencies."
(with-directory-excursion
(string-append (getenv "ELM_HOME")
"/" (getenv "GUIX_ELM_VERSION")
"/packages")
(define (get-dependencies pkg version acc)
(let* ((elm-json-alist
(match (call-with-input-file
(string-append pkg "/" version "/elm.json")
read-json)
(('@ . alist) alist)))
(deps-alist
(match (assoc-ref elm-json-alist "dependencies")
(('@ . alist) alist)))
(deps-names
(filter-map (match-lambda
((name . range)
(and (not (member name %essential-elm-packages))
name)))
deps-alist)))
(fold register-dependency acc deps-names)))
(define (register-dependency pkg acc)
;; Using vhash-cons unconditionally would add duplicate entries,
;; which would then cause problems when we must emit JSON.
;; Plus, we can avoid needlessly duplicating work.
(if (vhash-assoc pkg acc)
acc
(match (vhash-assoc pkg registry-vhash)
((_ version . _)
;; in the rare case that multiple versions are present,
;; just picking an arbitrary one seems to work well enough for now
(get-dependencies pkg version (vhash-cons pkg version acc))))))
(vlist->list
(get-dependencies root-pkg root-version vlist-null))))
(define* (patch-application-dependencies #:key inputs #:allow-other-keys)
"Rewrites the \"elm.json\" file in the working directory---which must be of
`\"type\":\"application\"`, not `\"type\":\"package\"`---to refer to the
dependency versions actually provided via Guix. The
GUIX_ELM_OFFLINE_REGISTRY_FILE environment variable is used to find available
versions."
(let* ((registry-vhash (read-offline-registry->vhash))
(rewrite-dep-version
(match-lambda
((name . _)
(cons name (match (vhash-assoc name registry-vhash)
((_ version) ;; no dot
version))))))
(rewrite-direct/indirect
(match-lambda
;; a little checking to avoid confusing misuse with "package"
;; project dependencies, which have a different shape
(((and key (or "direct" "indirect"))
'@ . alist)
`(,key @ ,@(map rewrite-dep-version alist)))))
(rewrite-json-section
(match-lambda
(((and key (or "dependencies" "test-dependencies"))
'@ . alist)
`(,key @ ,@(map rewrite-direct/indirect alist)))
((k . v)
(cons k v))))
(rewrite-elm-json
(match-lambda
(('@ . alist)
`(@ ,@(map rewrite-json-section alist))))))
(with-atomic-file-replacement "elm.json"
(lambda (in out)
(write-json (rewrite-elm-json (read-json in))
out)))
(patch-json-string-escapes "elm.json")))
(define* (configure #:key native-inputs inputs #:allow-other-keys)
"Generate a trivial Elm \"application\" with a direct dependency on the Elm
\"package\" currently being built."
(let* ((info (match (call-with-input-file "elm.json" read-json)
(('@ . alist) alist)))
(name (getenv "GUIX_ELM_PKG_NAME"))
(version (getenv "GUIX_ELM_PKG_VERSION"))
(elm-home (getenv "ELM_HOME"))
(registry-vhash (read-offline-registry->vhash))
(app-dir (string-append elm-home "/../fake-app")))
(mkdir-p (string-append app-dir "/src"))
(with-directory-excursion app-dir
(call-with-output-file "elm.json"
(lambda (out)
(write-json
`(@ ("type" . "application")
("source-directories" "src") ;; intentionally no dot
("elm-version" . ,(getenv "GUIX_ELM_VERSION"))
("dependencies"
@ ("direct"
@ ,@(map (lambda (pkg)
(match (vhash-assoc pkg registry-vhash)
((_ pkg-version . _)
(cons pkg
(if (equal? pkg name)
version
pkg-version)))))
(if (member name %essential-elm-packages)
%essential-elm-packages
(cons name %essential-elm-packages))))
("indirect"
@ ,@(if (member name %essential-elm-packages)
'()
(find-indirect-dependencies registry-vhash
name
version))))
("test-dependencies"
@ ("direct" @)
("indirect" @)))
out)))
(patch-json-string-escapes "elm.json")
(with-output-to-file "src/Main.elm"
;; the most trivial possible elm program
(lambda ()
(display "module Main exposing (..)
main : Program () () ()
main = Platform.worker
{ init = \\_ -> ( (), Cmd.none )
, update = \\_ -> \\_ -> ( (), Cmd.none )
, subscriptions = \\_ -> Sub.none }"))))))
(define* (build #:key native-inputs inputs #:allow-other-keys)
"Run `elm make` to build the Elm \"application\" generated by CONFIGURE."
(with-directory-excursion (string-append (getenv "ELM_HOME") "/../fake-app")
(invoke (search-input-file (or native-inputs inputs) "/bin/elm")
"make"
"src/Main.elm")))
(define* (check #:key tests? #:allow-other-keys)
"Does nothing, because the `elm-test` executable has not yet been packaged
for Guix."
(when tests?
(display "elm-test has not yet been packaged for Guix\n")))
(define* (install #:key outputs #:allow-other-keys)
"Installs the contents of the directory generated by STAGE, including any
files added by BUILD, to the Guix package output."
(copy-recursively
(string-append (getenv "ELM_HOME") "/../staged")
(string-append (assoc-ref outputs "out") "/share/elm")))
(define* (validate-compiled #:key outputs #:allow-other-keys)
"Checks that the files \"artifacts.dat\" and \"docs.json\" have been
installed."
(let ((base (string-append "/share/elm/"
(getenv "GUIX_ELM_VERSION")
"/packages/"
(getenv "GUIX_ELM_PKG_NAME")
"/"
(getenv "GUIX_ELM_PKG_VERSION")))
(expected '("artifacts.dat" "docs.json")))
(for-each (lambda (name)
(search-input-file outputs (string-append base "/" name)))
expected)))
(define %standard-phases
(modify-phases gnu:%standard-phases
(add-after 'unpack 'prepare-elm-home prepare-elm-home)
(delete 'bootstrap)
(add-after 'patch-source-shebangs 'stage stage)
(add-after 'stage 'make-offline-registry-file make-offline-registry-file)
(replace 'configure configure)
(delete 'patch-generated-file-shebangs)
(replace 'build build)
(replace 'check check)
(replace 'install install)
(add-before 'validate-documentation-location 'validate-compiled
validate-compiled)))
(define* (elm-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Builds the given Elm project, applying all of the PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))

97
tests/elm.scm Normal file
View File

@ -0,0 +1,97 @@
;;; 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 (test-elm)
#:use-module (guix build-system elm)
#:use-module (srfi srfi-64))
(test-begin "elm")
(test-group "elm->package-name and infer-elm-package-name"
(test-group "round trip"
;; Cases when our heuristics can find the upstream name.
(define-syntax-rule (test-round-trip elm guix)
(test-group elm
(test-equal "elm->package-name" guix
(elm->package-name elm))
(test-equal "infer-elm-package-name" elm
(infer-elm-package-name guix))))
(test-round-trip "elm/core" "elm-core")
(test-round-trip "elm/html" "elm-html")
(test-round-trip "elm-explorations/markdown" "elm-explorations-markdown")
(test-round-trip "elm-explorations/test" "elm-explorations-test")
(test-round-trip "elm-explorations/foo-bar" "elm-explorations-foo-bar")
(test-round-trip "elm/explorations" "elm-explorations")
(test-round-trip "terezka/intervals" "elm-terezka-intervals")
(test-round-trip "justinmimbs/time-extra" "elm-justinmimbs-time-extra")
(test-round-trip "danhandrea/elm-date-format"
"elm-danhandrea-elm-date-format"))
(test-group "upstream-name needed"
;; Upstream names that our heuristic can't infer. We still check that the
;; round-trip behavior of 'infer-elm-package-name' works as promised for
;; the hypothetical Elm name it doesn't infer.
(define-syntax-rule (test-upstream-needed elm guix inferred)
(test-group elm
(test-equal "elm->package-name" guix
(elm->package-name elm))
(test-group "infer-elm-package-name"
(test-equal "infers other name" inferred
(infer-elm-package-name guix))
(test-equal "infered name round-trips" guix
(elm->package-name inferred)))))
(test-upstream-needed "elm/virtual-dom"
"elm-virtual-dom"
"virtual/dom")
(test-upstream-needed "elm/project-metadata-utils"
"elm-project-metadata-utils"
"project/metadata-utils")
(test-upstream-needed "explorations/foo"
"elm-explorations-foo"
"elm-explorations/foo")
(test-upstream-needed "explorations/foo-bar"
"elm-explorations-foo-bar"
"elm-explorations/foo-bar")
(test-upstream-needed "explorations-central/foo"
"elm-explorations-central-foo"
"elm-explorations/central-foo")
(test-upstream-needed "explorations-central/foo-bar"
"elm-explorations-central-foo-bar"
"elm-explorations/central-foo-bar")
(test-upstream-needed "elm-xyz/foo"
"elm-xyz-foo"
"xyz/foo")
(test-upstream-needed "elm-xyz/foo-bar"
"elm-xyz-foo-bar"
"xyz/foo-bar")
(test-upstream-needed "elm-explorations-xyz/foo"
"elm-explorations-xyz-foo"
"elm-explorations/xyz-foo")
(test-upstream-needed "elm-explorations-xyz/foo-bar"
"elm-explorations-xyz-foo-bar"
"elm-explorations/xyz-foo-bar"))
(test-group "no inferred Elm name"
;; Cases that 'infer-elm-package-name' should not attempt to handle,
;; because 'elm->package-name' would never produce such names.
(define-syntax-rule (test-not-inferred guix)
(test-assert guix (not (infer-elm-package-name guix))))
(test-not-inferred "elm")
(test-not-inferred "guile")
(test-not-inferred "gcc-toolchain")
(test-not-inferred "font-adobe-source-sans-pro")))
(test-end "elm")