diff options
Diffstat (limited to 'gnu/ci.scm')
| -rw-r--r-- | gnu/ci.scm | 94 |
1 files changed, 60 insertions, 34 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm index babbb60f81..c5de25e70e 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -66,9 +66,14 @@ #: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 + + arguments->systems cuirass-jobs)) ;;; Commentary: @@ -87,6 +92,9 @@ MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when building the derivation." `((#:job-name . ,name) (#:derivation . ,(derivation-file-name drv)) + (#:inputs . ,(map (compose derivation-file-name + derivation-input-derivation) + (derivation-inputs drv))) (#:outputs . ,(filter-map (lambda (res) (match res @@ -232,43 +240,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) '())) '())) @@ -435,6 +448,13 @@ valid." load-manifest) manifests)))) +(define (arguments->systems arguments) + "Return the systems list from ARGUMENTS." + (match (assoc-ref arguments 'systems) + (#f %cuirass-supported-systems) + ((lst ...) lst) + ((? string? str) (call-with-input-string str read)))) + ;;; ;;; Cuirass entry point. @@ -446,10 +466,7 @@ valid." (assoc-ref arguments 'subset)) (define systems - (match (assoc-ref arguments 'systems) - (#f %cuirass-supported-systems) - ((lst ...) lst) - ((? string? str) (call-with-input-string str read)))) + (arguments->systems arguments)) (define channels (let ((channels (assq-ref arguments 'channels))) @@ -514,6 +531,15 @@ valid." ('tarball ;; Build Guix tarball only. (tarball-jobs store system)) + (('custom . modules) + ;; Build custom modules jobs only. + (append-map + (lambda (module) + (let ((proc (module-ref + (resolve-interface module) + 'cuirass-jobs))) + (proc store arguments))) + modules)) (('channels . channels) ;; Build only the packages from CHANNELS. (let ((all (all-packages))) |