mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
ci: Remove hydra support.
This removes hydra support to use Cuirass as the only continuous integration system. * build-aux/hydra/gnu-system.scm: Remove it. * build-aux/hydra/guix-modular.scm: Ditto. * build-aux/hydra/guix.scm: Ditto. * build-aux/cuirass/hydra-to-cuirass.scm: Ditto. * Makefile.am (EXTRA_DIST): Update it. (hydra-jobs.scm): Remove it. (cuirass-jobs.scm): Update it. * build-aux/hydra/evaluate.scm: Move it to ... * build-aux/cuirass/evaluate.scm: ... here. * build-aux/cuirass/guix-modular.scm: Remove it. * build-aux/cuirass/gnu-system.scm: Ditto. * guix/packages.scm (%hydra-supported-systems): Rename it to ... (%cuirass-supported-systems): ... this variable. * build-aux/check-final-inputs-self-contained: Adapt it. * etc/release-manifest.scm: Ditto. * gnu/ci.scm (package->alist): Remove it. (derivation->job): New procedure. (package-job, package-cross-job, cross-jobs, image-jobs, system-test-jobs, tarball-jobs): Use it. (guix-jobs): New procedure. (hydra-jobs): Rename it to ... (cuirass-jobs): ... this procedure.
This commit is contained in:
Mathieu Othacehe
parent
4399b1cf57
commit
76bea3f8bc
13 changed files with 318 additions and 767 deletions
448
gnu/ci.scm
448
gnu/ci.scm
|
|
@ -3,7 +3,7 @@
|
|||
;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
|
||||
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
|
||||
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
|
||||
;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -21,6 +21,7 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu ci)
|
||||
#:use-module (guix channels)
|
||||
#:use-module (guix config)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix grafts)
|
||||
|
|
@ -64,67 +65,69 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (%cross-targets
|
||||
#:export (%core-packages
|
||||
%cross-targets
|
||||
channel-source->package
|
||||
hydra-jobs))
|
||||
cuirass-jobs))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This file defines build jobs for the Hydra and Cuirass continuation
|
||||
;;; integration tools.
|
||||
;;; This file defines build jobs for Cuirass.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (package->alist store package system
|
||||
#:optional (package-derivation package-derivation))
|
||||
"Convert PACKAGE to an alist suitable for Hydra."
|
||||
(parameterize ((%graft? #f))
|
||||
(let ((drv (package-derivation store package system
|
||||
#:graft? #f)))
|
||||
`((derivation . ,(derivation-file-name drv))
|
||||
(log . ,(log-file store (derivation-file-name drv)))
|
||||
(outputs . ,(filter-map (lambda (res)
|
||||
(match res
|
||||
((name . path)
|
||||
`(,name . ,path))))
|
||||
(derivation->output-paths drv)))
|
||||
(nix-name . ,(derivation-name drv))
|
||||
(system . ,(derivation-system drv))
|
||||
(description . ,(package-synopsis package))
|
||||
(long-description . ,(package-description package))
|
||||
(define* (derivation->job name drv
|
||||
#:key
|
||||
period
|
||||
(max-silent-time 3600)
|
||||
(timeout 3600))
|
||||
"Return a Cuirass job called NAME and describing DRV. PERIOD is the minimal
|
||||
duration that must separate two evaluations of the same job. If PERIOD is
|
||||
false, then the job will be evaluated as soon as possible.
|
||||
|
||||
;; XXX: Hydra ignores licenses that are not a <license> structure or a
|
||||
;; list thereof.
|
||||
(license . ,(let loop ((license (package-license package)))
|
||||
(match license
|
||||
((? license?)
|
||||
(license-name license))
|
||||
((lst ...)
|
||||
(map loop license)))))
|
||||
MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when
|
||||
building the derivation."
|
||||
`((#:job-name . ,name)
|
||||
(#:derivation . ,(derivation-file-name drv))
|
||||
(#:outputs . ,(filter-map
|
||||
(lambda (res)
|
||||
(match res
|
||||
((name . path)
|
||||
`(,name . ,path))))
|
||||
(derivation->output-paths drv)))
|
||||
(#:nix-name . ,(derivation-name drv))
|
||||
(#:system . ,(derivation-system drv))
|
||||
(#:period . ,period)
|
||||
(#:max-silent-time . ,max-silent-time)
|
||||
(#:timeout . ,timeout)))
|
||||
|
||||
(home-page . ,(package-home-page package))
|
||||
(maintainers . ("bug-guix@gnu.org"))
|
||||
(max-silent-time . ,(or (assoc-ref (package-properties package)
|
||||
'max-silent-time)
|
||||
3600)) ;1 hour by default
|
||||
(timeout . ,(or (assoc-ref (package-properties package) 'timeout)
|
||||
72000)))))) ;20 hours by default
|
||||
|
||||
(define (package-job store job-name package system)
|
||||
(define* (package-job store job-name package system
|
||||
#:key cross? target)
|
||||
"Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
|
||||
(let ((job-name (symbol-append job-name (string->symbol ".")
|
||||
(string->symbol system))))
|
||||
`(,job-name . ,(cut package->alist store package system))))
|
||||
(let ((job-name (string-append job-name "." system)))
|
||||
(parameterize ((%graft? #f))
|
||||
(let* ((drv (if cross?
|
||||
(package-cross-derivation store package target system
|
||||
#:graft? #f)
|
||||
(package-derivation store package system
|
||||
#:graft? #f)))
|
||||
(max-silent-time (or (assoc-ref (package-properties package)
|
||||
'max-silent-time)
|
||||
3600))
|
||||
(timeout (or (assoc-ref (package-properties package)
|
||||
'timeout)
|
||||
72000)))
|
||||
(derivation->job job-name drv
|
||||
#:max-silent-time max-silent-time
|
||||
#:timeout timeout)))))
|
||||
|
||||
(define (package-cross-job store job-name package target system)
|
||||
"Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
|
||||
SYSTEM."
|
||||
`(,(symbol-append (string->symbol target) (string->symbol ".") job-name
|
||||
(string->symbol ".") (string->symbol system)) .
|
||||
,(cute package->alist store package system
|
||||
(lambda* (store package system #:key graft?)
|
||||
(package-cross-derivation store package target system
|
||||
#:graft? graft?)))))
|
||||
(let ((name (string-append target "." job-name "." system)))
|
||||
(package-job store name package system
|
||||
#:cross? #t
|
||||
#:target target)))
|
||||
|
||||
(define %core-packages
|
||||
;; Note: Don't put the '-final' package variants because (1) that's
|
||||
|
|
@ -200,6 +203,22 @@ SYSTEM."
|
|||
(remove (either from-32-to-64? same? pointless?)
|
||||
%cross-targets)))
|
||||
|
||||
(define* (guix-jobs store systems #:key source commit)
|
||||
"Return a list of jobs for Guix itself."
|
||||
(define build
|
||||
(primitive-load (string-append source "/build-aux/build-self.scm")))
|
||||
|
||||
(map
|
||||
(lambda (system)
|
||||
(let ((name (string->symbol
|
||||
(string-append "guix." system)))
|
||||
(drv (run-with-store store
|
||||
(build source #:version commit #:system system
|
||||
#:pull-version 1
|
||||
#:guile-version "2.2"))))
|
||||
(derivation->job name drv)))
|
||||
systems))
|
||||
|
||||
;; Architectures that are able to build or cross-build Guix System images.
|
||||
;; This does not mean that other architectures are not supported, only that
|
||||
;; they are often not fast enough to support Guix System images building.
|
||||
|
|
@ -219,32 +238,11 @@ SYSTEM."
|
|||
"Return a list of jobs that build images for SYSTEM. Those jobs are
|
||||
expensive in storage and I/O operations, hence their periodicity is limited by
|
||||
passing the PERIOD argument."
|
||||
(define (->alist drv)
|
||||
`((derivation . ,(derivation-file-name drv))
|
||||
(log . ,(log-file store (derivation-file-name drv)))
|
||||
(outputs . ,(filter-map (lambda (res)
|
||||
(match res
|
||||
((name . path)
|
||||
`(,name . ,path))))
|
||||
(derivation->output-paths drv)))
|
||||
(nix-name . ,(derivation-name drv))
|
||||
(system . ,(derivation-system drv))
|
||||
(description . "Stand-alone image of the GNU system")
|
||||
(long-description . "This is a demo stand-alone image of the GNU
|
||||
system.")
|
||||
(license . ,(license-name gpl3+))
|
||||
(period . ,(hours 48))
|
||||
(max-silent-time . 3600)
|
||||
(timeout . 3600)
|
||||
(home-page . ,%guix-home-page-url)
|
||||
(maintainers . ("bug-guix@gnu.org"))))
|
||||
|
||||
(define (->job name drv)
|
||||
(let ((name (symbol-append name (string->symbol ".")
|
||||
(string->symbol system))))
|
||||
`(,name . ,(lambda ()
|
||||
(parameterize ((%graft? #f))
|
||||
(->alist drv))))))
|
||||
(let ((name (string-append name "." system)))
|
||||
(parameterize ((%graft? #f))
|
||||
(derivation->job name drv
|
||||
#:period (hours 48)))))
|
||||
|
||||
(define (build-image image)
|
||||
(run-with-store store
|
||||
|
|
@ -256,25 +254,26 @@ system.")
|
|||
(expt 2 20))
|
||||
|
||||
(if (member system %guix-system-supported-systems)
|
||||
`(,(->job 'usb-image
|
||||
`(,(->job "usb-image"
|
||||
(build-image
|
||||
(image
|
||||
(inherit efi-disk-image)
|
||||
(operating-system installation-os))))
|
||||
,(->job 'iso9660-image
|
||||
,(->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))))
|
||||
iso9660-image
|
||||
(string-append "GUIX_" system "_"
|
||||
(if (> (string-length %guix-version) 7)
|
||||
(substring %guix-version 0 7)
|
||||
%guix-version))))
|
||||
(operating-system installation-os))))
|
||||
;; Only cross-compile Guix System images from x86_64-linux for now.
|
||||
,@(if (string=? system "x86_64-linux")
|
||||
(map (lambda (image)
|
||||
(->job (image-name image) (build-image image)))
|
||||
(->job (symbol->string (image-name image))
|
||||
(build-image image)))
|
||||
%guix-system-images)
|
||||
'()))
|
||||
'()))
|
||||
|
|
@ -322,112 +321,72 @@ system.")
|
|||
(define* (system-test-jobs store system
|
||||
#:key source commit)
|
||||
"Return a list of jobs for the system tests."
|
||||
(define (test->thunk test)
|
||||
(lambda ()
|
||||
(define drv
|
||||
(run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-current-system system)
|
||||
(set-grafting #f)
|
||||
(set-guile-for-build (default-guile))
|
||||
(system-test-value test))))
|
||||
|
||||
;; Those tests are extremely expensive in I/O operations and storage
|
||||
;; size, use the "period" attribute to run them with a period of at
|
||||
;; least 48 hours.
|
||||
`((derivation . ,(derivation-file-name drv))
|
||||
(log . ,(log-file store (derivation-file-name drv)))
|
||||
(outputs . ,(filter-map (lambda (res)
|
||||
(match res
|
||||
((name . path)
|
||||
`(,name . ,path))))
|
||||
(derivation->output-paths drv)))
|
||||
(nix-name . ,(derivation-name drv))
|
||||
(system . ,(derivation-system drv))
|
||||
(description . ,(format #f "Guix '~a' system test"
|
||||
(system-test-name test)))
|
||||
(long-description . ,(system-test-description test))
|
||||
(license . ,(license-name gpl3+))
|
||||
(period . ,(hours 48))
|
||||
(max-silent-time . 3600)
|
||||
(timeout . 3600)
|
||||
(home-page . ,%guix-home-page-url)
|
||||
(maintainers . ("bug-guix@gnu.org")))))
|
||||
|
||||
(define (->job test)
|
||||
(let ((name (string->symbol
|
||||
(string-append "test." (system-test-name test)
|
||||
"." system))))
|
||||
(cons name (test->thunk test))))
|
||||
(parameterize ((current-guix-package
|
||||
(channel-source->package source #:commit commit)))
|
||||
(let ((name (string-append "test." (system-test-name test)
|
||||
"." system))
|
||||
(drv (run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-current-system system)
|
||||
(set-grafting #f)
|
||||
(set-guile-for-build (default-guile))
|
||||
(system-test-value test)))))
|
||||
|
||||
;; Those tests are extremely expensive in I/O operations and storage
|
||||
;; size, use the "period" attribute to run them with a period of at
|
||||
;; least 48 hours.
|
||||
(derivation->job name drv
|
||||
#:period (hours 24)))))
|
||||
|
||||
(if (member system %guix-system-supported-systems)
|
||||
;; Override the value of 'current-guix' used by system tests. Using a
|
||||
;; channel instance makes tests that rely on 'current-guix' less
|
||||
;; expensive. It also makes sure we get a valid Guix package when this
|
||||
;; code is not running from a checkout.
|
||||
(parameterize ((current-guix-package
|
||||
(channel-source->package source #:commit commit)))
|
||||
(map ->job (all-system-tests)))
|
||||
(map ->job (all-system-tests))
|
||||
'()))
|
||||
|
||||
(define (tarball-jobs store system)
|
||||
"Return Hydra jobs to build the self-contained Guix binary tarball."
|
||||
(define (->alist drv)
|
||||
`((derivation . ,(derivation-file-name drv))
|
||||
(log . ,(log-file store (derivation-file-name drv)))
|
||||
(outputs . ,(filter-map (lambda (res)
|
||||
(match res
|
||||
((name . path)
|
||||
`(,name . ,path))))
|
||||
(derivation->output-paths drv)))
|
||||
(nix-name . ,(derivation-name drv))
|
||||
(system . ,(derivation-system drv))
|
||||
(description . "Stand-alone binary Guix tarball")
|
||||
(long-description . "This is a tarball containing binaries of Guix and
|
||||
all its dependencies, and ready to be installed on \"foreign\" distributions.")
|
||||
(license . ,(license-name gpl3+))
|
||||
(home-page . ,%guix-home-page-url)
|
||||
(maintainers . ("bug-guix@gnu.org"))
|
||||
(period . ,(hours 24))))
|
||||
|
||||
"Return jobs to build the self-contained Guix binary tarball."
|
||||
(define (->job name drv)
|
||||
(let ((name (symbol-append name (string->symbol ".")
|
||||
(string->symbol system))))
|
||||
`(,name . ,(lambda ()
|
||||
(parameterize ((%graft? #f))
|
||||
(->alist drv))))))
|
||||
(let ((name (string-append name "." system)))
|
||||
(parameterize ((%graft? #f))
|
||||
(derivation->job name drv
|
||||
#:period (hours 24)))))
|
||||
|
||||
;; XXX: Add a job for the stable Guix?
|
||||
(list (->job 'binary-tarball
|
||||
(run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(>>= (profile-derivation (packages->manifest (list guix)))
|
||||
(lambda (profile)
|
||||
(self-contained-tarball "guix-binary" profile
|
||||
#:localstatedir? #t
|
||||
#:compressor
|
||||
(lookup-compressor "xz")))))
|
||||
#:system system))))
|
||||
(list
|
||||
(->job "binary-tarball"
|
||||
(run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(>>= (profile-derivation (packages->manifest (list guix)))
|
||||
(lambda (profile)
|
||||
(self-contained-tarball "guix-binary" profile
|
||||
#:localstatedir? #t
|
||||
#:compressor
|
||||
(lookup-compressor "xz")))))
|
||||
#:system system))))
|
||||
|
||||
(define job-name
|
||||
;; Return the name of a package's job.
|
||||
(compose string->symbol package-name))
|
||||
package-name)
|
||||
|
||||
(define package->job
|
||||
(let ((base-packages
|
||||
(delete-duplicates
|
||||
(append-map (match-lambda
|
||||
((_ package _ ...)
|
||||
(match (package-transitive-inputs package)
|
||||
(((_ inputs _ ...) ...)
|
||||
inputs))))
|
||||
((_ package _ ...)
|
||||
(match (package-transitive-inputs package)
|
||||
(((_ inputs _ ...) ...)
|
||||
inputs))))
|
||||
(%final-inputs)))))
|
||||
(lambda (store package system)
|
||||
"Return a job for PACKAGE on SYSTEM, or #f if this combination is not
|
||||
valid."
|
||||
(cond ((member package base-packages)
|
||||
(package-job store (symbol-append 'base. (job-name package))
|
||||
(package-job store (string-append "base." (job-name package))
|
||||
package system))
|
||||
((supported-package? package system)
|
||||
(let ((drv (package-derivation store package system
|
||||
|
|
@ -461,14 +420,19 @@ valid."
|
|||
packages)))
|
||||
#:select? (const #t))) ;include hidden packages
|
||||
|
||||
(define (arguments->manifests arguments)
|
||||
(define (arguments->manifests arguments channels)
|
||||
"Return the list of manifests extracted from ARGUMENTS."
|
||||
(define (channel-name->checkout name)
|
||||
(let ((channel (find (lambda (channel)
|
||||
(eq? (channel-name channel) name))
|
||||
channels)))
|
||||
(channel-url channel)))
|
||||
|
||||
(map (match-lambda
|
||||
((input-name . relative-path)
|
||||
(let* ((checkout (assq-ref arguments (string->symbol input-name)))
|
||||
(base (assq-ref checkout 'file-name)))
|
||||
(in-vicinity base relative-path))))
|
||||
(assq-ref arguments 'manifests)))
|
||||
((name . path)
|
||||
(let ((checkout (channel-name->checkout name)))
|
||||
(in-vicinity checkout path))))
|
||||
arguments))
|
||||
|
||||
(define (manifests->packages store manifests)
|
||||
"Return the list of packages found in MANIFESTS."
|
||||
|
|
@ -484,100 +448,94 @@ valid."
|
|||
load-manifest)
|
||||
manifests))))
|
||||
|
||||
(define (find-current-checkout arguments)
|
||||
"Find the first checkout of ARGUMENTS that provided the current file.
|
||||
Return #f if no such checkout is found."
|
||||
(let ((current-root
|
||||
(canonicalize-path
|
||||
(string-append (dirname (current-filename)) "/.."))))
|
||||
(find (lambda (argument)
|
||||
(and=> (assq-ref argument 'file-name)
|
||||
(lambda (name)
|
||||
(string=? name current-root)))) arguments)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Hydra entry point.
|
||||
;;; Cuirass entry point.
|
||||
;;;
|
||||
|
||||
(define (hydra-jobs store arguments)
|
||||
"Return Hydra jobs."
|
||||
(define (cuirass-jobs store arguments)
|
||||
"Register Cuirass jobs."
|
||||
(define subset
|
||||
(match (assoc-ref arguments 'subset)
|
||||
("core" 'core) ; only build core packages
|
||||
("hello" 'hello) ; only build hello
|
||||
(((? string?) (? string?) ...) 'list) ; only build selected list of packages
|
||||
("manifests" 'manifests) ; only build packages in the list of manifests
|
||||
(_ 'all))) ; build everything
|
||||
(assoc-ref arguments 'subset))
|
||||
|
||||
(define systems
|
||||
(match (assoc-ref arguments 'systems)
|
||||
(#f %hydra-supported-systems)
|
||||
(#f %cuirass-supported-systems)
|
||||
((lst ...) lst)
|
||||
((? string? str) (call-with-input-string str read))))
|
||||
|
||||
(define checkout
|
||||
(or (find-current-checkout arguments)
|
||||
(assq-ref arguments 'superior-guix-checkout)))
|
||||
(define channels
|
||||
(let ((channels (assq-ref arguments 'channels)))
|
||||
(map sexp->channel channels)))
|
||||
|
||||
(define guix
|
||||
(find guix-channel? channels))
|
||||
|
||||
(define commit
|
||||
(assq-ref checkout 'revision))
|
||||
(channel-commit guix))
|
||||
|
||||
(define source
|
||||
(assq-ref checkout 'file-name))
|
||||
(channel-url guix))
|
||||
|
||||
;; Turn off grafts. Grafting is meant to happen on the user's machines.
|
||||
(parameterize ((%graft? #f))
|
||||
;; Return one job for each package, except bootstrap packages.
|
||||
(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)
|
||||
(image-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.
|
||||
(let ((hello (specification->package "hello")))
|
||||
(list (package-job store (job-name hello) hello system))))
|
||||
((list)
|
||||
;; Build selected list of packages only.
|
||||
(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)
|
||||
(image-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)))
|
||||
('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))))
|
||||
(('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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue