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 (): 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* @@ -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 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{} 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