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(-)
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