- (append-map (lambda (system)
- (format (current-error-port)
- "evaluating for '~a' (heap size: ~a MiB)...~%"
- system
- (round
- (/ (assoc-ref (gc-stats) 'heap-size)
- (expt 2. 20))))
- (invalidate-derivation-caches!)
- (case subset
- ((all)
- ;; Build everything, including replacements.
- (let ((all (all-packages))
- (job (lambda (package)
- (package->job store package
- system))))
- (append (filter-map job all)
- (qemu-jobs store system)
- (system-test-jobs store system
- #:source source
- #:commit commit)
- (tarball-jobs store system)
- (cross-jobs store system))))
- ((core)
- ;; Build core packages only.
- (append (map (lambda (package)
- (package-job store (job-name package)
- package system))
- %core-packages)
- (cross-jobs store system)))
- ((hello)
- ;; Build hello package only.
- (if (string=? system (%current-system))
- (let ((hello (specification->package "hello")))
- (list (package-job store (job-name hello) hello system)))
- '()))
- ((list)
- ;; Build selected list of packages only.
- (if (string=? system (%current-system))
- (let* ((names (assoc-ref arguments 'subset))
- (packages (map specification->package names)))
- (map (lambda (package)
- (package-job store (job-name package)
- package system))
- packages))
- '()))
- ((manifests)
- ;; Build packages in the list of manifests.
- (let* ((manifests (arguments->manifests arguments))
- (packages (manifests->packages store manifests)))
- (map (lambda (package)
- (package-job store (job-name package)
- package system))
- packages)))
- (else
- (error "unknown subset" subset))))
- systems)))
+ (append-map
+ (lambda (system)
+ (format (current-error-port)
+ "evaluating for '~a' (heap size: ~a MiB)...~%"
+ system
+ (round
+ (/ (assoc-ref (gc-stats) 'heap-size)
+ (expt 2. 20))))
+ (invalidate-derivation-caches!)
+ (match subset
+ ('all
+ ;; Build everything, including replacements.
+ (let ((all (all-packages))
+ (job (lambda (package)
+ (package->job store package system))))
+ (append
+ (filter-map job all)
+ (cross-jobs store system))))
+ ('core
+ ;; Build core packages only.
+ (append
+ (map (lambda (package)
+ (package-job store (job-name package)
+ package system))
+ %core-packages)
+ (cross-jobs store system)))
+ ('guix
+ ;; Build Guix modules only.
+ (guix-jobs store systems
+ #:source source
+ #:commit commit))
+ ('hello
+ ;; Build hello package only.
+ (let ((hello (specification->package "hello")))
+ (list (package-job store (job-name hello)
+ hello system))))
+ ('images
+ ;; Build Guix System images only.
+ (image-jobs store system))
+ ('system-tests
+ ;; Build Guix System tests only.
+ (system-test-jobs store system
+ #:source source
+ #:commit commit))
+ ('tarball
+ ;; Build Guix tarball only.
+ (tarball-jobs store system))
+ (('channels . channels)
+ ;; Build only the packages from CHANNELS.
+ (let ((all (all-packages)))
+ (filter-map
+ (lambda (package)
+ (any (lambda (channel)
+ (and (member (channel-name channel) channels)
+ (package->job store package system)))
+ (package-channels package)))
+ all)))
+ (('packages . rest)
+ ;; Build selected list of packages only.
+ (let ((packages (map specification->package rest)))
+ (map (lambda (package)
+ (package-job store (job-name package)
+ package system))
+ packages)))
+ (('manifests . rest)
+ ;; Build packages in the list of manifests.
+ (let* ((manifests (arguments->manifests rest channels))
+ (packages (manifests->packages store manifests)))
+ (map (lambda (package)
+ (package-job store (job-name package)
+ package system))
+ packages)))
+ (else
+ (error "unknown subset" subset))))
+ systems)))