[bug#47989] [PATCH] channels: Add a #:system argument to channel-instances->manifest.

[Christopher Baines <mail@cbaines.net>]

This allows computing a manifest for a specific system. Previously this was
possible, but only through changing %current-system, which caused the
derivation to be computed using that system as well (so computing a derivation
for aarch64-linux on x86_64-linux would require running aarch64-linux code).

This new argument adds the possibility of computing derivations for non-native
systems, without having to run non-native code.

I'm looking at this as it will enable the Guix Data Service to compute channel
instance derivations without relying on QEMU emulation for non-native
systems (it should be faster as well).

* guix/channels.scm (build-from-source): Add #:system argument and pass to
build.
(build-channel-instance): Add system argument and pass to build-from-source.
(channel-instance-derivations): Add #:system argument and pass to
build-channel-instance, also rename system to current-system-value.
(channel-instances->manifest): Add #:system argument and pass to
channel-instance-derivations.
---
 guix/channels.scm | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index c40fc0c507..70a09e74ff 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -657,7 +657,7 @@ that unconditionally resumes the continuation."
               store))))
 
 (define* (build-from-source instance
-                            #:key core verbose? (dependencies '()))
+                            #:key core verbose? (dependencies '()) system)
   "Return a derivation to build Guix from INSTANCE, using the self-build
 script contained therein.  When CORE is true, build package modules under
 SOURCE using CORE, an instance of Guix."
@@ -700,20 +700,22 @@ SOURCE using CORE, an instance of Guix."
           (with-trivial-build-handler
            (build source
                   #:verbose? verbose? #:version commit
+                  #:system system
                   #:channel-metadata (channel-instance->sexp instance)
                   #:pull-version %pull-version))))
 
       ;; Build a set of modules that extend Guix using the standard method.
       (standard-module-derivation name source core dependencies)))
 
-(define* (build-channel-instance instance
+(define* (build-channel-instance instance system
                                  #:optional core (dependencies '()))
   "Return, as a monadic value, the derivation for INSTANCE, a channel
 instance.  DEPENDENCIES is a list of extensions providing Guile modules that
 INSTANCE depends on."
   (build-from-source instance
                      #:core core
-                     #:dependencies dependencies))
+                     #:dependencies dependencies
+                     #:system system))
 
 (define (resolve-dependencies instances)
   "Return a procedure that, given one of the elements of INSTANCES, returns
@@ -743,7 +745,7 @@ list of instances it depends on."
   (lambda (instance)
     (vhash-foldq* cons '() instance edges)))
 
-(define (channel-instance-derivations instances)
+(define* (channel-instance-derivations instances #:key system)
   "Return the list of derivations to build INSTANCES, in the same order as
 INSTANCES."
   (define core-instance
@@ -757,14 +759,15 @@ INSTANCES."
     (resolve-dependencies instances))
 
   (define (instance->derivation instance)
-    (mlet %store-monad ((system (current-system)))
+    (mlet %store-monad ((current-system-value (current-system)))
       (mcached (if (eq? instance core-instance)
-                   (build-channel-instance instance)
+                   (build-channel-instance instance system)
                    (mlet %store-monad ((core (instance->derivation core-instance))
                                        (deps (mapm %store-monad instance->derivation
                                                    (edges instance))))
-                     (build-channel-instance instance core deps)))
+                     (build-channel-instance instance system core deps)))
                instance
+               current-system-value
                system)))
 
   (unless core-instance
@@ -865,7 +868,7 @@ derivation."
                     intro))))))
             '()))))
 
-(define (channel-instances->manifest instances)
+(define* (channel-instances->manifest instances #:key system)
   "Return a profile manifest with entries for all of INSTANCES, a list of
 channel instances."
   (define (instance->entry instance drv)
@@ -883,7 +886,8 @@ channel instances."
         (properties
          `((source ,(channel-instance->sexp instance)))))))
 
-  (mlet* %store-monad ((derivations (channel-instance-derivations instances))
+  (mlet* %store-monad ((derivations (channel-instance-derivations instances
+                                                                  #:system system))
                        (entries ->  (map instance->entry instances derivations)))
     (return (manifest entries))))
 
-- 
2.30.1