[bug#55030] [PATCH v2 03/34] guix: Add elm-build-system.

[Philip McGrath <philip@philipmcgrath.com>]

* 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.
---
 Makefile.am                                   |   3 +
 doc/contributing.texi                         |  82 ++++
 doc/guix.texi                                 |  52 +++
 gnu/local.mk                                  |   1 +
 gnu/packages/elm.scm                          |   4 +-
 .../elm-offline-package-registry.patch        |  71 ++++
 guix/build-system/elm.scm                     | 172 ++++++++
 guix/build/elm-build-system.scm               | 380 ++++++++++++++++++
 tests/elm.scm                                 |  97 +++++
 9 files changed, 861 insertions(+), 1 deletion(-)
 create mode 100644 gnu/packages/patches/elm-offline-package-registry.patch
 create mode 100644 guix/build-system/elm.scm
 create mode 100644 guix/build/elm-build-system.scm
 create mode 100644 tests/elm.scm

diff --git a/Makefile.am b/Makefile.am
index 85a22be99c..9ca92c407c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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				\
diff --git a/doc/contributing.texi b/doc/contributing.texi
index 862dcbf12a..555b9bb961 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -447,6 +447,7 @@ Packaging Guidelines
 * 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 @@ Rust Crates
 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
 
diff --git a/doc/guix.texi b/doc/guix.texi
index c007c93dd3..63fb647045 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -102,6 +102,7 @@
 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 @@ Build Systems
 
 @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
diff --git a/gnu/local.mk b/gnu/local.mk
index de044bdbff..94590ab5b5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -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			\
diff --git a/gnu/packages/elm.scm b/gnu/packages/elm.scm
index a3863e6e6f..35bdcc65f5 100644
--- a/gnu/packages/elm.scm
+++ b/gnu/packages/elm.scm
@@ -25,6 +25,7 @@ (define-module (gnu packages elm)
   #: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 @@ (define-public elm
        (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
diff --git a/gnu/packages/patches/elm-offline-package-registry.patch b/gnu/packages/patches/elm-offline-package-registry.patch
new file mode 100644
index 0000000000..761ec69878
--- /dev/null
+++ b/gnu/packages/patches/elm-offline-package-registry.patch
@@ -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
+
diff --git a/guix/build-system/elm.scm b/guix/build-system/elm.scm
new file mode 100644
index 0000000000..b54954bf4e
--- /dev/null
+++ b/guix/build-system/elm.scm
@@ -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)))
diff --git a/guix/build/elm-build-system.scm b/guix/build/elm-build-system.scm
new file mode 100644
index 0000000000..02d7c029dd
--- /dev/null
+++ b/guix/build/elm-build-system.scm
@@ -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))
diff --git a/tests/elm.scm b/tests/elm.scm
new file mode 100644
index 0000000000..96f958f060
--- /dev/null
+++ b/tests/elm.scm
@@ -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")
-- 
2.32.0