summaryrefslogtreecommitdiff
path: root/gnu/ci.scm
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-04-28 11:51:33 +0200
committerMathieu Othacehe <othacehe@gnu.org>2021-04-28 11:53:32 +0200
commit996b5edf51c132764ca8122d401c5bb2b8d2e3c5 (patch)
tree4568598436f893872911dab3f4dc5bc6c222feb8 /gnu/ci.scm
parent93242b54e4eff90432df9de4841297f19b358e55 (diff)
ci: Factorize image->job procedure.
* gnu/ci.scm (image-jobs): Extract ->job procedure into ... (image->job): ... this new procedure.
Diffstat (limited to 'gnu/ci.scm')
-rw-r--r--gnu/ci.scm68
1 files changed, 38 insertions, 30 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm
index babbb60f81..9e4f0a8c82 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -66,7 +66,10 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (%core-packages
+ #:export (derivation->job
+ image->job
+
+ %core-packages
%cross-targets
channel-source->package
cuirass-jobs))
@@ -232,43 +235,48 @@ SYSTEM."
(define (hours hours)
(* 3600 hours))
+(define* (image->job store image
+ #:key name system)
+ "Return the job for IMAGE on SYSTEM. If NAME is passed, use it as job name,
+otherwise use the IMAGE name."
+ (let* ((image-name (or name
+ (symbol->string (image-name image))))
+ (name (string-append image-name "." system))
+ (drv (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (lower-object (system-image image))))))
+ (parameterize ((%graft? #f))
+ (derivation->job name drv))))
+
(define (image-jobs store system)
"Return a list of jobs that build images for SYSTEM."
- (define (->job name drv)
- (let ((name (string-append name "." system)))
- (parameterize ((%graft? #f))
- (derivation->job name drv))))
-
- (define (build-image image)
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (lower-object (system-image image)))))
-
(define MiB
(expt 2 20))
(if (member system %guix-system-supported-systems)
- `(,(->job "usb-image"
- (build-image
- (image
- (inherit efi-disk-image)
- (operating-system installation-os))))
- ,(->job "iso9660-image"
- (build-image
- (image
- (inherit (image-with-label
- iso9660-image
- (string-append "GUIX_" system "_"
- (if (> (string-length %guix-version) 7)
- (substring %guix-version 0 7)
- %guix-version))))
- (operating-system installation-os))))
+ `(,(image->job store
+ (image
+ (inherit efi-disk-image)
+ (operating-system installation-os))
+ #:name "usb-image"
+ #:system system)
+ ,(image->job
+ store
+ (image
+ (inherit (image-with-label
+ iso9660-image
+ (string-append "GUIX_" system "_"
+ (if (> (string-length %guix-version) 7)
+ (substring %guix-version 0 7)
+ %guix-version))))
+ (operating-system installation-os))
+ #:name "iso9660-image"
+ #:system system)
;; Only cross-compile Guix System images from x86_64-linux for now.
,@(if (string=? system "x86_64-linux")
- (map (lambda (image)
- (->job (symbol->string (image-name image))
- (build-image image)))
+ (map (cut image->job store <>
+ #:system system)
%guix-system-images)
'()))
'()))