diff mbox series

[bug#66801,va3e5ae0f..37252e07,01/32] rebar-build-system and packages.

Message ID a3e5ae0f3235df996b4be479f107680ae769a3c4.1698590244.git.phfrohring@deeplinks.com
State New
Headers show
Series [bug#66801,va3e5ae0f..37252e07,01/32] rebar-build-system and packages. | expand

Commit Message

Pierre-Henry Fröhring Oct. 29, 2023, 2:36 p.m. UTC
The builder now accepts the `#:sources-erlang` parameter, which expects a list
of "Source" items. Each "Source" corresponds to the source code of a library
directory, which is where Erlang looks for compiled modules. Documentation:
https://www.erlang.org/doc/man/code#code-path. Each Source is installed as a
"Checkout", which are local dependencies linked to directories managed by
rebar. For more information, see
https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies. Lacking
checkouts, rebar3 will not compile if there is no network access.

Change-Id: Idc3aa8bb204f55d0594c1669399845cd9b9e86ab
---
 guix/build-system/rebar.scm       | 274 +++++++++++++++++++-----------
 guix/build/rebar-build-system.scm | 255 +++++++++++++++++----------
 2 files changed, 339 insertions(+), 190 deletions(-)


base-commit: 4dfbc536689b07e56aead3dd864b8af54613d091
--
2.41.0

Comments

Liliana Marie Prikler Oct. 29, 2023, 6:29 p.m. UTC | #1
Am Sonntag, dem 29.10.2023 um 15:36 +0100 schrieb Pierre-Henry
Fröhring:
>  [PATCH va3e5ae0f..37252e07 01/32]
The middle should indicate a revision number and an optional branch (as
well as optional WIP and RFC).  Since this goes to master (I assume),
it should just be v2, v3, … vN

> The builder now accepts the `#:sources-erlang` parameter, which
> expects a list of "Source" items. Each "Source" corresponds to the
> source code of a library directory, which is where Erlang looks for
> compiled modules.
> Documentation:
> https://www.erlang.org/doc/man/code#code-path. Each Source is
> installed as a "Checkout", which are local dependencies linked to
> directories managed by rebar. For more information, see
> https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies
> . Lacking checkouts, rebar3 will not compile if there is no network
> access.
> 
> Change-Id: Idc3aa8bb204f55d0594c1669399845cd9b9e86ab
> ---
>  guix/build-system/rebar.scm       | 274 +++++++++++++++++++---------
> --
>  guix/build/rebar-build-system.scm | 255 +++++++++++++++++----------
>  2 files changed, 339 insertions(+), 190 deletions(-)
> 
> diff --git a/guix/build-system/rebar.scm b/guix/build-
> system/rebar.scm
> index de1294ec..862721ee 100644
> --- a/guix/build-system/rebar.scm
> +++ b/guix/build-system/rebar.scm
> @@ -1,6 +1,7 @@
>  ;;; GNU Guix --- Functional package management for GNU
>  ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
>  ;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
> +;;; Copyright © 2023 Pierre-Henry Fröhring
> <phfrohring@deeplinks.com>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -18,102 +19,117 @@
>  ;;; along with GNU Guix.  If not, see
> <http://www.gnu.org/licenses/>.
>  
>  (define-module (guix build-system rebar)
> -  #:use-module (guix store)
> -  #:use-module (guix utils)
> +  #:use-module (guix build-system gnu)
> +  #:use-module (guix build-system)
>    #:use-module (guix gexp)
> -  #:use-module (guix packages)
>    #:use-module (guix monads)
> +  #:use-module (guix packages)
>    #:use-module (guix search-paths)
> -  #:use-module (guix build-system)
> -  #:use-module (guix build-system gnu)
> -  #:export (hexpm-uri
> -            hexpm-package-url
> -            %rebar-build-system-modules
> -            rebar-build
> -            rebar-build-system))
> +  #:use-module (guix store)
> +  #:use-module (guix utils)
> +  #:use-module (ice-9 match)
> +  #:use-module (ice-9 regex)
> +  #:use-module (srfi srfi-1)
> +  #:export (hexpm-uri hexpm-package-url %rebar-build-system-modules
> +                      rebar-build rebar-build-system))
>  
> -;;;
> -;;; Definitions for the hex.pm repository,
> -;;;
> +;; Source
> +;;   A « Source » reprensents the source code to a library
> directory. It is
> +;;   defined as (list <name> <origin>) where: <name> is a string
> representing
> +;;   the name of a library directory and <origin> is an origin as
> defined
> +;;   (guix packages).
> +
> +
> +;; Pattern that an Erlang Guix package name is expected to match.
> +(define pkg-name-re "^erlang-(.*)")
Emacs, Rust, etc. build systems just strip out the prefix.  No need to
go all fancy regexpy :)

> +(define (pkg-name->match name)
> +  "Return the match object from NAME if NAME starts with pkg-name-
> prefix."
> +  (string-match pkg-name-re name))
> +
> +(define (pkg-name? name)
> +  "Test if NAME is the name of an Erlang Guix package."
> +  (or (pkg-name->match name) #f))
>  
> -;; URL and paths from
> -;; https://github.com/hexpm/specifications/blob/master/endpoints.md
> -(define %hexpm-repo-url
> -  (make-parameter "https://repo.hex.pm"))
> +(define (pkg-name->suffix name)
> +  "Return the suffix of the name of an Erlang Guix package."
> +  (regexp-substitute #f (pkg-name->match name) 1))
>  
> -(define hexpm-package-url
> -  (string-append (%hexpm-repo-url) "/tarballs/"))
> +(define* (pkg-name->library-directory-name name #:key (version ""))
> +  "Return the name of the library directory associated with the
> Erlang Guix package name NAME."
> +  (string-append (string-replace-substring (pkg-name->suffix name)
> "-" "_")
> +                 (if (string= version "") "" (string-append "-"
> version))))
> +
> +;; See:
> https://github.com/hexpm/specifications/blob/master/endpoints.md
> +(define hexpm (make-parameter "https://repo.hex.pm"))
> +
> +(define hexpm-tarballs (string-append (hexpm) "/tarballs/"))
>  
>  (define (hexpm-uri name version)
>    "Return a URI string for the package hosted at hex.pm
> corresponding to NAME
> -and VERSION."
> -  (string-append hexpm-package-url name "-" version ".tar"))
> +and VERSION.
>  
> -;;
> -;; Standard build procedure for Erlang packages using Rebar.
> -;;
> +XXX: should a warning be emitted?
> +If NAME is not an Erlang Guix package name, then emit a warning. The
> download
> +will fail if it is not correct anyway."
>  
> -(define %rebar-build-system-modules
> -  ;; Build-side modules imported by default.
> -  `((guix build rebar-build-system)
> -    ,@%gnu-build-system-modules))
> +  (define (warn-about name)
> +    (format #t "AssertionWarning 4dcbff27
> +  Assertion: re matches name.
> +    re = ~a
> +    name = ~a
> +" pkg-name-re name)
> +
> +    name)
何で?

>  
> -(define (default-rebar3)
> -  "Return the default Rebar3 package."
> +  (define (name->archive-name name)
> +    (if (pkg-name? name)
> +        (string-append (pkg-name->library-directory-name name
> #:version version) ".tar")
> +        (string-append (warn-about name) "-" version ".tar")))
> +
> +  (string-append hexpm-tarballs (name->archive-name name)))
> +
> +(define (rebar-default)
>    ;; Lazily resolve the binding to avoid a circular dependency.
>    (let ((erlang-mod (resolve-interface '(gnu packages erlang))))
>      (module-ref erlang-mod 'rebar3)))
I suggest not to rename these procedures.  default-X reads more
naturally than X-default.

> -(define (default-erlang)
> -  "Return the default Erlang package."
> +(define (erlang-default)
>    ;; Lazily resolve the binding to avoid a circular dependency.
>    (let ((erlang-mod (resolve-interface '(gnu packages erlang))))
>      (module-ref erlang-mod 'erlang)))
>  
> -(define* (lower name
> -                #:key source inputs native-inputs outputs system
> target
> -                (rebar (default-rebar3))
> -                (erlang (default-erlang))
> -                #:allow-other-keys
> -                #:rest arguments)
> -  "Return a bag for NAME from the given arguments."
> -  (define private-keywords
> -    '(#:target #:rebar #:erlang #:inputs #:native-inputs))
> -
> -  (and (not target)                               ;XXX: no cross-
> compilation
> -       (bag
> -         (name name)
> -         (system system)
> -         (host-inputs `(,@(if source
> -                              `(("source" ,source))
> -                              '())
> -                        ,@inputs))
> -         (build-inputs `(("rebar" ,rebar)
> -                         ("erlang" ,erlang) ;; for escriptize
> -                         ,@native-inputs
> -                         ;; Keep the standard inputs of 'gnu-build-
> system'.
> -                         ,@(standard-packages)))
> -         (outputs outputs)
> -         (build rebar-build)
> -         (arguments (strip-keyword-arguments private-keywords
> arguments)))))
> -
> -(define* (rebar-build name inputs
> -                       #:key
> -                       guile source
> -                       (rebar-flags ''("skip_deps=true" "-vv"))
> -                       (tests? #t)
> -                       (test-target "eunit")
> -                       ;; TODO: install-name  ; default: based on
> guix package name
> -                       (install-profile "default")
> -                       (phases '(@ (guix build rebar-build-system)
> -                                   %standard-phases))
> -                       (outputs '("out"))
> -                       (search-paths '())
> -                       (native-search-paths '())
> -                       (system (%current-system))
> -                       (imported-modules %rebar-build-system-
> modules)
> -                       (modules '((guix build rebar-build-system)
> -                                  (guix build utils))))
> +(define imported-modules
> +  `((guix build rebar-build-system)
> +    ,@%gnu-build-system-modules))
> +
> +(define (input->source input)
> +  "Return a Source associated to the Input INPUT."
> +  (match input
> +    ((name package)
> +     (list (pkg-name->library-directory-name name)
> +           (package-source package)))))
> +
> +(define* (rebar-build name
> +                      inputs
> +                      #:key
> +                      guile
> +                      source
> +                      (rebar-flags ''())
> +                      (tests? #t)
> +                      (test-target "eunit")
> +                      ;; TODO: install-name  ; default: based on
> guix package name
> +                      (install-profile "default")
> +                      (phases '(@ (guix build rebar-build-system)
> +                                  %standard-phases))
> +                      (outputs '("out"))
> +                      (search-paths '())
> +                      (native-search-paths '())
> +                      (system (%current-system))
> +                      (imported-modules imported-modules)
> +                      (modules '((guix build rebar-build-system)
> +                                 (guix build utils)))
> +                      (sources-erlang '()))
>    "Build SOURCE with INPUTS."
>  
>    (define builder
> @@ -122,35 +138,95 @@ (define* (rebar-build name inputs
>            (use-modules #$@(sexp->gexp modules))
>  
>            #$(with-build-variables inputs outputs
> +
>                #~(rebar-build #:source #+source
> -                      #:system #$system
> -                      #:name #$name
> -                      #:rebar-flags #$rebar-flags
> -                      #:tests? #$tests?
> -                      #:test-target #$test-target
> -                      ;; TODO: #:install-name #$install-name
> -                      #:install-profile #$install-profile
> -                      #: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)))
> +                             #:sources-erlang '#$sources-erlang
This reeks of the hack that we need for cargo-build-system, except with
a worse variable name.  I strongly suggest looking into ways we can do
without it.
> +                             #:system #$system
> +                             #:name #$name
> +                             #:rebar-flags #$rebar-flags
> +                             #:tests? #$tests?
> +                             #:test-target #$test-target
> +                             ;; TODO: #:install-name #$install-name
> +                             #:install-profile #$install-profile
> +                             #: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)))
> +
>      ;; Note: Always pass #:graft? #f.  Without it, ALLOWED-
> REFERENCES &
>      ;; co. would be interpreted as referring to grafted packages.
> -    (gexp->derivation name builder
> +    (gexp->derivation name
> +                      builder
>                        #:system system
>                        #:target #f
>                        #:graft? #f
>                        #:guile-for-build guile)))
>  
> +(define* (lower name
> +                      #:key
> +                      (erlang (erlang-default))
> +                      inputs
> +                      native-inputs
> +                      outputs
> +                      (rebar (rebar-default))
> +                      source
> +                      system
> +                      target
> +                      #:allow-other-keys #:rest arguments)
> +  "Return a bag for NAME from the given arguments."
> +
> +  (let* ((erlang-packages
> +          (filter (lambda (input)
> +                    (match input
> +                      ((name _) (pkg-name? name))))
> +                  (append inputs native-inputs)))
> +
> +         (erlang-sources (map input->source erlang-packages)))
> +
> +    (define private-keywords
> +      '(#:target #:rebar #:erlang #:inputs #:native-inputs
> #:sources-erlang))
> +
> +    (and (not target) ;XXX: no cross-compilation
> +         (bag (name name)
> +              (system system)
> +              (host-inputs inputs)
> +              (build-inputs `(,@(standard-packages)
> +                              ("erlang" ,erlang)
> +                              ("rebar" ,rebar)
> +                              ,@inputs
> +                              ,@native-inputs))
> +              (outputs outputs)
> +              (build rebar-build)
> +              (arguments (append (list #:sources-erlang erlang-
> sources)
> +                                 (strip-keyword-arguments private-
> keywords
> +                                                         
> arguments)))))))
> +
>  (define rebar-build-system
> -  (build-system
> -    (name 'rebar)
> -    (description "The standard Rebar build system")
> -    (lower lower)))
> +  (build-system (name 'rebar)
> +                (description "The standard Rebar build system")
> +                (lower lower)))
> +
> +
> +;;;
> +;;; Exports
> +;;;
> +
> +(define hexpm-package-url hexpm-tarballs)
> +
> +(define %rebar-build-system-modules imported-modules)
> +
> +
> +;;; rebar.scm ends here
> diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar-
> build-system.scm
> index fb664228..b68348bd 100644
> --- a/guix/build/rebar-build-system.scm
> +++ b/guix/build/rebar-build-system.scm
> @@ -2,6 +2,7 @@
>  ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
>  ;;; Copyright © 2019 Björn Höfling
> <bjoern.hoefling@bjoernhoefling.de>
>  ;;; Copyright © 2020, 2022 Hartmut Goebel
> <h.goebel@crazy-compilers.com>
> +;;; Copyright © 2023 Pierre-Henry Fröhring
> <phfrohring@deeplinks.com>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -23,125 +24,197 @@ (define-module (guix build rebar-build-system)
>    #:use-module ((guix build utils) #:hide (delete))
>    #:use-module (ice-9 match)
>    #:use-module (ice-9 ftw)
> +  #:use-module (ice-9 string-fun)
> +  #:use-module (ice-9 receive)
> +  #:use-module (ice-9 regex)
>    #:use-module (srfi srfi-1)
>    #:use-module (srfi srfi-26)
> -  #:export (rebar-build
> -            %standard-phases))
> +  #:export (rebar-build %standard-phases))
>  
>  ;;
>  ;; Builder-side code of the standard build procedure for Erlang
> packages using
>  ;; rebar3.
>  ;;
> -;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and
> includedir
> -;; "(include") need to be configurable
> +;; Library directory
> +;;   A « library directory » is a directory where Erlang searches
> for compiled
> +;;   code. Its name should look like: `a_name-1.2.3' where the
> suffix `-1.2.3'
> +;;   is optional. See:
> https://www.erlang.org/doc/man/code#code-path.
> +;;
> +;; Package name
> +;;   A « package name » is the value of the name field of a package
> +;;   definition. It looks like: `prefix-a-name-1.2.3'. See:
> +;;   https://guix.gnu.org/manual/en/html_node/Package-Naming.html
> +;;
> +;; Profile
> +;;   For Rebar3, a « profile » is a name associated to a set of
> configuration
> +;;   settings overriding or complementing the regular configuration.
> See:
> +;;   https://rebar3.org/docs/configuration/profiles
> +;;
> +;; Source
> +;;   A « source » represents the source code associated to a Guix
> package as
> +;;   defined by its `source' field. Here, the data sctructure used
> to
> +;;   represent a source has the form `(list name path)' where `name'
> is a
> +;;   library directory name and `path' is the store path where to
> find the
> +;;   source code.
> +;;
> +;; Checkout
> +;;   A « checkout » is a locally defined dependency related to a
> directory
> +;;   managed by rebar.  See:
> +;;  
> https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies
>  
> -(define %erlang-libdir "/lib/erlang/lib")
> +(define sep "/")
Uhm, did you mean file-name-separator-string from Guile core?

> -(define* (erlang-depends #:key inputs #:allow-other-keys)
> -  (define input-directories
> -    (match inputs
> -      (((_ . dir) ...)
> -       dir)))
> -  (mkdir-p "_checkouts")
> -
> -  (for-each
> -   (lambda (input-dir)
> -     (let ((elibdir (string-append input-dir %erlang-libdir)))
> -       (when (directory-exists? elibdir)
> -         (for-each
> -          (lambda (dirname)
> -            (let ((dest (string-append elibdir "/" dirname))
> -                  (link (string-append "_checkouts/" dirname)))
> -              (when (not (file-exists? link))
> -                ;; RETHINK: Maybe better copy and make writable to
> avoid some
> -                ;; error messages e.g. when using with rebar3-git-
> vsn.
> -                (symlink dest link))))
> -          (list-directories elibdir)))))
> -   input-directories))
> +;; Where Erlang libraries are installed relative to a package path
> in the store.
> +(define lib-erlang-lib "lib/erlang/lib")
> +
> +(define (list-directories directory)
> +  "Return file names of the sub-directory of DIRECTORY."
> +  (scandir directory
> +           (lambda (file)
> +             (and (not (member file '("." "..")))
> +                  (file-is-directory? (string-append directory sep
> file))))))
We have find-files?
> +
> +(define* (pkg-name->libdir-name name)
> +  "Return the library name deduced from the Erlang package name
> NAME."
> +  (let* ((suffix (regexp-substitute #f (string-match "^erlang-(.*)"
> name) 1))
> +         (elements (string-split suffix #\-)))
> +    (string-append (string-join (drop-right elements 1) "_") "-"
> (last elements))))
> +
> +(define (libdir-name->prefix name)
> +  "Return the prefix of a library directory name NAME."
> +  (car (string-split name #\-)))
> +
> +(define (rebar-build-dir profile)
> +  "Return the path where rebar builds libraries given the profile
> PROFILE."
> +  (format #f "_build/~a/lib" profile))
> +
> +(define* (pkg-name->build-dir name #:key (profile "default"))
> +  "Return the path of library directory where rebar3 builds code of
> an Erlang package named NAME given the profile PROFILE."
> +  (string-append (rebar-build-dir profile) sep (libdir-name->prefix
> (pkg-name->libdir-name name))))
>  
>  (define* (unpack #:key source #: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)
> -    ;; Packages from hex.pm typically have a contents.tar.gz
> containing the
> -    ;; actual source. If this tar file exists, extract it.
> -    (when (file-exists? "contents.tar.gz")
> -      (invoke "tar" "xvf" "contents.tar.gz"))))
> -
> -(define* (build #:key (rebar-flags '()) #:allow-other-keys)
> +  (if (file-is-directory? source)
> +      ;; If source is a checkout:
> +      (begin
> +        ;; Preserve timestamps (set to the Epoch) on the copied tree
> so that
> +        ;; things work deterministically.
> +        (copy-recursively source "." #:keep-mtime? #t)
> +        ;; Make the source checkout files writable, for convenience.
> +        (for-each (lambda (f)
> +                    (false-if-exception (make-file-writable f)))
> +                  (find-files ".")))
> +
> +      ;; If source is an hex.pm archive:
> +      (begin
> +        (invoke "tar" "xvf" source)
> +        (invoke "tar" "xvf" "contents.tar.gz")
> +
> +        ;; Prevent an error message during the install phase.
> +        ;;   `rebar3 compile' produces symlinks like so in _build/:
> +        ;;      priv -> ../../../../priv
> +        ;;      include -> ../../../../include
> +        ;;
> +        ;;   The install phase copies whatever has been built to the
> output directory.
> +        ;;   If the priv/ directory is absent, then an error `i/o
> error:
> +        ;;   _build/…/priv: No such file or directory' occurs. So,
> we make sure that a
> +        ;;   directory exists.
> +        (for-each (lambda (dir) (mkdir-p dir)) (list "priv"
> "include")))))
Uhm, how are you improving the status quo here?

> +
> +(define (configure-HOME . ignored_args)
Just _ is fine for ignored arguments.
> +  "In some cases, it is needed for the environment variable HOME to
> be defined
> +as a directory with write permission. Examples of errors:
> +
> +Could not write to \"/homeless-shelter/.cache/rebar3/hex\". Please
> ensure the path is writeable.
> +"
> +  (let ((HOME "HOME")
> +        (tmp "/tmp"))
> +    (setenv HOME tmp)
> +    (format #t "~a=~a\n" HOME tmp)))
The canonical way is to use (getcwd) as HOME.  You can could also try
something like (canonicalize-path "../hexpm-home").  Anyhow, you might
want to try using a variable that is less global than HOME.

> +(define* (configure-dependencies #:key
> +                                 (install-profile "default")
> +                                 inputs
> +                                 name
> +                                 sources-erlang ;List of Source.
> +                                 version
> +                                 #:allow-other-keys)
> +  "Rebar3 refuses to compile without network access unless its
> dependencies are
> +present as source checkouts. To prevent unnecessary compilations, we
> must «
> +pre-install » dependencies in Rebar's build directory."
I suggest not using french quotes – they are confusing between French
and German native speakers :)
You might want to look into possible PATH variables or put these
sources into a special folder so that you can use search-path-as-list.

Also, IIUC erlang-depends already does something rather similar.  Is
there any reason it's broken for you?
> +
> +  ;; If source in sources-erlang, then install it under _checkouts/.
> +  (let ((_checkouts "_checkouts"))
> +    (mkdir-p _checkouts)
> +
> +    (define (install-source source)
> +      "Install the Source SOURCE in _checkouts."
> +      (match source
> +        ((name path)
> +         (let ((src (string-append _checkouts sep name)))
> +           (mkdir-p src)
> +           (with-directory-excursion src (unpack #:source path))))
> +        (_ #f)))
> +
> +    (for-each install-source sources-erlang))
> +
> +  ;; If input in inputs is an Erlang package, then install it under
> _build/.
> +  (let ((_build (format #f "_build/~a/checkouts" install-profile)))
> +    (mkdir-p _build)
> +
> +    (define (install-libdir elib name dest)
> +      "Install the library directory named NAME from ELIB to DEST."
> +      (let ((src (string-append elib sep name))
> +            (dest (string-append dest sep (libdir-name->prefix
> name))))
> +        (copy-recursively src dest)
> +        (mkdir-p (string-append dest "/priv"))))
> +
> +    (define (install-all-libdirs dir dest)
> +      "Install in DEST all library directories in DIR."
> +      (let ((elib (string-append dir sep lib-erlang-lib)))
> +        (when (directory-exists? elib)
> +          (for-each (lambda (name) (install-libdir elib name dest))
> +                    (list-directories elib)))))
> +
> +    (match inputs
> +      (((_ . dirs) ..1)
> +       (for-each
> +        (lambda (dir) (install-all-libdirs dir _build))
> +        dirs))
> +      (_ #f))))
> +
> +(define* (build #:key name (rebar-flags '()) #:allow-other-keys)
>    (apply invoke `("rebar3" "compile" ,@rebar-flags)))
>  
> -(define* (check #:key target (rebar-flags '()) (tests? (not target))
> +(define* (check #:key target
> +                (rebar-flags '())
> +                (tests? (not target))
>                  (test-target "eunit")
>                  #:allow-other-keys)
>    (if tests?
>        (apply invoke `("rebar3" ,test-target ,@rebar-flags))
>        (format #t "test suite not run~%")))
>  
> -(define (erlang-package? name)
> -  "Check if NAME correspond to the name of an Erlang package."
> -  (string-prefix? "erlang-" name))
> -
> -(define (package-name-version->erlang-name name+ver)
> -  "Convert the Guix package NAME-VER to the corresponding Erlang
> name-version
> -format.  Essentially drop the prefix used in Guix and replace dashes
> by
> -underscores."
> -  (let* ((name- (package-name->name+version name+ver)))
> -    (string-join
> -     (string-split
> -      (if (erlang-package? name-)  ; checks for "erlang-" prefix
> -          (string-drop name- (string-length "erlang-"))
> -          name-)
> -      #\-)
> -     "_")))
> -
> -(define (list-directories directory)
> -  "Return file names of the sub-directory of DIRECTORY."
> -  (scandir directory
> -           (lambda (file)
> -             (and (not (member file '("." "..")))
> -                  (file-is-directory? (string-append directory "/"
> file))))))
> -
> -(define* (install #:key name outputs
> -                  (install-name (package-name-version->erlang-name
> name))
> -                  (install-profile "default") ; build profile
> outputs to install
> -                  #:allow-other-keys)
> -  (let* ((out (assoc-ref outputs "out"))
> -         (pkg-dir (string-append out %erlang-libdir "/" install-
> name)))
> -    (let ((bin-dir (string-append "_build/" install-profile "/bin"))
> -          (lib-dir (string-append "_build/" install-profile
> "/lib")))
> -      ;; install _build/PROFILE/bin
> -      (when (file-exists? bin-dir)
> -        (copy-recursively bin-dir out #:follow-symlinks? #t))
> -      ;; install _build/PROFILE/lib/*/{ebin,include,priv}
> -      (for-each
> -       (lambda (*)
> -         (for-each
> -          (lambda (dirname)
> -            (let ((src-dir (string-append lib-dir "/" * "/"
> dirname))
> -                  (dst-dir (string-append pkg-dir "/" dirname)))
> -              (when (file-exists? src-dir)
> -                (copy-recursively src-dir dst-dir #:follow-symlinks?
> #t))
> -              (false-if-exception
> -               (delete-file (string-append dst-dir
> "/.gitignore")))))
> -          '("ebin" "include" "priv")))
> -       (list-directories lib-dir))
> -      (false-if-exception
> -       (delete-file (string-append pkg-dir "/priv/Run-eunit-
> loop.expect"))))))
> +(define* (install #:key name outputs (install-profile "default")
> #:allow-other-keys)
> +  (let* ((src (pkg-name->build-dir name #:profile install-profile))
> +         (dest (string-append (assoc-ref outputs "out")
> +                              sep lib-erlang-lib sep
> +                              (pkg-name->libdir-name name))))
> +    (mkdir-p dest)
> +    (copy-recursively src dest #:follow-symlinks? #t)))
>  
>  (define %standard-phases
>    (modify-phases gnu:%standard-phases
>      (replace 'unpack unpack)
> +    (add-after 'unpack 'configure-HOME configure-HOME)
>      (delete 'bootstrap)
>      (delete 'configure)
> -    (add-before 'build 'erlang-depends erlang-depends)
> +    (add-before 'build 'configure-dependencies configure-
> dependencies)
>      (replace 'build build)
>      (replace 'check check)
>      (replace 'install install)))
>  
> -(define* (rebar-build #:key inputs (phases %standard-phases)
> -                      #:allow-other-keys #:rest args)
> +(define* (rebar-build #:key inputs (phases %standard-phases)
> #:allow-other-keys #:rest args)
>    "Build the given Erlang package, applying all of PHASES in order."
>    (apply gnu:gnu-build #:inputs inputs #:phases phases args))
> +
> +;;; rebar-build-system.scm ends here
> 
> base-commit: 4dfbc536689b07e56aead3dd864b8af54613d091
> --
> 2.41.0
Cheers
Pierre-Henry Fröhring Oct. 29, 2023, 10:14 p.m. UTC | #2
>  The middle should indicate a revision number and an optional branch
>  (as well as optional WIP and RFC).  Since this goes to master (I
>  assume), it should just be v2, v3, … vN.

DONE: Ok. If I understood correctly, it means that it should have been
[PATCH v2]. So this time, it will be [PATCH v3].

> Emacs, Rust, etc., build systems just strip out the prefix.  No need
> to go all fancy regexpy :)何で?

WAITING: Well, it makes the warning message completely explicit, for
example:
┌────
│ AssertionWarning 4dcbff27
│   Assertion: re matches name.
│     re = ^erlang-(.*)
│     name = something-else
└────
Is it OK if it stays like this?

> I suggest not renaming these procedures.  default-X reads more
> naturally than X-default.

DONE.

> This reeks of the hack that we need for cargo-build-system, except
> with a worse variable name.  I strongly suggest looking into ways we
> can do without it.

WAITING: this idea came from a discussion with jpoiret. See:
<https://logs.guix.gnu.org/guix/2023-10-24.log#180111>. It seems that
the idea you suggest is to use `search-path-as-list' as hinted below. Is
this correct?

> Uhm, did you mean file-name-separator-string from Guile core?

DONE: Great. That is what I was searching for; I'm not yet familiar with
the standard library.

> We have find-files?

DONE: replaced.

> Uhm, how are you improving the status quo here?

WAITING: comment updated with:
┌────
│ ;;   If these directories exist, then no error occurs. So, we make sure
│ ;;   they exist.
└────
Is this OK?

> The canonical way is to use (getcwd) as HOME.  You could also try
> something like (canonicalize-path "../hexpm-home").  Anyhow, you might
> want to try using a variable that is less global than HOME.

DONE: HOME has been replaced by REBAR_CACHE_DIR.

> I suggest not using French examples – they are confusing between
> French and German native speakers :)

DONE: « → “, » → ”

> You might want to look into possible PATH variables or put these
> sources into a special folder so that you can use search-path-as-list.

WAITING: Perhaps an idea:
1) If we require all Erlang packages to have an output “src” something
   like: /gnu/store/…elixir-pkg-1.2.3/src/elixir/src/…,
2) then (search-path-as-list '("src/elixir/src")
   '("/gnu/store…elixir-pkg-1.2.3" …)) would return
   '("/gnu/store…elixir-pkg-1.2.3/src/elixir/src" …) ≡ lst-src.
3) Given lst-src, it would be enough to install each source under
   _checkouts, i.e., _checkouts/lib-name/src. It is probably feasible to
   retrieve lib-name from somewhere.
What do you think?

> Also, IIUC, erlang-depends already does something rather similar.  Is
> there any reason it's broken for you?

WAITING: Without that (i.e., _checkouts/lib-name/src), rebar3 will not
compile things. Is this a satisfaying explaination?
Liliana Marie Prikler Oct. 30, 2023, 5:29 a.m. UTC | #3
Am Sonntag, dem 29.10.2023 um 23:14 +0100 schrieb Pierre-Henry
Fröhring:
> n [PATCH v2]. So this time, it will be [PATCH v3].
> 
> > Emacs, Rust, etc., build systems just strip out the prefix.  No
> > need to go all fancy regexpy :)何で?
> 
> WAITING: Well, it makes the warning message completely explicit, for
> example:
> ┌────
> │ AssertionWarning 4dcbff27
> │   Assertion: re matches name.
> │     re = ^erlang-(.*)
> │     name = something-else
> └────
> Is it OK if it stays like this?
You can use a shorter error and explain the problem better: 
  "~a does not start with \"erlang-\"" name

> 
> > Uhm, how are you improving the status quo here?
> 
> WAITING: comment updated with:
> ┌────
> │ ;;   If these directories exist, then no error occurs. So, we make
> sure
> │ ;;   they exist.
> └────
> Is this OK?
> 
> 
> [...]
> > You might want to look into possible PATH variables or put these
> > sources into a special folder so that you can use search-path-as-
> > list.
> 
> WAITING: Perhaps an idea:
> 1) If we require all Erlang packages to have an output “src”
> something
>    like: /gnu/store/…elixir-pkg-1.2.3/src/elixir/src/…,
> 2) then (search-path-as-list '("src/elixir/src")
>    '("/gnu/store…elixir-pkg-1.2.3" …)) would return
>    '("/gnu/store…elixir-pkg-1.2.3/src/elixir/src" …) ≡ lst-src.
> 3) Given lst-src, it would be enough to install each source under
>    _checkouts, i.e., _checkouts/lib-name/src. It is probably feasible
> to
>    retrieve lib-name from somewhere.
> What do you think?
Rather than require, you can add a phase to ensure that this is the
case.  I'm not sure whether we should make that an extra output,
however; there might be many packages for which we don't need those
sources and where we do need them, we could potentially add them as
native-inputs.  

Another alternative would be to keep the sources in 
lib/erlang/lib/lib-name/src so that it gets symlinked by the phase we
have.  Though at that point we can surely go with a less surprising
install directory.

> > Also, IIUC, erlang-depends already does something rather similar. 
> > Is there any reason it's broken for you?
> 
> WAITING: Without that (i.e., _checkouts/lib-name/src), rebar3 will
> not compile things. Is this a satisfaying explaination?
I mean, ideally we would store these things in some other directory,
given that _checkouts/lib-name already contains the precompiled stuff
after erlang-depends.  However, if the tooling insists on storing both
in the same place, you could simply amend the existing erlang-depends
phase to
1. Copy instead of symlinking
2. Also copy the sources

Cheers
Pierre-Henry Fröhring Oct. 30, 2023, 12:30 p.m. UTC | #4
I've collected your comments in an org-file so that it's easier (at least
for me, but I hope it's the case for you too)
to follow multiple discussions at the same time. I've only included the
ones that are still open to discussion.
The structure should be self-evident. The most important comment may be
Comment 9.
Cheers.

* TODO Comment 4
** LMP
This reeks of the hack that we need for cargo-build-system, except with a
worse variable name.  I strongly suggest looking into ways we can do without
it.

** PHF
This idea came from a discussion with jpoiret. See:
https://logs.guix.gnu.org/guix/2023-10-24.log#180111. It seems that the idea
you suggest is to use =search-path-as-list= as hinted below (=Comment 9=).
Is this
correct?

* TODO Comment 6
** LMP
Uhm, how are you improving the status quo here?

** PHF
Comment updated with:
#+begin_example
;;   If these directories exist, then no error occurs. So, we make sure
;;   they exist.
#+end_example
Is this OK?

I don't see how to prevent rebar3 to do that. It's apparently an opened
issue:
https://github.com/erlang/rebar3/issues/1173

* TODO Comment 9
** LMP
You might want to look into possible PATH variables or put these sources
into
a special folder so that you can use search-path-as-list.

** PHF
Perhaps an idea:
  1) If we require all Erlang packages to have an output “src” something
like: /gnu/store/…elixir-pkg-1.2.3/src/elixir/src/…,
  2) then (search-path-as-list '("src/elixir/src")
'("/gnu/store…elixir-pkg-1.2.3" …)) would return
'("/gnu/store…elixir-pkg-1.2.3/src/elixir/src" …) ≡ lst-src.
  3) Given lst-src, it would be enough to install each source under
_checkouts,
     i.e., _checkouts/lib-name/src. It is probably feasible to retrieve
lib-name
     from somewhere.
What do you think?

** LMP
Rather than require, you can add a phase to ensure that this is the case.
I'm not sure whether we should make that an extra output, however; there
might be many packages for which we don't need those sources and where we do
need them, we could potentially add them as native-inputs.

** PHF
Agreed.

** LMP
Another alternative would be to keep the sources in
=lib/erlang/lib/lib-name/src= so that it gets symlinked by the phase we
have.
Though at that point we can surely go with a less surprising install
directory.

** PHF
Here is the approach taken so far:
1) The objective is to ensure that =mix compile= does not attempt to use the
   network and, as a result, fails to compile.
2) For the above to be true, it is necessary to have — at build time — the
   sources of all Erlang input packages and install them as checkouts.
3) Thus, the question becomes: How to access all the Erlang package sources
at
   build time?
4) One idea was to have the client side of the build code send all the
sources
   to the server through the poorly named argument =#:sources-erlang=. This
led
   to the current code. It relies on the fact that for a given Erlang
package,
   it is possible to access its source in the store, for example,
   =/gnu/store/…erlang-kv/erlang-kv.tar=.
5) Instead, you propose modifying the installation process so that sources
are
   installed along with the built libraries. The source might be collected
   with =search-path-as-list=.

   The downside seems to be that the source code is stored twice: first in
the
   archive, then in the package.

   However, this could lead to a much cleaner method of passing the sources
to
   the build-side code, that is, the source code would not be passed through
   =arguments=.

I'm sending a patch based on this latter idea. Are you OK with that?

* TODO Comment 10
** LMP
Also, IIUC, erlang-depends already does something rather similar.  Is there
any reason it's broken for you?

** PHF
Without that (i.e., _checkouts/lib-name/src), rebar3 will not compile
things. Is this a satisfying explanation?

** LMP
I mean, ideally we would store these things in some other directory,
given that _checkouts/lib-name already contains the precompiled stuff
after erlang-depends.  However, if the tooling insists on storing both
in the same place, you could simply amend the existing erlang-depends
phase to:
1. Copy instead of symlinking
2. Also copy the sources

** PHF
If I understand correctly, this should be addressed with the patch from
=Comment 9= section above.
Liliana Marie Prikler Oct. 30, 2023, 8:40 p.m. UTC | #5
Am Montag, dem 30.10.2023 um 13:30 +0100 schrieb Pierre-Henry Fröhring:
> [...]
> Comment updated with:
> #+begin_example
> ;;   If these directories exist, then no error occurs. So, we make
> sure
> ;;   they exist.
> #+end_example
> Is this OK?
> 
> I don't see how to prevent rebar3 to do that. It's apparently an
> opened issue:
> https://github.com/erlang/rebar3/issues/1173
I'd recommend sticking with the current flow, however, and either
create those directories unconditionally or inside the 
  (when (file-exists? …) …)
In general, don't mix gratuitous "styling" changes into your commits. 
Try to keep your edits minimal and reviewable.

> Here is the approach taken so far:
> 1) The objective is to ensure that =mix compile= does not attempt to
>    use the network and, as a result, fails to compile.
> 2) For the above to be true, it is necessary to have — at build time
>    — the sources of all Erlang input packages and install them as
>    checkouts.
> 3) Thus, the question becomes: How to access all the Erlang package 
>    sources at build time?
> [...]
One idea both of us haven't voiced so far is to actually grab these in
the (guix build-system …) code rather than the (guix build …) side and
make the sources available via a mapping.  Think package → (package-
source package).

The downsides of this are quite obvious.  First, to my knowledge
something like that hasn't been done yet, so there's no reference
point.  Second, the (guix build …) side would still need to identify
what's an erlang source.  Given our code for the unpack phase, I'd
hazard a guess that this is non-trivial.  Thus, even if there's
theoretically a way to not store the same tarball twice, in practice it
doesn't really matter.

You could alternatively also write the sources to a special source
output if and only if one such output is requested via the outputs
field.  Again, I'd hazard a guess that this would be a very standard
output for anything that needs to go into mix-build-system and thus not
worth the split after all.

Alternatively² you could patch mix to only look for compiled stuff and
not sources.  That would tackle the issue at the root instead of trying
to work around it, with the caveat being that we would need to maintain
this patch ourselves if upstream doesn't accept it.

Cheers
diff mbox series

Patch

diff --git a/guix/build-system/rebar.scm b/guix/build-system/rebar.scm
index de1294ec..862721ee 100644
--- a/guix/build-system/rebar.scm
+++ b/guix/build-system/rebar.scm
@@ -1,6 +1,7 @@ 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,102 +19,117 @@ 
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix build-system rebar)
-  #:use-module (guix store)
-  #:use-module (guix utils)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix monads)
+  #:use-module (guix packages)
   #:use-module (guix search-paths)
-  #:use-module (guix build-system)
-  #:use-module (guix build-system gnu)
-  #:export (hexpm-uri
-            hexpm-package-url
-            %rebar-build-system-modules
-            rebar-build
-            rebar-build-system))
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:export (hexpm-uri hexpm-package-url %rebar-build-system-modules
+                      rebar-build rebar-build-system))
 
-;;;
-;;; Definitions for the hex.pm repository,
-;;;
+;; Source
+;;   A « Source » reprensents the source code to a library directory. It is
+;;   defined as (list <name> <origin>) where: <name> is a string representing
+;;   the name of a library directory and <origin> is an origin as defined
+;;   (guix packages).
+
+
+;; Pattern that an Erlang Guix package name is expected to match.
+(define pkg-name-re "^erlang-(.*)")
+
+(define (pkg-name->match name)
+  "Return the match object from NAME if NAME starts with pkg-name-prefix."
+  (string-match pkg-name-re name))
+
+(define (pkg-name? name)
+  "Test if NAME is the name of an Erlang Guix package."
+  (or (pkg-name->match name) #f))
 
-;; URL and paths from
-;; https://github.com/hexpm/specifications/blob/master/endpoints.md
-(define %hexpm-repo-url
-  (make-parameter "https://repo.hex.pm"))
+(define (pkg-name->suffix name)
+  "Return the suffix of the name of an Erlang Guix package."
+  (regexp-substitute #f (pkg-name->match name) 1))
 
-(define hexpm-package-url
-  (string-append (%hexpm-repo-url) "/tarballs/"))
+(define* (pkg-name->library-directory-name name #:key (version ""))
+  "Return the name of the library directory associated with the Erlang Guix package name NAME."
+  (string-append (string-replace-substring (pkg-name->suffix name) "-" "_")
+                 (if (string= version "") "" (string-append "-" version))))
+
+;; See: https://github.com/hexpm/specifications/blob/master/endpoints.md
+(define hexpm (make-parameter "https://repo.hex.pm"))
+
+(define hexpm-tarballs (string-append (hexpm) "/tarballs/"))
 
 (define (hexpm-uri name version)
   "Return a URI string for the package hosted at hex.pm corresponding to NAME
-and VERSION."
-  (string-append hexpm-package-url name "-" version ".tar"))
+and VERSION.
 
-;;
-;; Standard build procedure for Erlang packages using Rebar.
-;;
+XXX: should a warning be emitted?
+If NAME is not an Erlang Guix package name, then emit a warning. The download
+will fail if it is not correct anyway."
 
-(define %rebar-build-system-modules
-  ;; Build-side modules imported by default.
-  `((guix build rebar-build-system)
-    ,@%gnu-build-system-modules))
+  (define (warn-about name)
+    (format #t "AssertionWarning 4dcbff27
+  Assertion: re matches name.
+    re = ~a
+    name = ~a
+" pkg-name-re name)
+
+    name)
 
-(define (default-rebar3)
-  "Return the default Rebar3 package."
+  (define (name->archive-name name)
+    (if (pkg-name? name)
+        (string-append (pkg-name->library-directory-name name #:version version) ".tar")
+        (string-append (warn-about name) "-" version ".tar")))
+
+  (string-append hexpm-tarballs (name->archive-name name)))
+
+(define (rebar-default)
   ;; Lazily resolve the binding to avoid a circular dependency.
   (let ((erlang-mod (resolve-interface '(gnu packages erlang))))
     (module-ref erlang-mod 'rebar3)))
 
-(define (default-erlang)
-  "Return the default Erlang package."
+(define (erlang-default)
   ;; Lazily resolve the binding to avoid a circular dependency.
   (let ((erlang-mod (resolve-interface '(gnu packages erlang))))
     (module-ref erlang-mod 'erlang)))
 
-(define* (lower name
-                #:key source inputs native-inputs outputs system target
-                (rebar (default-rebar3))
-                (erlang (default-erlang))
-                #:allow-other-keys
-                #:rest arguments)
-  "Return a bag for NAME from the given arguments."
-  (define private-keywords
-    '(#:target #:rebar #:erlang #:inputs #:native-inputs))
-
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs))
-         (build-inputs `(("rebar" ,rebar)
-                         ("erlang" ,erlang) ;; for escriptize
-                         ,@native-inputs
-                         ;; Keep the standard inputs of 'gnu-build-system'.
-                         ,@(standard-packages)))
-         (outputs outputs)
-         (build rebar-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
-
-(define* (rebar-build name inputs
-                       #:key
-                       guile source
-                       (rebar-flags ''("skip_deps=true" "-vv"))
-                       (tests? #t)
-                       (test-target "eunit")
-                       ;; TODO: install-name  ; default: based on guix package name
-                       (install-profile "default")
-                       (phases '(@ (guix build rebar-build-system)
-                                   %standard-phases))
-                       (outputs '("out"))
-                       (search-paths '())
-                       (native-search-paths '())
-                       (system (%current-system))
-                       (imported-modules %rebar-build-system-modules)
-                       (modules '((guix build rebar-build-system)
-                                  (guix build utils))))
+(define imported-modules
+  `((guix build rebar-build-system)
+    ,@%gnu-build-system-modules))
+
+(define (input->source input)
+  "Return a Source associated to the Input INPUT."
+  (match input
+    ((name package)
+     (list (pkg-name->library-directory-name name)
+           (package-source package)))))
+
+(define* (rebar-build name
+                      inputs
+                      #:key
+                      guile
+                      source
+                      (rebar-flags ''())
+                      (tests? #t)
+                      (test-target "eunit")
+                      ;; TODO: install-name  ; default: based on guix package name
+                      (install-profile "default")
+                      (phases '(@ (guix build rebar-build-system)
+                                  %standard-phases))
+                      (outputs '("out"))
+                      (search-paths '())
+                      (native-search-paths '())
+                      (system (%current-system))
+                      (imported-modules imported-modules)
+                      (modules '((guix build rebar-build-system)
+                                 (guix build utils)))
+                      (sources-erlang '()))
   "Build SOURCE with INPUTS."
 
   (define builder
@@ -122,35 +138,95 @@  (define* (rebar-build name inputs
           (use-modules #$@(sexp->gexp modules))
 
           #$(with-build-variables inputs outputs
+
               #~(rebar-build #:source #+source
-                      #:system #$system
-                      #:name #$name
-                      #:rebar-flags #$rebar-flags
-                      #:tests? #$tests?
-                      #:test-target #$test-target
-                      ;; TODO: #:install-name #$install-name
-                      #:install-profile #$install-profile
-                      #: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)))
+                             #:sources-erlang '#$sources-erlang
+                             #:system #$system
+                             #:name #$name
+                             #:rebar-flags #$rebar-flags
+                             #:tests? #$tests?
+                             #:test-target #$test-target
+                             ;; TODO: #:install-name #$install-name
+                             #:install-profile #$install-profile
+                             #: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)))
+
     ;; Note: Always pass #:graft? #f.  Without it, ALLOWED-REFERENCES &
     ;; co. would be interpreted as referring to grafted packages.
-    (gexp->derivation name builder
+    (gexp->derivation name
+                      builder
                       #:system system
                       #:target #f
                       #:graft? #f
                       #:guile-for-build guile)))
 
+(define* (lower name
+                      #:key
+                      (erlang (erlang-default))
+                      inputs
+                      native-inputs
+                      outputs
+                      (rebar (rebar-default))
+                      source
+                      system
+                      target
+                      #:allow-other-keys #:rest arguments)
+  "Return a bag for NAME from the given arguments."
+
+  (let* ((erlang-packages
+          (filter (lambda (input)
+                    (match input
+                      ((name _) (pkg-name? name))))
+                  (append inputs native-inputs)))
+
+         (erlang-sources (map input->source erlang-packages)))
+
+    (define private-keywords
+      '(#:target #:rebar #:erlang #:inputs #:native-inputs #:sources-erlang))
+
+    (and (not target) ;XXX: no cross-compilation
+         (bag (name name)
+              (system system)
+              (host-inputs inputs)
+              (build-inputs `(,@(standard-packages)
+                              ("erlang" ,erlang)
+                              ("rebar" ,rebar)
+                              ,@inputs
+                              ,@native-inputs))
+              (outputs outputs)
+              (build rebar-build)
+              (arguments (append (list #:sources-erlang erlang-sources)
+                                 (strip-keyword-arguments private-keywords
+                                                          arguments)))))))
+
 (define rebar-build-system
-  (build-system
-    (name 'rebar)
-    (description "The standard Rebar build system")
-    (lower lower)))
+  (build-system (name 'rebar)
+                (description "The standard Rebar build system")
+                (lower lower)))
+
+
+;;;
+;;; Exports
+;;;
+
+(define hexpm-package-url hexpm-tarballs)
+
+(define %rebar-build-system-modules imported-modules)
+
+
+;;; rebar.scm ends here
diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar-build-system.scm
index fb664228..b68348bd 100644
--- a/guix/build/rebar-build-system.scm
+++ b/guix/build/rebar-build-system.scm
@@ -2,6 +2,7 @@ 
 ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 ;;; Copyright © 2020, 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,125 +24,197 @@  (define-module (guix build rebar-build-system)
   #:use-module ((guix build utils) #:hide (delete))
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 string-fun)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (rebar-build
-            %standard-phases))
+  #:export (rebar-build %standard-phases))
 
 ;;
 ;; Builder-side code of the standard build procedure for Erlang packages using
 ;; rebar3.
 ;;
-;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and includedir
-;; "(include") need to be configurable
+;; Library directory
+;;   A « library directory » is a directory where Erlang searches for compiled
+;;   code. Its name should look like: `a_name-1.2.3' where the suffix `-1.2.3'
+;;   is optional. See: https://www.erlang.org/doc/man/code#code-path.
+;;
+;; Package name
+;;   A « package name » is the value of the name field of a package
+;;   definition. It looks like: `prefix-a-name-1.2.3'. See:
+;;   https://guix.gnu.org/manual/en/html_node/Package-Naming.html
+;;
+;; Profile
+;;   For Rebar3, a « profile » is a name associated to a set of configuration
+;;   settings overriding or complementing the regular configuration. See:
+;;   https://rebar3.org/docs/configuration/profiles
+;;
+;; Source
+;;   A « source » represents the source code associated to a Guix package as
+;;   defined by its `source' field. Here, the data sctructure used to
+;;   represent a source has the form `(list name path)' where `name' is a
+;;   library directory name and `path' is the store path where to find the
+;;   source code.
+;;
+;; Checkout
+;;   A « checkout » is a locally defined dependency related to a directory
+;;   managed by rebar.  See:
+;;   https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies
 
-(define %erlang-libdir "/lib/erlang/lib")
+(define sep "/")
 
-(define* (erlang-depends #:key inputs #:allow-other-keys)
-  (define input-directories
-    (match inputs
-      (((_ . dir) ...)
-       dir)))
-  (mkdir-p "_checkouts")
-
-  (for-each
-   (lambda (input-dir)
-     (let ((elibdir (string-append input-dir %erlang-libdir)))
-       (when (directory-exists? elibdir)
-         (for-each
-          (lambda (dirname)
-            (let ((dest (string-append elibdir "/" dirname))
-                  (link (string-append "_checkouts/" dirname)))
-              (when (not (file-exists? link))
-                ;; RETHINK: Maybe better copy and make writable to avoid some
-                ;; error messages e.g. when using with rebar3-git-vsn.
-                (symlink dest link))))
-          (list-directories elibdir)))))
-   input-directories))
+;; Where Erlang libraries are installed relative to a package path in the store.
+(define lib-erlang-lib "lib/erlang/lib")
+
+(define (list-directories directory)
+  "Return file names of the sub-directory of DIRECTORY."
+  (scandir directory
+           (lambda (file)
+             (and (not (member file '("." "..")))
+                  (file-is-directory? (string-append directory sep file))))))
+
+(define* (pkg-name->libdir-name name)
+  "Return the library name deduced from the Erlang package name NAME."
+  (let* ((suffix (regexp-substitute #f (string-match "^erlang-(.*)" name) 1))
+         (elements (string-split suffix #\-)))
+    (string-append (string-join (drop-right elements 1) "_") "-" (last elements))))
+
+(define (libdir-name->prefix name)
+  "Return the prefix of a library directory name NAME."
+  (car (string-split name #\-)))
+
+(define (rebar-build-dir profile)
+  "Return the path where rebar builds libraries given the profile PROFILE."
+  (format #f "_build/~a/lib" profile))
+
+(define* (pkg-name->build-dir name #:key (profile "default"))
+  "Return the path of library directory where rebar3 builds code of an Erlang package named NAME given the profile PROFILE."
+  (string-append (rebar-build-dir profile) sep (libdir-name->prefix (pkg-name->libdir-name name))))
 
 (define* (unpack #:key source #: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)
-    ;; Packages from hex.pm typically have a contents.tar.gz containing the
-    ;; actual source. If this tar file exists, extract it.
-    (when (file-exists? "contents.tar.gz")
-      (invoke "tar" "xvf" "contents.tar.gz"))))
-
-(define* (build #:key (rebar-flags '()) #:allow-other-keys)
+  (if (file-is-directory? source)
+      ;; If source is a checkout:
+      (begin
+        ;; Preserve timestamps (set to the Epoch) on the copied tree so that
+        ;; things work deterministically.
+        (copy-recursively source "." #:keep-mtime? #t)
+        ;; Make the source checkout files writable, for convenience.
+        (for-each (lambda (f)
+                    (false-if-exception (make-file-writable f)))
+                  (find-files ".")))
+
+      ;; If source is an hex.pm archive:
+      (begin
+        (invoke "tar" "xvf" source)
+        (invoke "tar" "xvf" "contents.tar.gz")
+
+        ;; Prevent an error message during the install phase.
+        ;;   `rebar3 compile' produces symlinks like so in _build/:
+        ;;      priv -> ../../../../priv
+        ;;      include -> ../../../../include
+        ;;
+        ;;   The install phase copies whatever has been built to the output directory.
+        ;;   If the priv/ directory is absent, then an error `i/o error:
+        ;;   _build/…/priv: No such file or directory' occurs. So, we make sure that a
+        ;;   directory exists.
+        (for-each (lambda (dir) (mkdir-p dir)) (list "priv" "include")))))
+
+(define (configure-HOME . ignored_args)
+  "In some cases, it is needed for the environment variable HOME to be defined
+as a directory with write permission. Examples of errors:
+
+Could not write to \"/homeless-shelter/.cache/rebar3/hex\". Please ensure the path is writeable.
+"
+  (let ((HOME "HOME")
+        (tmp "/tmp"))
+    (setenv HOME tmp)
+    (format #t "~a=~a\n" HOME tmp)))
+
+(define* (configure-dependencies #:key
+                                 (install-profile "default")
+                                 inputs
+                                 name
+                                 sources-erlang ;List of Source.
+                                 version
+                                 #:allow-other-keys)
+  "Rebar3 refuses to compile without network access unless its dependencies are
+present as source checkouts. To prevent unnecessary compilations, we must «
+pre-install » dependencies in Rebar's build directory."
+
+  ;; If source in sources-erlang, then install it under _checkouts/.
+  (let ((_checkouts "_checkouts"))
+    (mkdir-p _checkouts)
+
+    (define (install-source source)
+      "Install the Source SOURCE in _checkouts."
+      (match source
+        ((name path)
+         (let ((src (string-append _checkouts sep name)))
+           (mkdir-p src)
+           (with-directory-excursion src (unpack #:source path))))
+        (_ #f)))
+
+    (for-each install-source sources-erlang))
+
+  ;; If input in inputs is an Erlang package, then install it under _build/.
+  (let ((_build (format #f "_build/~a/checkouts" install-profile)))
+    (mkdir-p _build)
+
+    (define (install-libdir elib name dest)
+      "Install the library directory named NAME from ELIB to DEST."
+      (let ((src (string-append elib sep name))
+            (dest (string-append dest sep (libdir-name->prefix name))))
+        (copy-recursively src dest)
+        (mkdir-p (string-append dest "/priv"))))
+
+    (define (install-all-libdirs dir dest)
+      "Install in DEST all library directories in DIR."
+      (let ((elib (string-append dir sep lib-erlang-lib)))
+        (when (directory-exists? elib)
+          (for-each (lambda (name) (install-libdir elib name dest))
+                    (list-directories elib)))))
+
+    (match inputs
+      (((_ . dirs) ..1)
+       (for-each
+        (lambda (dir) (install-all-libdirs dir _build))
+        dirs))
+      (_ #f))))
+
+(define* (build #:key name (rebar-flags '()) #:allow-other-keys)
   (apply invoke `("rebar3" "compile" ,@rebar-flags)))
 
-(define* (check #:key target (rebar-flags '()) (tests? (not target))
+(define* (check #:key target
+                (rebar-flags '())
+                (tests? (not target))
                 (test-target "eunit")
                 #:allow-other-keys)
   (if tests?
       (apply invoke `("rebar3" ,test-target ,@rebar-flags))
       (format #t "test suite not run~%")))
 
-(define (erlang-package? name)
-  "Check if NAME correspond to the name of an Erlang package."
-  (string-prefix? "erlang-" name))
-
-(define (package-name-version->erlang-name name+ver)
-  "Convert the Guix package NAME-VER to the corresponding Erlang name-version
-format.  Essentially drop the prefix used in Guix and replace dashes by
-underscores."
-  (let* ((name- (package-name->name+version name+ver)))
-    (string-join
-     (string-split
-      (if (erlang-package? name-)  ; checks for "erlang-" prefix
-          (string-drop name- (string-length "erlang-"))
-          name-)
-      #\-)
-     "_")))
-
-(define (list-directories directory)
-  "Return file names of the sub-directory of DIRECTORY."
-  (scandir directory
-           (lambda (file)
-             (and (not (member file '("." "..")))
-                  (file-is-directory? (string-append directory "/" file))))))
-
-(define* (install #:key name outputs
-                  (install-name (package-name-version->erlang-name name))
-                  (install-profile "default") ; build profile outputs to install
-                  #:allow-other-keys)
-  (let* ((out (assoc-ref outputs "out"))
-         (pkg-dir (string-append out %erlang-libdir "/" install-name)))
-    (let ((bin-dir (string-append "_build/" install-profile "/bin"))
-          (lib-dir (string-append "_build/" install-profile "/lib")))
-      ;; install _build/PROFILE/bin
-      (when (file-exists? bin-dir)
-        (copy-recursively bin-dir out #:follow-symlinks? #t))
-      ;; install _build/PROFILE/lib/*/{ebin,include,priv}
-      (for-each
-       (lambda (*)
-         (for-each
-          (lambda (dirname)
-            (let ((src-dir (string-append lib-dir "/" * "/" dirname))
-                  (dst-dir (string-append pkg-dir "/" dirname)))
-              (when (file-exists? src-dir)
-                (copy-recursively src-dir dst-dir #:follow-symlinks? #t))
-              (false-if-exception
-               (delete-file (string-append dst-dir "/.gitignore")))))
-          '("ebin" "include" "priv")))
-       (list-directories lib-dir))
-      (false-if-exception
-       (delete-file (string-append pkg-dir "/priv/Run-eunit-loop.expect"))))))
+(define* (install #:key name outputs (install-profile "default") #:allow-other-keys)
+  (let* ((src (pkg-name->build-dir name #:profile install-profile))
+         (dest (string-append (assoc-ref outputs "out")
+                              sep lib-erlang-lib sep
+                              (pkg-name->libdir-name name))))
+    (mkdir-p dest)
+    (copy-recursively src dest #:follow-symlinks? #t)))
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
     (replace 'unpack unpack)
+    (add-after 'unpack 'configure-HOME configure-HOME)
     (delete 'bootstrap)
     (delete 'configure)
-    (add-before 'build 'erlang-depends erlang-depends)
+    (add-before 'build 'configure-dependencies configure-dependencies)
     (replace 'build build)
     (replace 'check check)
     (replace 'install install)))
 
-(define* (rebar-build #:key inputs (phases %standard-phases)
-                      #:allow-other-keys #:rest args)
+(define* (rebar-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args)
   "Build the given Erlang package, applying all of PHASES in order."
   (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; rebar-build-system.scm ends here