From 1505095fe7fc48be2c84ee34b7805d5fad8cfd84 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 19 Dec 2023 19:40:40 +0000
Subject: forge: Allow building specific variables in channels.

* guix/forge/forge.scm (<variable-specification>): New type.
(guix-channel-job-gexp): Accept #:variables argument specifying
what to build.
---
 guix/forge/forge.scm | 50 +++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 37 insertions(+), 13 deletions(-)

(limited to 'guix/forge/forge.scm')

diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm
index ca8128c..7cf3ff3 100644
--- a/guix/forge/forge.scm
+++ b/guix/forge/forge.scm
@@ -56,6 +56,10 @@
             forge-project-ci-jobs
             forge-project-ci-jobs-trigger
             derivation-job-gexp
+            variable-specification
+            variable-specification?
+            variable-specification-module
+            variable-specification-name
             guix-channel-job-gexp))
 
 (define-record-type* <forge-project>
@@ -264,12 +268,21 @@ clone and does not include the .git directory."
                 (format (current-error-port) "Built ~a successfully~%" derivation-output)
                 derivation-output)))))))
 
+(define-record-type* <variable-specification>
+  variable-specification make-variable-specification
+  variable-specification?
+  (module variable-specification-module)
+  (name variable-specification-name))
+
 (define* (guix-channel-job-gexp channels
                                 #:key
+                                variables
                                 (guix-daemon-uri %daemon-socket-uri)
                                 (verbose? #true))
-  "Return a G-expression that pulls @var{channels} and builds all
-packages defined in the first channel.
+  "Return a G-expression that pulls @var{channels} and builds
+@var{variables}, a list of @code{<variable-specification>} objects. If
+@var{variables} is @code{#f}, all packages defined in the first
+channel are built.
 
 @var{guix-daemon-uri} is a file name or URI designating the Guix
 daemon endpoint.
@@ -367,17 +380,28 @@ When @var{verbose?} is #true, verbose build logs are shown."
              (inferior-eval
               '(parameterize ((%daemon-socket-uri #$guix-daemon-uri))
                  (with-store store
-                   (map (lambda (pkg)
-                          (derivation-file-name
-                           (parameterize ((%graft? #false))
-                             (run-with-store store
-                               (package->derivation pkg)))))
-                        (filter-packages
-                         (lambda (pkg)
-                           (any (lambda (channel)
-                                  (memq (channel-name channel)
-                                        (list '#$(channel-name (first channels)))))
-                                (package-channels pkg)))))))
+                   (map (compose derivation-file-name
+                                 (match-lambda
+                                   ((? package? pkg)
+                                    (parameterize ((%graft? #false))
+                                      (run-with-store store
+                                        (package->derivation pkg))))
+                                   (item (error "Unknown item" item))))
+                        #$(if variables
+                              #~(map (match-lambda
+                                       ((module-name variable-name)
+                                        (module-ref (resolve-interface module-name)
+                                                    variable-name)))
+                                     '#$(map (lambda (variable)
+                                               (list (variable-specification-module variable)
+                                                     (variable-specification-name variable)))
+                                             variables))
+                              #~(filter-packages
+                                 (lambda (pkg)
+                                   (any (lambda (channel)
+                                          (memq (channel-name channel)
+                                                (list '#$(channel-name (first channels)))))
+                                        (package-channels pkg))))))))
               inferior)))))))
 
 (define (forge-ci-jobs config)
-- 
cgit v1.2.3