[bug#66801] [PATCH v3 01/14] build-system: Add mix-build-system.

[Pierre-Henry Fröhring]

* guix/build-system/mix.scm,
* guix/build/mix-build-system.scm: New modules.

Change-Id: I2cbf6c963a530e73420da0eb17ffaf92827451bf
---
 guix/build-system/mix.scm       | 181 ++++++++++++++++++++++++++++
 guix/build/mix-build-system.scm | 205 ++++++++++++++++++++++++++++++++
 2 files changed, 386 insertions(+)
 create mode 100644 guix/build-system/mix.scm
 create mode 100644 guix/build/mix-build-system.scm

diff --git a/guix/build-system/mix.scm b/guix/build-system/mix.scm
new file mode 100644
index 00000000..ae80679b
--- /dev/null
+++ b/guix/build-system/mix.scm
@@ -0,0 +1,181 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.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/>.
+
+;; Commentary:
+;;
+;; Standard build procedure for Elixir packages using 'mix'.  This is
+;; implemented as an extension of 'gnu-build-system'.
+;;
+;; Code:
+
+(define-module (guix build-system mix)
+  #:use-module (guix build mix-build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix search-paths)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (mix-build-system hexpm-uri))
+
+;; Lazily resolve the bindings to avoid circular dependencies.
+(define (default-glibc-utf8-locales)
+  (let* ((base (resolve-interface '(gnu packages base))))
+    (module-ref base 'glibc-utf8-locales)))
+
+(define (default-elixir-hex)
+  (let ((elixir (resolve-interface '(gnu packages elixir))))
+    (module-ref elixir 'elixir-hex)))
+
+(define (default-rebar3)
+  (let ((erlang (resolve-interface '(gnu packages erlang))))
+    (module-ref erlang 'rebar3)))
+
+(define (default-elixir)
+  "Return the default Elixir package."
+  (let ((elixir (resolve-interface '(gnu packages elixir))))
+    (module-ref elixir 'elixir)))
+
+(define (hexpm-uri name version)
+  "Return the URI where to fetch the sources of a Hex package NAME at VERSION.
+NAME is the name of the package which should look like: elixir-pkg-name-X.Y.Z
+See: https://github.com/hexpm/specifications/blob/main/endpoints.md";
+  ((compose
+    (cut string-append "https://repo.hex.pm/tarballs/"; <> "-" version ".tar")
+    (cut string-replace-substring <> "-" "_")
+    strip-elixir-prefix)
+   name))
+
+;; A number of environment variables specific to the Mix build system are
+;; reflected here.  They are documented at
+;; https://hexdocs.pm/mix/1.15.7/Mix.html#module-environment-variables.  Other
+;; parameters located in mix.exs are defined at
+;; https://hexdocs.pm/mix/1.15.7/Mix.Project.html#module-configuration
+(define* (mix-build name
+                    inputs
+                    #:key
+                    source
+                    (tests? #t)
+                    (mix-path #f) ;See MIX_PATH.
+                    (mix-exs "mix.exs") ;See MIX_EXS.
+                    (build-per-environment #t) ;See :build_per_environment.
+                    (phases '%standard-phases)
+                    (outputs '("out"))
+                    (search-paths '())
+                    (system (%current-system))
+                    (guile #f)
+                    (imported-modules `((guix build mix-build-system)
+                                        ,@%gnu-build-system-modules))
+                    (modules '((guix build mix-build-system)
+                               (guix build utils))))
+  "Build SOURCE using Elixir, and with INPUTS."
+
+  ;; Check the documentation of :build_per_environment here:
+  ;; https://hexdocs.pm/mix/1.15.7/Mix.Project.html#module-configuration And
+  ;; "Environments" here:
+  ;; https://hexdocs.pm/mix/1.15.7/Mix.html#module-environments
+  (define mix-environments
+    (if build-per-environment
+        `("prod" ,@(if tests? '("test") '()))
+        '("shared")))
+
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+
+          (use-modules #$@(sexp->gexp modules))
+
+          #$(with-build-variables inputs outputs
+              #~(mix-build #:name #$name
+                           #:source #+source
+                           #:system #$system
+                           #:tests? #$tests?
+                           #:mix-path #$mix-path
+                           #:mix-exs #$mix-exs
+                           #:mix-environments '#$mix-environments
+                           #:build-per-environment #$build-per-environment
+                           #:phases #$(if (pair? phases)
+                                          (sexp->gexp phases)
+                                          phases)
+                           #:outputs %outputs
+                           #:search-paths '#$(sexp->gexp
+                                              (map
+                                               search-path-specification->sexp
+                                               search-paths))
+                           #:inputs
+                           %build-inputs)))))
+
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system
+                                                  #:graft? #f)))
+    (gexp->derivation name
+                      builder
+                      #:system system
+                      #:graft? #f       ;consistent with 'gnu-build'
+                      #:target #f
+                      #:guile-for-build guile)))
+
+(define* (lower name
+                #:key
+                (elixir (default-elixir))
+                (elixir-hex (default-elixir-hex))
+                (glibc-utf8-locales (default-glibc-utf8-locales))
+                (inputs '())
+                (native-inputs '())
+                (propagated-inputs '())
+                (rebar3 (default-rebar3))
+                (tests? #t)
+                outputs
+                source
+                system
+                target
+                #:allow-other-keys #:rest arguments)
+  "Return a bag for NAME."
+  (let ((private-keywords
+         '(#:inputs #:native-inputs
+           #:outputs #:system #:target
+           #:elixir #:elixir-hex #:glibc-utf8-locales
+           #:rebar3 #:erlang))
+        (build-inputs
+         `(,@(standard-packages)
+           ("glibc-utf8-locales" ,glibc-utf8-locales)
+           ("erlang" ,(lookup-package-input elixir "erlang"))
+           ("rebar3" ,rebar3)
+           ("elixir" ,elixir)
+           ("elixir-hex" ,elixir-hex)
+           ,@inputs
+           ,@native-inputs)))
+  (bag (name name)
+       (system system)
+       (build-inputs build-inputs)
+       (host-inputs (if target inputs '()))
+       (outputs outputs)
+       (build mix-build)
+       (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define mix-build-system
+  (build-system (name 'mix)
+                (description "The standard Mix build system")
+                (lower lower)))
+
+;;; mix.scm ends here
diff --git a/guix/build/mix-build-system.scm b/guix/build/mix-build-system.scm
new file mode 100644
index 00000000..0a1fcb5c
--- /dev/null
+++ b/guix/build/mix-build-system.scm
@@ -0,0 +1,205 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.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/>.
+
+;; Commentary:
+;;
+;; Code:
+
+(define-module (guix build mix-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 string-fun)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (mix-build
+            strip-elixir-prefix
+            %standard-phases))
+
+(define (elixir-version elixir)
+  "Return an X.Y string where X and Y are respectively the major and minor 
version number of ELIXIR.
+Example: /gnu/store/…-elixir-1.14.0 → 1.14"
+  ((compose
+    (cut string-join <> ".")
+    (cut take <> 2)
+    (cut string-split <> #\.)
+    last)
+   (string-split elixir #\-)))
+
+(define (elixir-libdir elixir path)
+  "Return the path where all libraries for a specified ELIXIR version are 
installed."
+  (string-append path "/lib/elixir/" (elixir-version elixir)))
+
+(define (erlang-libdir path)
+  "Return the path of the directory where libraries of an Erlang package are
+installed in the store."
+  (string-append path "/lib/erlang/lib"))
+
+(define (install-dir inputs outputs)
+  "Return the path of the current output's Elixir library.
+Example: /gnu/store/…/lib/elixir/1.14"
+  (elixir-libdir (assoc-ref inputs "elixir")
+                 (assoc-ref outputs "out")))
+
+(define (strip-prefix prefix name)
+  "Return NAME without the prefix PREFIX."
+  (if (string-prefix? prefix name)
+      (string-drop name (string-length prefix))
+      name))
+
+(define (strip-elixir-prefix name)
+  "Strip elixir- from NAME."
+  (strip-prefix "elixir-" name))
+
+(define (mix-build-dir mix-env)
+  "Return the directory where build artifacts are to be installed according to
+en environment MIX-ENV in the current directory."
+  (string-append "_build/" mix-env "/lib"))
+
+(define* (unpack #:key source mix-path #:allow-other-keys)
+  "Unpack SOURCE in the working directory, and change directory within the
+source.  When SOURCE is a directory, copy it in a sub-directory of the current
+working directory."
+  (let ((gnu-unpack (assoc-ref gnu:%standard-phases 'unpack)))
+    (gnu-unpack #:source source)
+    (when (file-exists? "contents.tar.gz")
+      (invoke "tar" "xvf" "contents.tar.gz"))))
+
+(define (list-directories dir)
+  "List absolute paths of directories directly under the directory DIR."
+  (map (cut string-append dir "/" <>)
+       (scandir dir (lambda (filename)
+                      (and (not (member filename '("." "..")))
+                           (directory-exists? (string-append dir "/" 
filename)))))))
+
+(define* (configure #:key inputs mix-path mix-exs #:allow-other-keys)
+  "Set environment variables.
+See: https://hexdocs.pm/mix/1.15.7/Mix.html#module-environment-variables";
+  (setenv "LC_ALL" "en_US.UTF-8")
+  (setenv "MIX_HOME" (getcwd))
+  (setenv "MIX_ARCHIVES" "archives")
+  (setenv "MIX_BUILD_ROOT" "_build")
+  (setenv "MIX_DEPS_PATH" "deps")
+  (setenv "MIX_PATH" (or mix-path ""))
+  (setenv "MIX_REBAR3" (string-append (assoc-ref inputs "rebar3") 
"/bin/rebar3"))
+  (setenv "MIX_EXS" mix-exs))
+
+(define* (install-hex #:key name inputs outputs #:allow-other-keys)
+  "Install Hex."
+  (let ((hex-archive-path (string-append (getenv "MIX_ARCHIVES") "/hex")))
+    (mkdir-p hex-archive-path)
+    (symlink (car (list-directories (elixir-libdir (assoc-ref inputs "elixir")
+                                                   (assoc-ref inputs 
"elixir-hex"))))
+             (string-append hex-archive-path "/hex"))))
+
+(define* (install-dependencies #:key
+                               name
+                               inputs
+                               outputs
+                               tests?
+                               build-per-environment
+                               (native-inputs '())
+                               mix-environments
+                               #:allow-other-keys
+                               #:rest rest)
+  "Install dependencies."
+  (define (install-lib lib dir)
+    (let ((lib-name (last (string-split lib #\/))))
+      (symlink lib (string-append dir "/" lib-name))))
+
+  (define (install-input mix-env input)
+    (let ((dir (mix-build-dir mix-env)))
+      (mkdir-p dir)
+      (match input
+        ((_ . path)
+         ((compose
+           (cut for-each (cut install-lib <> dir) <>)
+           (cut append-map list-directories <>)
+           (cut filter directory-exists? <>))
+          (list (elixir-libdir (assoc-ref inputs "elixir") path)
+                (erlang-libdir path)))))))
+
+  (define (install-inputs mix-env)
+    (for-each (cut install-input mix-env <>)
+              (append inputs native-inputs)))
+
+  (for-each install-inputs mix-environments))
+
+(define* (build #:key mix-environments #:allow-other-keys)
+  "Builds the Mix project."
+  (for-each (lambda (mix-env)
+              (setenv "MIX_ENV" mix-env)
+              (invoke "mix" "compile" "--no-deps-check"))
+            mix-environments))
+
+(define* (check #:key (tests? #t) #:allow-other-keys)
+  "Test the Mix project."
+  (if tests?
+      (invoke "mix" "test" "--no-deps-check")
+      (format #t "tests? = ~a~%" tests?)))
+
+(define* (remove-mix-dirs . _)
+  "Remove all .mix/ directories.
+We do not want to copy them to the installation directory."
+  (for-each delete-file-recursively
+            (find-files "." (file-name-predicate "\\.mix$") #:directories? 
#t)))
+
+(define (library-name pkg-name)
+  "Return the library name deduced from PKG-NAME.
+A package should be named: elixir-lib-name-X.Y.Z from which the library name
+lib_name is deduced."
+  ((compose
+    (cut string-join <> "_")
+    (cut drop-right <> 1)
+    (cut string-split <> #\-))
+   (strip-elixir-prefix pkg-name)))
+
+(define* (install #:key
+                  inputs
+                  outputs
+                  name
+                  build-per-environment
+                  #:allow-other-keys)
+  "Install build artifacts in the store."
+  (let* ((lib-name (library-name name))
+         (lib-dir (string-append (install-dir inputs outputs) "/" lib-name)))
+    (mkdir-p lib-dir)
+    (copy-recursively (string-append (mix-build-dir (if build-per-environment 
"prod" "shared")) "/" lib-name)
+                      lib-dir
+                      #:follow-symlinks? #t)))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (delete 'bootstrap)
+    (replace 'configure configure)
+    (replace 'unpack unpack)
+    (add-after 'patch-generated-file-shebangs 'install-hex install-hex)
+    (add-after 'install-hex 'install-dependencies install-dependencies)
+    (replace 'build build)
+    (replace 'check check)
+    (add-before 'install 'remove-mix-dirs remove-mix-dirs)
+    (replace 'install install)))
+
+(define* (mix-build #:key inputs (phases %standard-phases)
+                    #:allow-other-keys #:rest args)
+  "Build the given Mix package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; mix-build-system.scm ends here

base-commit: a0d337e79c87d7c38c79d0291974f490cb137a52
-- 
2.41.0