01/03: gnu: cuirass: Simplify ‘wrap-program’ phase.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 2588fb98f0a99dc90aa70b45039b56a15d1f6cb1
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Oct 12 21:59:37 2023 +0200

    gnu: cuirass: Simplify ‘wrap-program’ phase.
    
    * gnu/packages/ci.scm (cuirass)[arguments]: Add (srfi srfi-1) and (ice-9
    match) to #:modules.  Rewrite ‘wrap-program’ phase to iterate over
    INPUTS and select the subset that actually provides Guile modules.
---
 gnu/packages/ci.scm | 61 ++++++++++++++++++++++-------------------------------
 1 file changed, 25 insertions(+), 36 deletions(-)

diff --git a/gnu/packages/ci.scm b/gnu/packages/ci.scm
index 8d386140a9..fb6ad49a41 100644
--- a/gnu/packages/ci.scm
+++ b/gnu/packages/ci.scm
@@ -77,8 +77,10 @@
       (arguments
        `(#:modules ((guix build utils)
                     (guix build gnu-build-system)
+                    (ice-9 match)
                     (ice-9 rdelim)
-                    (ice-9 popen))
+                    (ice-9 popen)
+                    (srfi srfi-1))
          #:configure-flags '("--localstatedir=/var") ;for /var/log/cuirass
          ;; XXX: HTTP tests fail on aarch64 due to Fibers errors, disable them
          ;; on that architecture for now.
@@ -98,47 +100,34 @@
            (add-after 'install 'wrap-program
              (lambda* (#:key inputs outputs #:allow-other-keys)
                ;; Wrap the 'cuirass' command to refer to the right modules.
+               ;; Do so by collecting the subset of INPUTS that provides Guile
+               ;; modules.  This includes direct inputs as well as their
+               ;; propagated inputs--e.g., 'guix' propagates 'guile-zstd'.
+               (define (sub-directory suffix)
+                 (match-lambda
+                   ((label . directory)
+                    (let ((directory (string-append directory suffix)))
+                      (and (directory-exists? directory)
+                           directory)))))
+
                (let* ((out    (assoc-ref outputs "out"))
-                      (avahi  (assoc-ref inputs "guile-avahi"))
-                      (gcrypt (assoc-ref inputs "guile-gcrypt"))
-                      (json   (assoc-ref inputs "guile-json"))
-                      (zmq    (assoc-ref inputs "guile-simple-zmq"))
-                      (squee  (assoc-ref inputs "guile-squee"))
-                      (git    (assoc-ref inputs "guile-git"))
-                      (bytes  (assoc-ref inputs "guile-bytestructures"))
-                      (fibers (assoc-ref inputs "guile-fibers"))
-                      (zlib   (assoc-ref inputs "guile-zlib"))
-                      (matd   (assoc-ref inputs "guile-mastodon"))
-                      (tls    (assoc-ref inputs "guile-gnutls"))
-                      (mail   (assoc-ref inputs "mailutils"))
-                      (guix   (assoc-ref inputs "guix"))
-                      (deps   (list avahi gcrypt json zmq squee git bytes
-                                    fibers zlib matd tls mail guix))
-                      (guile  (assoc-ref inputs "guile"))
                       (effective
                        (read-line
-                        (open-pipe* OPEN_READ
-                                    (string-append guile "/bin/guile")
+                        (open-pipe* OPEN_READ (which "guile")
                                     "-c" "(display (effective-version))")))
-                      (mods
-                       (string-drop-right  ;drop trailing colon
-                        (string-join deps
-                                     (string-append "/share/guile/site/"
-                                                    effective ":")
-                                     'suffix)
-                        1))
-                      (objs
-                       (string-drop-right
-                        (string-join deps
-                                     (string-append "/lib/guile/" effective
-                                                    "/site-ccache:")
-                                     'suffix)
-                        1)))
-                 ;; Make sure 'cuirass' can find the relevant Guile modules.
+                      (mods   (filter-map (sub-directory
+                                           (string-append "/share/guile/site/"
+                                                          effective))
+                                          inputs))
+                      (objs   (filter-map (sub-directory
+                                           (string-append "/lib/guile/"
+                                                          effective
+                                                          "/site-ccache"))
+                                          inputs)))
                  (wrap-program (string-append out "/bin/cuirass")
                    `("PATH" ":" prefix (,(string-append out "/bin")))
-                   `("GUILE_LOAD_PATH" ":" prefix (,mods))
-                   `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,objs)))))))))
+                   `("GUILE_LOAD_PATH" ":" prefix ,mods)
+                   `("GUILE_LOAD_COMPILED_PATH" ":" prefix ,objs))))))))
       (inputs
        (list guile-3.0-latest
              guile-avahi