[bug#66801,1/5] guix: build-system: rebar: build Erlang packages with dependencies.

Change-Id: Ie221d47fd1c9a766c2e2cdf76460ddfdf65e090d
---
 guix/build-system/rebar.scm       | 223 ++++++++++++++++++++++--------
 guix/build/rebar-build-system.scm |  43 +++---
 2 files changed, 189 insertions(+), 77 deletions(-)

Am Mittwoch, dem 08.11.2023 um 10:22 +0100 schrieb Pierre-Henry
Fröhring:
> Change-Id: Ie221d47fd1c9a766c2e2cdf76460ddfdf65e090d
> ---
Missing the ChangeLog :)

Also, don't forget to add me to CC so that I can see the changes more
easily.

>  guix/build-system/rebar.scm       | 223 ++++++++++++++++++++++------
> --
>  guix/build/rebar-build-system.scm |  43 +++---
>  2 files changed, 189 insertions(+), 77 deletions(-)
> 
> diff --git a/guix/build-system/rebar.scm b/guix/build-
> system/rebar.scm
> index de1294ec..cdff85a6 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,20 +19,120 @@
>  ;;; 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)
> +  #:use-module (guix store)
> +  #:use-module (guix utils)
> +  #:use-module (srfi srfi-1)
> +  #:use-module (srfi srfi-26)
>    #:export (hexpm-uri
>              hexpm-package-url
>              %rebar-build-system-modules
>              rebar-build
>              rebar-build-system))
>  
> +
> +;;;
> +;;; Utils
> +;;;
> +
> +(define (flatten lst) (fold append '() lst))
You use this procedure once and you can probably replace it with
append-map from SRFI-1.

> +;;;
> +;;; Packages
> +;;;
> +
> +(define %erlang-package-prefix "erlang-")
> +
> +(define (erlang-package-name? name)
> +  "Indicates if NAME is an Erlang package name.
> +If a package name starts with %erlang-package-prefix, then it is an
> Erlang package name.
> +An Erlang package name must start with %erlang-package-prefix."
> +  (string-prefix? %erlang-package-prefix name))
> +
> +(define (hexpm-name pkg-name)
> +  "Given a package name PKG-NAME, returns the corresponding hex.pm
> package name."
> +  (let ((suffix (string-drop pkg-name (string-length %erlang-
> package-prefix))))
> +    (string-replace-substring suffix "-" "_")))
> +
> +(define (all-transitive-inputs pkg pred)
> +  "Given a package PKG and a predicate PRED, return all transitive
> inputs of PKG
> +that match the predicate PRED."
> +  (delete-duplicates
> +   (append
> +    (filter pred (package-transitive-inputs pkg))
> +    (filter pred (package-transitive-native-inputs pkg))
> +    (filter pred (package-transitive-propagated-inputs pkg)))
> +   input=?))
We already have package-direct-inputs.  Instead of matching labels, you
might want to match package names instead anyway.

> +
> +;;;
> +;;; Input
> +;;;
> +
> +(define (input-mk name package)
> +  "Build an Input."
> +  (list name package))
> +
> +(define (input->name input)
> +  "Return the name of INPUT."
> +  (car input))
> +
> +(define (input->package input)
> +  "Return the package of INPUT."
> +  (cadr input))
You shouldn't define such destructuring procedures.  Use (ice-9 match)
where needed.

> +(define (input=? i1 i2)
> +  "Test whether Inputs I1 and I2 are equal."
> +  (string=? (input->name i1) (input->name i2)))
Yeah, don't compare labels.

> +(define (erlang-input? input)
> +  "Test whether INPUT is an Erlang Input."
> +  (erlang-package-name? (input->name input)))
> +
> +(define (input->all-inputs input pred)
> +  "Return the list of implicit satisfying PRED Inputs associated to
> INPUT, including INPUT."
> +  (cons input (all-transitive-inputs (input->package input) pred)))
> +
> +(define (inputs->all-erlang-inputs erlang-inputs)
> +  "Return a list of implicit Erlang Inputs associated to INPUT,
> including INPUT."
> +  (let ((all-inputs (flatten (map (cut input->all-inputs <> erlang-
> package-name?) erlang-inputs))))
> +    (delete-duplicates all-inputs input=?)))
The name, arguments, and docstring of this function do not match in any
way.  Consider expressing yourself in terms of known Guile functions.  

  (define (transitive-erlang-inputs inputs)
    (define (erlang-inputs inputs)
      (filter-map
        (match-lambda ((name package . output)
                       (and (erlang-package-name?) 
                            (cons* name package output))))
        inputs))
    (delete-duplicates
      (append-map erlang-inputs 
                  (append-map
                   package-transitive-inputs
                   (map cadr inputs)))))

Note that there's almost certainly a smarter way than nesting two
append-maps, but am currently too lazy to look that up.

> +
> +;;;
> +;;; Source
> +;;;
> +
> +(define (source-mk name origin)
> +  "Build a source.
> +NAME is an hex.pm package name.
> +ORIGIN is an Origin."
> +  (list name origin))
> +
> +(define (source->name source)
> +  "Return the name of SOURCE."
> +  (car source))
> +
> +(define (source->origin source)
> +  "Return the origin of SOURCE."
> +  (cadr source))
> +
> +(define (source=? s1 s2)
> +  "Test whether Sources S1 and S2 are equal."
> +  (string=? (source->name s1) (source->name s2)))
> +
> +(define (input->source input)
> +  "Given an Input INPUT, return its associated Source."
> +  (source-mk (hexpm-name (input->name input))
> +             (package-source (input->package input))))
Again, use ice-9 match instead of manually defining all those
destructuring procedures.

> +
>  ;;;
>  ;;; Definitions for the hex.pm repository,
>  ;;;
> @@ -44,10 +145,11 @@ (define %hexpm-repo-url
>  (define hexpm-package-url
>    (string-append (%hexpm-repo-url) "/tarballs/"))
>  
> -(define (hexpm-uri name version)
> +(define (hexpm-uri pkg-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"))
> +  (let ((name (if (erlang-package-name? pkg-name) (hexpm-name pkg-
> name) pkg-name)))
> +    (string-append hexpm-package-url name "-" version ".tar")))
>  
>  ;;
>  ;; Standard build procedure for Erlang packages using Rebar.
> @@ -78,42 +180,50 @@ (define* (lower name
>                  #: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)))))
> +    '(#:target #:rebar #:erlang #:inputs #:native-inputs #:erlang-
> sources))
> +
> +  (let* ((inputs-all (append inputs native-inputs))
> +         (erlang-inputs (filter erlang-input? inputs-all))
> +         (all-erlang-inputs (inputs->all-erlang-inputs erlang-
> inputs))
> +         (all-erlang-sources (map input->source all-erlang-inputs)))
Instead of let-binding these, you might want to define a procedure
(erlang-sources inputs native-inputs) and then use that for #:erlang-
sources.

> +    (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
> +                           ,@inputs
> +                           ,@native-inputs
> +                           ;; Keep the standard inputs of 'gnu-
> build-system'.
> +                           ,@(standard-packages)))
> +           (outputs outputs)
> +           (build rebar-build)
> +           (arguments (append (list #:erlang-sources all-erlang-
> sources)
> +                              (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))))
> +                      #: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 '())
> +                      (erlang-sources '())
> +                      (system (%current-system))
> +                      (imported-modules %rebar-build-system-modules)
> +                      (modules '((guix build rebar-build-system)
> +                                 (guix build utils))))
>    "Build SOURCE with INPUTS."
>  
>    (define builder
> @@ -123,21 +233,22 @@ (define* (rebar-build name inputs
>  
>            #$(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)))))
> +                             #: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
> +                             #:erlang-sources '#$erlang-sources)))))
>  
>    (mlet %store-monad ((guile (package->derivation (or guile
> (default-guile))
>                                                    system #:graft?
> #f)))
> diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar-
> build-system.scm
> index fb664228..286e4e1a 100644
> --- a/guix/build/rebar-build-system.scm
> +++ b/guix/build/rebar-build-system.scm
> @@ -28,6 +28,13 @@ (define-module (guix build rebar-build-system)
>    #:export (rebar-build
>              %standard-phases))
>  
> +;;
> +;; Utils
> +;;
> +
> +(define sep file-name-separator-string)
How about no?

> +
>  ;;
>  ;; Builder-side code of the standard build procedure for Erlang
> packages using
>  ;; rebar3.
> @@ -37,27 +44,20 @@ (define-module (guix build rebar-build-system)
>  
>  (define %erlang-libdir "/lib/erlang/lib")
>  
> -(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))
> +(define (configure-environment . _)
> +  (setenv "REBAR_CACHE_DIR" (getcwd)))
How about simply naming this configure, so that you can use replace
instead of add-after + delete below?

> +(define* (erlang-depends #:key erlang-sources #:allow-other-keys)
> +  (let ((checkouts "_checkouts"))
> +    (mkdir-p checkouts)
> +    (for-each (lambda (source)
> +                (match source
> +                  ((name archive)
> +                   (let ((libdir (string-append checkouts sep
> name)))
Alternatively add a slash (/) to checkouts ;)
> +                     (mkdir-p libdir)
> +                     (with-directory-excursion libdir
> +                       (unpack #:source archive))))))
> +              erlang-sources)))
This loses the previous erlang-depends logic, which unpackaged the
already compiled packages.  I really don't think we should have erlang
be yet another rust that heats up the planet compiling leftpad over and
over again.  Can we somehow have that cake?

>  (define* (unpack #:key source #:allow-other-keys)
>    "Unpack SOURCE in the working directory, and change directory
> within the
> @@ -134,6 +134,7 @@ (define* (install #:key name outputs
>  (define %standard-phases
>    (modify-phases gnu:%standard-phases
>      (replace 'unpack unpack)
> +    (add-after 'unpack 'configure-environment configure-environment)
>      (delete 'bootstrap)
>      (delete 'configure)
>      (add-before 'build 'erlang-depends erlang-depends)

Cheers

This loses the previous erlang-depends logic, which unpackaged the
      already compiled packages.  I really don't think we should have
erlang be
      yet another rust that heats up the planet compiling leftpad over and
over
      again.  Can we somehow have that cake?

Okay, perhaps it would have been better to start working on the Mix
building system
and inform you simultaneously, instead of sending patches all at once. So,
let's
start anew.

I have taken into account all of your suggestions and have crafted this
patch
introducing the mix-build-system. Yes, there are ChangeLogs now. Currently,
the
"Machete" package is compiled and tested without repeatedly compiling
leftpad — i.e.,
considering pure Elixir packages up to transitive dependencies, it works as
expected. This is new.

As I'm learning how all this works, I'm not entirely sure that updating the
rebar
build system is absolutely necessary. I suppose we will understand more as
we add an
increasing number of Elixir packages, especially when incorporating Elixir
packages
with Erlang dependencies.

So, here's what's coming up:

1. A patch that introduces the mix-build-system variable.
2. Several patches that introduce Elixir packages, up to elixir-machete,
which is one
   of the few packages that includes tests in the tarball.

I guess the next steps are as follows:

1. To determine if the approach is acceptable. Will we boil the world by
compiling
   left-pad endlessly?
2. If the approach is deemed acceptable, the next step is to evaluate the
code. Is
   the code riddled with delicious regexes?
3. If the first two points are verified, it might be worthwhile to continue
   developing this implementation until Phoenix is successfully compiled
and tested
   as expected.

For reference, I have attached a file named `mix-build-system.org'.
This file contains a description of a prototype in Bash that
illustrates the approach taken in this patch.

Cheers.