From patchwork Sun Oct 29 14:36:54 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Pierre-Henry_Fr=C3=B6hring?= X-Patchwork-Id: 55525 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0A3B827BBE9; Sun, 29 Oct 2023 14:40:45 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 4FE6827BBE2 for ; Sun, 29 Oct 2023 14:40:41 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qx6xr-0003sa-NT; Sun, 29 Oct 2023 10:40:31 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qx6xp-0003rs-VA for guix-patches@gnu.org; Sun, 29 Oct 2023 10:40:30 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qx6xp-0003DU-MH for guix-patches@gnu.org; Sun, 29 Oct 2023 10:40:29 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qx6yM-0007Wt-8O for guix-patches@gnu.org; Sun, 29 Oct 2023 10:41:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#66801] [PATCH va3e5ae0f..37252e07 01/32] rebar-build-system and packages. References: <68117eb2b3e0e6adcc7449d878e602c7b831ffee.1698524350.git.phfrohring@deeplinks.com> In-Reply-To: <68117eb2b3e0e6adcc7449d878e602c7b831ffee.1698524350.git.phfrohring@deeplinks.com> Resent-From: Pierre-Henry =?utf-8?b?RnLDtmhyaW5n?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 29 Oct 2023 14:41:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66801 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 66801@debbugs.gnu.org Cc: Pierre-Henry =?utf-8?b?RnLDtmhyaW5n?= Received: via spool by 66801-submit@debbugs.gnu.org id=B66801.169859045128890 (code B ref 66801); Sun, 29 Oct 2023 14:41:02 +0000 Received: (at 66801) by debbugs.gnu.org; 29 Oct 2023 14:40:51 +0000 Received: from localhost ([127.0.0.1]:42971 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qx6yA-0007Vt-0c for submit@debbugs.gnu.org; Sun, 29 Oct 2023 10:40:51 -0400 Received: from mail-wr1-x42a.google.com ([2a00:1450:4864:20::42a]:47233) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qx6y4-0007VZ-BJ for 66801@debbugs.gnu.org; Sun, 29 Oct 2023 10:40:48 -0400 Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-32f70391608so1381069f8f.2 for <66801@debbugs.gnu.org>; Sun, 29 Oct 2023 07:40:11 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=deeplinks-com.20230601.gappssmtp.com; s=20230601; t=1698590405; x=1699195205; darn=debbugs.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=e3X/KGKBdprnxuCcHeUoA4MLN/PTMXO40uBqWL0dc18=; b=VxBSz+fEi7OfYdY6voLu12LmNtpSdtXU+/N6FuAOyJv80unUZCg1W25fnR+0CLZsqO Y3ozFnoW7Betkan8mjKDVXKZ1qGc0HomYSppkrLp81+GezUvahMTNKO0mZdKWrmlU07E 99FuXUpFpGBLlwb6rmwPbcubL3cU0meDB7Wz5O0Vhx1VdqrodabqsAB4qC4OwheHXPav PFgqTeDowAbmJhbun3TnEakwTnLkbpYzOt+ieJy5NQkX42MtHh7MfRKUcEPcfXSpCtxS auICwR9DQIrkTjJW51VAsLlJskqzGeHPYk1/4+ZzSZQUnGR9x7Ono0Y3KeMqnJUaXEPs xNog== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1698590405; x=1699195205; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=e3X/KGKBdprnxuCcHeUoA4MLN/PTMXO40uBqWL0dc18=; b=Us2QXThWXgHvO3o887G7xTZO/a9iEuu7z4I38CxnzULqWDk/mZZ9dI0+/XJIwFiD+g KyEWFL93lBxcuN6vFTCgPvuK7capG5k2qIPMQPf+6lQ4xG1f+h2MCo9hvU8bLEAoiBt6 hflPwsH1C/kfJKbyRE7ouEjJ18CcDvxgBGAcpAAsqUF56ai710brdJEHG/kCtTKZcE9u 5OCahhhplxEfwDmft3L+fNDjeBX1uNd6WtX6+Aj2wnM3n5ZVFphrpqXseHaU1naRv0QH 4sgmWSvOhHVVyG/UVGWT2JQdd5DXN91z8Bmp0JkPKEYyZ0o+SLuqqnZJouKDXKXueS56 uVOQ== X-Gm-Message-State: AOJu0YwfxP5n8ZfzPzLgXaxuBi/J1e4L5Ine312gQ2AynxaXW3PmezTA wPi/3SoSW9Ffleafi/kUk+vjq+vL9bBDJveb6qI= X-Google-Smtp-Source: AGHT+IHQG9LKfQvW6jV4ZFyqjJgPIkqfuyzXAPZFBGxlpTEzTgC4VFQz7yEYT5Q6cnsX8593TL983A== X-Received: by 2002:adf:e7d0:0:b0:32d:a0a9:4785 with SMTP id e16-20020adfe7d0000000b0032da0a94785mr6114282wrn.7.1698590405098; Sun, 29 Oct 2023 07:40:05 -0700 (PDT) Received: from doug.com ([2a01:e34:ec69:c8b0:530e:366:bd55:7769]) by smtp.gmail.com with ESMTPSA id s10-20020a5d69ca000000b00323287186aasm6059590wrw.32.2023.10.29.07.40.04 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 29 Oct 2023 07:40:04 -0700 (PDT) From: Pierre-Henry =?utf-8?b?RnLDtmhyaW5n?= Date: Sun, 29 Oct 2023 15:36:54 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 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 ;;; Copyright © 2020 Hartmut Goebel +;;; Copyright © 2023 Pierre-Henry Fröhring ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,102 +19,117 @@ ;;; along with GNU Guix. If not, see . (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 ) where: is a string representing +;; the name of a library directory and 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 ;;; Copyright © 2019 Björn Höfling ;;; Copyright © 2020, 2022 Hartmut Goebel +;;; Copyright © 2023 Pierre-Henry Fröhring ;;; ;;; 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