channels: Resolve dependencies recursively.

* guix/channels.scm (closure): New procedure.
(resolve-dependencies): Use it.
* tests/channels.scm ("channel-instance-dependency-resolver"): New test.

Fixes: https://issues.guix.gnu.org/68797
Change-Id: Iaba4f54261e33e18bd57a0a319aa099f259b8570
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Merges: #7137

guix/channels.scm

@@ -50,6 +50,7 @@
   #:use-module (guix diagnostics)
   #:use-module (guix store)
   #:use-module (guix i18n)
+  #:autoload   (guix sets) (setq set-insert set-contains?)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
@@ -91,6 +92,8 @@
             channel-instance-channel
             channel-instance-commit
             channel-instance-checkout
+            channel-instance-dependencies
+            (resolve-dependencies . channel-instance-dependency-resolver)
 
             authenticate-channel
             latest-channel-instances
@@ -791,9 +794,24 @@ during this process."
                      #:built-in-builders
                      built-in-builders))
 
+(define (closure node edge)
+  "Return the closure of NODE following EDGE, a one-argument procedure, but
+not NODE itself."
+  (let loop ((nodes (edge node))
+             (visited (setq))
+             (result '()))
+    (match nodes
+      (() result)
+      ((head . tail)
+       (if (set-contains? visited head)
+           (loop tail visited result)
+           (loop (append (edge head) tail)
+                 (set-insert head visited)
+                 (cons head result)))))))
+
 (define (resolve-dependencies instances)
   "Return a procedure that, given one of the elements of INSTANCES, returns
-list of instances it depends on."
+list of instances it depends on, recursively."
   (define channel-instance-name
     (compose channel-name channel-instance-channel))
 
@@ -817,7 +835,13 @@ list of instances it depends on."
           instances))
 
   (lambda (instance)
-    (vhash-foldq* cons '() instance edges)))
+    ;; Return both direct and indirect dependencies of INSTANCE.  That way, if
+    ;; INSTANCE uses a module of one of its direct dependencies, which in turn
+    ;; uses a module of an indirect dependency, INSTANCE will has access to
+    ;; the module of that indirect dependency.
+    (closure instance
+             (lambda (instance)
+               (vhash-foldq* cons '() instance edges)))))
 
 (define* (channel-instance-derivations instances #:key system
                                        built-in-builders)

tests/channels.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2020, 2022, 2024, 2026 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -278,6 +278,61 @@
                                       #:current-channels (list new)
                                       #:validate-pull validate-pull)))))))
 
+(test-equal "channel-instance-dependency-resolver"
+  '((c => (a b)) (b => (a)) (a => ()))
+  ;; Check that channel dependencies propagate.  Here we create three channels
+  ;; that depend on one another: c depends on b, which depends on a.  When
+  ;; resolving dependencies for c, we must get both a and b, such that
+  ;; (use-modules (b)) from channel c finds (a) when building the derivation
+  ;; of channel c.  See <https://issues.guix.gnu.org/68797>.
+  (let ((call-with-channel
+         (lambda (name dependencies channels proc)
+           (with-temporary-git-repository directory
+               `((add ,(string-append (symbol->string name) ".scm")
+                      ,(object->string
+                        `(define-module (,name)
+                           ,@(append-map (lambda (dependency)
+                                           `(#:use-module (,dependency)))
+                                         dependencies))))
+                 (add ".guix-channel"
+                      ,(object->string
+                        `(channel
+                           (version 0)
+                           (dependencies
+                            ,@(map (lambda (dependency)
+                                     `(channel
+                                        (name ,dependency)
+                                        (url "http://example.org")))
+                                   dependencies)))))
+                 (commit "Initial commit."))
+             (proc (cons (channel
+                           (name name)
+                           (url directory))
+                         channels))))))
+    (define-syntax with-channels
+      (syntax-rules (&initialized)
+        ((_ &initialized binding (name dependencies) rest ... exp)
+         (call-with-channel 'name dependencies binding
+                            (lambda (binding)
+                              (with-channels &initialized binding
+                                             rest ... exp))))
+        ((_ &initialized binding exp) exp)
+        ((_ binding rest ...)
+         (let ((binding '()))
+           (with-channels &initialized binding rest ...)))))
+
+    (with-channels
+     channels (a '()) (b '(a)) (c '(b))
+     (with-store store
+       (let* ((instances (latest-channel-instances store channels))
+              (resolve (channel-instance-dependency-resolver instances)))
+         (map (lambda (instance)
+                (list (channel-name (channel-instance-channel instance))
+                      '=>
+                      (map (compose channel-name channel-instance-channel)
+                           (resolve instance))))
+              instances))))))
+
 (test-assert "channel-instances->manifest"
   ;; Compute the manifest for a graph of instances and make sure we get a
   ;; derivation graph that mirrors the instance graph.  This test also ensures