@@ -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 \
@@ -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:)
@@ -37,6 +38,8 @@ (define-module (gnu packages elm)
;; also want to be able to enable it once we can build it. We patch Elm to
;; instead look for the files on disk relative to the executable and to have
;; `elm reactor` exit with a useful error message if they aren't there.
+(define %reactor-root-base
+ "share/elm/reactor-")
(define-public elm
(package
(name "elm")
@@ -51,13 +54,14 @@ (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
#:configure-flags
#~(list (string-append "--ghc-option=-DGUIX_REACTOR_STATIC_REL_ROOT="
- "\"../share/elm/reactor-"
+ "\"../" #$%reactor-root-base
#$(package-version this-package)
"\""))
#:phases
new file mode 100644
@@ -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
+
new file mode 100644
@@ -0,0 +1,144 @@
+;;; 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
+ 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 (elm-package-origin name version hash)
+ "Return an origin for the Elm package 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/" name))
+ (commit version)))
+ (file-name (git-file-name (elm->package-name 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)))
new file mode 100644
@@ -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 sets
+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))
new file mode 100644
@@ -0,0 +1,148 @@
+;;; 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 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->guix-package))
+
+(define elm-package-registry
+ ;; It is much nicer to fetch this small (< 40 KB gzipped)
+ ;; file once than to do many HTTP requests.
+ (mlambda ()
+ "Fetch the Elm package registry, represented as a vhash mapping package
+names to lists of available versions, sorted from latest to oldest."
+ (let ((url "https://package.elm-lang.org/all-packages"))
+ (cond
+ ((json-fetch url)
+ => (lambda (alist)
+ (fold (lambda (entry vh)
+ (match entry
+ ((name . vec)
+ (vhash-cons name
+ (sort (vector->list vec) version>?)
+ vh))))
+ vlist-null
+ alist)))
+ (else
+ (raise (formatted-message
+ (G_ "error downloading Elm package registry from ~a")
+ url)))))))
+
+(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-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)))
+ (define info
+ (call-with-input-file (string-append checkout "/elm.json")
+ json->scm))
+ (define (get-deps key)
+ (cond
+ ((assoc-ref info key)
+ => (cut map car <>))
+ (else
+ '())))
+ (define dependencies
+ (get-deps "dependencies"))
+ (define test-dependencies
+ (get-deps "test-dependencies"))
+ (values
+ `(package
+ (name ,(elm->package-name 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 ,(assoc-ref info "summary"))
+ (description
+ ;; Try to use the first paragraph of README.md (which Elm requires),
+ ;; or fall back to summary otherwise.
+ ,(beautify-description
+ (match (chunk-lines (call-with-input-file
+ (string-append checkout "/README.md")
+ read-lines))
+ ((_ par . _)
+ (string-join par " "))
+ (_
+ (assoc-ref info "summary")))))
+ (license ,(spdx-string->license (assoc-ref info "license")))
+ ;; so we know where the "/" goes
+ (properties '((upstream-name . ,name))))
+ (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 (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))
@@ -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 @@ (define %standard-import-options '())
(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
new file mode 100644
@@ -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~%"))))))