;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
- #:use-module (guix utils)
+ #:use-module (guix grafts)
+
+ ;; Use the procedure that destructures "NAME-VERSION" forms.
+ #:use-module ((guix utils) #:hide (package-name->name+version))
+ #:use-module ((guix build utils) #:select (package-name->name+version))
+
#:use-module (guix monads)
#:use-module (guix gexp)
#:autoload (guix http-client) (http-fetch http-get-error?)
set-build-options-from-command-line*
show-build-options-help
- guix-build))
+ %transformation-options
+ options->transformation
+ show-transformation-options-help
+
+ guix-build
+ register-root
+ register-root*))
(define %default-log-urls
;; Default base URLs for build logs.
found. Return #f if no build log was found."
(define (valid-url? url)
;; Probe URL and return #t if it is accessible.
- (guard (c ((http-get-error? c) #f))
- (close-port (http-fetch url #:buffered? #f))
- #t))
+ (catch 'getaddrinfo-error
+ (lambda ()
+ (guard (c ((http-get-error? c) #f))
+ (close-port (http-fetch url #:buffered? #f))
+ #t))
+ (lambda _
+ #f)))
(define (find-url file)
(let ((base (basename file)))
(define (register-root store paths root)
"Register ROOT as an indirect GC root for all of PATHS."
- (let* ((root (string-append (canonicalize-path (dirname root))
- "/" root)))
+ (let* ((root (if (string-prefix? "/" root)
+ root
+ (string-append (canonicalize-path (dirname root))
+ "/" root))))
(catch 'system-error
(lambda ()
(match paths
0
paths))))
(lambda args
- (leave (_ "failed to create GC root `~a': ~a~%")
+ (leave (G_ "failed to create GC root `~a': ~a~%")
root (strerror (system-error-errno args)))))))
+(define register-root*
+ (store-lift register-root))
+
(define (package-with-source store p uri)
"Return a package based on P but with its source taken from URI. Extract
the new package's version number from URI."
;; Use #:recursive? #t to allow for directories.
(source (download-to-store store uri
- #:recursive? #t))))))
+ #:recursive? #t))
+
+ ;; Override the replacement, otherwise '--with-source' would
+ ;; have no effect.
+ (replacement #f)))))
+
+\f
+;;;
+;;; Transformations.
+;;;
+
+(define (transform-package-source sources)
+ "Return a transformation procedure that replaces package sources with the
+matching URIs given in SOURCES."
+ (define new-sources
+ (map (lambda (uri)
+ (cons (package-name->name+version (basename uri))
+ uri))
+ sources))
+
+ (lambda (store obj)
+ (let loop ((sources new-sources)
+ (result '()))
+ (match obj
+ ((? package? p)
+ (let ((source (assoc-ref sources (package-name p))))
+ (if source
+ (package-with-source store p source)
+ p)))
+ (_
+ obj)))))
+
+(define (evaluate-replacement-specs specs proc)
+ "Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on
+each package pair specified by SPECS. Return the resulting list. Raise an
+error if an element of SPECS uses invalid syntax, or if a package it refers to
+could not be found."
+ (define not-equal
+ (char-set-complement (char-set #\=)))
+
+ (map (lambda (spec)
+ (match (string-tokenize spec not-equal)
+ ((old new)
+ (proc (specification->package old)
+ (specification->package new)))
+ (x
+ (leave (G_ "invalid replacement specification: ~s~%") spec))))
+ specs))
+
+(define (transform-package-inputs replacement-specs)
+ "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
+strings like \"guile=guile@2.1\" meaning that, any dependency on a package
+called \"guile\" must be replaced with a dependency on a version 2.1 of
+\"guile\"."
+ (let* ((replacements (evaluate-replacement-specs replacement-specs cons))
+ (rewrite (package-input-rewriting replacements)))
+ (lambda (store obj)
+ (if (package? obj)
+ (rewrite obj)
+ obj))))
+
+(define (transform-package-inputs/graft replacement-specs)
+ "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
+strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
+current 'gnutls' package, after which version 3.5.4 is grafted onto them."
+ (define (replacement-pair old new)
+ (cons old
+ (package (inherit old) (replacement new))))
+
+ (let* ((replacements (evaluate-replacement-specs replacement-specs
+ replacement-pair))
+ (rewrite (package-input-rewriting replacements)))
+ (lambda (store obj)
+ (if (package? obj)
+ (rewrite obj)
+ obj))))
+
+(define %transformations
+ ;; Transformations that can be applied to things to build. The car is the
+ ;; key used in the option alist, and the cdr is the transformation
+ ;; procedure; it is called with two arguments: the store, and a list of
+ ;; things to build.
+ `((with-source . ,transform-package-source)
+ (with-input . ,transform-package-inputs)
+ (with-graft . ,transform-package-inputs/graft)))
+
+(define %transformation-options
+ ;; The command-line interface to the above transformations.
+ (let ((parser (lambda (symbol)
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons symbol arg result)
+ rest)))))
+ (list (option '("with-source") #t #f
+ (parser 'with-source))
+ (option '("with-input") #t #f
+ (parser 'with-input))
+ (option '("with-graft") #t #f
+ (parser 'with-graft)))))
+
+(define (show-transformation-options-help)
+ (display (G_ "
+ --with-source=SOURCE
+ use SOURCE when building the corresponding package"))
+ (display (G_ "
+ --with-input=PACKAGE=REPLACEMENT
+ replace dependency PACKAGE by REPLACEMENT"))
+ (display (G_ "
+ --with-graft=PACKAGE=REPLACEMENT
+ graft REPLACEMENT on packages that refer to PACKAGE")))
+
+
+(define (options->transformation opts)
+ "Return a procedure that, when passed an object to build (package,
+derivation, etc.), applies the transformations specified by OPTS."
+ (define applicable
+ ;; List of applicable transformations as symbol/procedure pairs.
+ (filter-map (match-lambda
+ ((key . transform)
+ (match (filter-map (match-lambda
+ ((k . arg)
+ (and (eq? k key) arg)))
+ opts)
+ (() #f)
+ (args (cons key (transform args))))))
+ %transformations))
+
+ (lambda (store obj)
+ (fold (match-lambda*
+ (((name . transform) obj)
+ (let ((new (transform store obj)))
+ (when (eq? new obj)
+ (warning (G_ "transformation '~a' had no effect on ~a~%")
+ name
+ (if (package? obj)
+ (package-full-name obj)
+ obj)))
+ new)))
+ obj
+ applicable)))
\f
;;;
"Display on the current output port help about the standard command-line
options handled by 'set-build-options-from-command-line', and listed in
'%standard-build-options'."
- (display (_ "
+ (display (G_ "
-L, --load-path=DIR prepend DIR to the package module search path"))
- (display (_ "
+ (display (G_ "
-K, --keep-failed keep build tree of failed builds"))
- (display (_ "
+ (display (G_ "
+ -k, --keep-going keep going when some of the derivations fail"))
+ (display (G_ "
-n, --dry-run do not build the derivations"))
- (display (_ "
+ (display (G_ "
--fallback fall back to building when the substituter fails"))
- (display (_ "
+ (display (G_ "
--no-substitutes build instead of resorting to pre-built substitutes"))
- (display (_ "
+ (display (G_ "
--substitute-urls=URLS
fetch substitute from URLS if they are authorized"))
- (display (_ "
+ (display (G_ "
+ --no-grafts do not graft packages"))
+ (display (G_ "
--no-build-hook do not attempt to offload builds via the build hook"))
- (display (_ "
+ (display (G_ "
--max-silent-time=SECONDS
mark the build as failed after SECONDS of silence"))
- (display (_ "
+ (display (G_ "
--timeout=SECONDS mark the build as failed after SECONDS of activity"))
- (display (_ "
+ (display (G_ "
--verbosity=LEVEL use the given verbosity LEVEL"))
- (display (_ "
+ (display (G_ "
+ --rounds=N build N times in a row to detect non-determinism"))
+ (display (G_ "
-c, --cores=N allow the use of up to N CPU cores for the build"))
- (display (_ "
+ (display (G_ "
-M, --max-jobs=N allow at most N build jobs")))
(define (set-build-options-from-command-line store opts)
;; TODO: Add more options.
(set-build-options store
#:keep-failed? (assoc-ref opts 'keep-failed?)
- #:build-cores (or (assoc-ref opts 'cores) 0)
- #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1)
+ #:keep-going? (assoc-ref opts 'keep-going?)
+ #:rounds (assoc-ref opts 'rounds)
+ #:build-cores (assoc-ref opts 'cores)
+ #:max-build-jobs (assoc-ref opts 'max-jobs)
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes? (assoc-ref opts 'substitutes?)
- #:substitute-urls (or (assoc-ref opts 'substitute-urls)
- %default-substitute-urls)
+ #:substitute-urls (assoc-ref opts 'substitute-urls)
#:use-build-hook? (assoc-ref opts 'build-hook?)
#:max-silent-time (assoc-ref opts 'max-silent-time)
#:timeout (assoc-ref opts 'timeout)
(lambda (opt name arg result . rest)
;; XXX: Imperatively modify the search paths.
(%package-module-path (cons arg (%package-module-path)))
+ (%patch-path (cons arg (%patch-path)))
(set! %load-path (cons arg %load-path))
(set! %load-compiled-path (cons arg %load-compiled-path))
(apply values
(alist-cons 'keep-failed? #t result)
rest)))
+ (option '(#\k "keep-going") #f #f
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'keep-going? #t result)
+ rest)))
+ (option '("rounds") #t #f
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'rounds (string->number* arg)
+ result)
+ rest)))
(option '("fallback") #f #f
(lambda (opt name arg result . rest)
(apply values
(string-tokenize arg)
(alist-delete 'substitute-urls result))
rest)))
+ (option '("no-grafts") #f #f
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'graft? #f
+ (alist-delete 'graft? result eq?))
+ rest)))
(option '("no-build-hook") #f #f
(lambda (opt name arg result . rest)
(apply values
(let ((c (false-if-exception (string->number arg))))
(if c
(apply values (alist-cons 'cores c result) rest)
- (leave (_ "not a number: '~a' option argument: ~a~%")
+ (leave (G_ "not a number: '~a' option argument: ~a~%")
name arg)))))
(option '(#\M "max-jobs") #t #f
(lambda (opt name arg result . rest)
(let ((c (false-if-exception (string->number arg))))
(if c
(apply values (alist-cons 'max-jobs c result) rest)
- (leave (_ "not a number: '~a' option argument: ~a~%")
+ (leave (G_ "not a number: '~a' option argument: ~a~%")
name arg)))))))
\f
(define %default-options
;; Alist of default option values.
`((system . ,(%current-system))
+ (build-mode . ,(build-mode normal))
(graft? . #t)
(substitutes? . #t)
(build-hook? . #t)
(print-build-trace? . #t)
- (max-silent-time . 3600)
(verbosity . 0)))
(define (show-help)
- (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
+ (display (G_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
- (display (_ "
+ (display (G_ "
-e, --expression=EXPR build the package or derivation EXPR evaluates to"))
- (display (_ "
+ (display (G_ "
+ -f, --file=FILE build the package or derivation that the code within
+ FILE evaluates to"))
+ (display (G_ "
-S, --source build the packages' source derivations"))
- (display (_ "
+ (display (G_ "
--sources[=TYPE] build source derivations; TYPE may optionally be one
of \"package\", \"all\" (default), or \"transitive\""))
- (display (_ "
+ (display (G_ "
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
- (display (_ "
+ (display (G_ "
--target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
- (display (_ "
- --with-source=SOURCE
- use SOURCE when building the corresponding package"))
- (display (_ "
- --no-grafts do not graft packages"))
- (display (_ "
+ (display (G_ "
-d, --derivations return the derivation paths of the given packages"))
- (display (_ "
+ (display (G_ "
+ --check rebuild items to check for non-determinism issues"))
+ (display (G_ "
+ --repair repair the specified items"))
+ (display (G_ "
-r, --root=FILE make FILE a symlink to the result, and register it
as a garbage collector root"))
- (display (_ "
+ (display (G_ "
+ -q, --quiet do not show the build log"))
+ (display (G_ "
--log-file return the log file names for the given derivations"))
(newline)
(show-build-options-help)
(newline)
- (display (_ "
+ (show-transformation-options-help)
+ (newline)
+ (display (G_ "
-h, --help display this help and exit"))
- (display (_ "
+ (display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
("transitive"
(alist-cons 'source package-transitive-sources result))
(else
- (leave (_ "invalid argument: '~a' option argument: ~a, ~
+ (leave (G_ "invalid argument: '~a' option argument: ~a, ~
must be one of 'package', 'all', or 'transitive'~%")
name arg)))))
+ (option '("check") #f #f
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'build-mode (build-mode check)
+ result)
+ rest)))
+ (option '("repair") #f #f
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'build-mode (build-mode repair)
+ result)
+ rest)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(option '(#\e "expression") #t #f
(lambda (opt name arg result)
(alist-cons 'expression arg result)))
+ (option '(#\f "file") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'file arg result)))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
- (alist-cons 'dry-run? #t result)))
+ (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
+ (option '(#\q "quiet") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'quiet? #t result)))
(option '("log-file") #f #f
(lambda (opt name arg result)
(alist-cons 'log-file? #t result)))
- (option '("with-source") #t #f
- (lambda (opt name arg result)
- (alist-cons 'with-source arg result)))
- (option '("no-grafts") #f #f
- (lambda (opt name arg result)
- (alist-cons 'graft? #f
- (alist-delete 'graft? result eq?))))
- %standard-build-options))
+ (append %transformation-options
+ %standard-build-options)))
+
+(define (options->things-to-build opts)
+ "Read the arguments from OPTS and return a list of high-level objects to
+build---packages, gexps, derivations, and so on."
+ (define (validate-type x)
+ (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x))
+ (leave (G_ "~s: not something we can build~%") x)))
+
+ (define (ensure-list x)
+ (let ((lst (match x
+ ((x ...) x)
+ (x (list x)))))
+ (for-each validate-type lst)
+ lst))
+
+ (append-map (match-lambda
+ (('argument . (? string? spec))
+ (cond ((derivation-path? spec)
+ (list (call-with-input-file spec read-derivation)))
+ ((store-path? spec)
+ ;; Nothing to do; maybe for --log-file.
+ '())
+ (else
+ (list (specification->package spec)))))
+ (('file . file)
+ (ensure-list (load* file (make-user-module '()))))
+ (('expression . str)
+ (ensure-list (read/eval str)))
+ (('argument . (? derivation? drv))
+ drv)
+ (_ '()))
+ opts))
(define (options->derivations store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to
build."
+ (define transform
+ (options->transformation opts))
+
(define package->derivation
(match (assoc-ref opts 'target)
(#f package-derivation)
(cut package-cross-derivation <> <> triplet <>))))
(define src (assoc-ref opts 'source))
- (define sys (assoc-ref opts 'system))
+ (define system (assoc-ref opts 'system))
(define graft? (assoc-ref opts 'graft?))
(parameterize ((%graft? graft?))
- (let ((opts (options/with-source store
- (options/resolve-packages store opts))))
- (concatenate
- (filter-map (match-lambda
- (('argument . (? package? p))
+ (append-map (match-lambda
+ ((? package? p)
+ (let ((p (or (and graft? (package-replacement p)) p)))
(match src
(#f
- (list (package->derivation store p sys)))
+ (list (package->derivation store p system)))
(#t
- (let ((s (package-source p)))
- (list (package-source-derivation store s))))
+ (match (package-source p)
+ (#f
+ (format (current-error-port)
+ (G_ "~a: warning: \
+package '~a' has no source~%")
+ (location->string (package-location p))
+ (package-name p))
+ '())
+ (s
+ (list (package-source-derivation store s)))))
(proc
(map (cut package-source-derivation store <>)
- (proc p)))))
- (('argument . (? derivation? drv))
- (list drv))
- (('argument . (? derivation-path? drv))
- (list (call-with-input-file drv read-derivation)))
- (('argument . (? store-path?))
- ;; Nothing to do; maybe for --log-file.
- #f)
- (_ #f))
- opts)))))
-
-(define (options/resolve-packages store opts)
- "Return OPTS with package specification strings replaced by actual
-packages."
- (define system
- (or (assoc-ref opts 'system) (%current-system)))
-
- (map (match-lambda
- (('argument . (? string? spec))
- (if (store-path? spec)
- `(argument . ,spec)
- `(argument . ,(specification->package spec))))
- (('expression . str)
- (match (read/eval str)
- ((? package? p)
- `(argument . ,p))
- ((? procedure? proc)
- (let ((drv (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (proc))
- #:system system)))
- `(argument . ,drv)))
- ((? gexp? gexp)
- (let ((drv (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (gexp->derivation "gexp" gexp
- #:system system)))))
- `(argument . ,drv)))))
- (opt opt))
- opts))
-
-(define (options/with-source store opts)
- "Process with 'with-source' options in OPTS, replacing the relevant package
-arguments with packages that use the specified source."
- (define new-sources
- (filter-map (match-lambda
- (('with-source . uri)
- (cons (package-name->name+version (basename uri))
- uri))
- (_ #f))
- opts))
-
- (let loop ((opts opts)
- (sources new-sources)
- (result '()))
- (match opts
- (()
- (unless (null? sources)
- (warning (_ "sources do not match any package:~{ ~a~}~%")
- (match sources
- (((name . uri) ...)
- uri))))
- (reverse result))
- ((('argument . (? package? p)) tail ...)
- (let ((source (assoc-ref sources (package-name p))))
- (loop tail
- (alist-delete (package-name p) sources)
- (alist-cons 'argument
- (if source
- (package-with-source store p source)
- p)
- result))))
- ((('with-source . _) tail ...)
- (loop tail sources result))
- ((head tail ...)
- (loop tail sources (cons head result))))))
+ (proc p))))))
+ ((? derivation? drv)
+ (list drv))
+ ((? procedure? proc)
+ (list (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (proc))
+ #:system system)))
+ ((? gexp? gexp)
+ (list (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (gexp->derivation "gexp" gexp
+ #:system system))))))
+ (map (cut transform store <>)
+ (options->things-to-build opts)))))
+
+(define (show-build-log store file urls)
+ "Show the build log for FILE, falling back to remote logs from URLS if
+needed."
+ (let ((log (or (log-file store file)
+ (log-url store file #:base-urls urls))))
+ (if log
+ (format #t "~a~%" log)
+ (leave (G_ "no build log for '~a'~%") file))))
\f
;;;
;;;
(define (guix-build . args)
+ (define opts
+ (parse-command-line args %options
+ (list %default-options)))
+
+ (define quiet?
+ (assoc-ref opts 'quiet?))
+
(with-error-handling
;; Ask for absolute file names so that .drv file names passed from the
;; user to 'read-derivation' are absolute when it returns.
(with-fluids ((%file-port-name-canonicalization 'absolute))
- (let* ((opts (parse-command-line args %options
- (list %default-options)))
- (store (open-connection))
- (drv (options->derivations store opts))
- (urls (map (cut string-append <> "/log")
- (if (assoc-ref opts 'substitutes?)
- (or (assoc-ref opts 'substitute-urls)
- %default-substitute-urls)
- '())))
- (roots (filter-map (match-lambda
- (('gc-root . root) root)
- (_ #f))
- opts)))
-
+ (with-store store
+ ;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts)
- (unless (assoc-ref opts 'log-file?)
- (show-what-to-build store drv
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:dry-run? (assoc-ref opts 'dry-run?)))
-
- (cond ((assoc-ref opts 'log-file?)
- (for-each (lambda (file)
- (let ((log (or (log-file store file)
- (log-url store file
- #:base-urls urls))))
- (if log
- (format #t "~a~%" log)
- (leave (_ "no build log for '~a'~%")
- file))))
- (delete-duplicates
- (append (map derivation-file-name drv)
- (filter-map (match-lambda
- (('argument
- . (? store-path? file))
- file)
- (_ #f))
- opts)))))
- ((assoc-ref opts 'derivations-only?)
- (format #t "~{~a~%~}" (map derivation-file-name drv))
- (for-each (cut register-root store <> <>)
- (map (compose list derivation-file-name) drv)
- roots))
- ((not (assoc-ref opts 'dry-run?))
- (and (build-derivations store drv)
- (for-each (lambda (d)
- (format #t "~{~a~%~}"
- (map (match-lambda
- ((out-name . out)
- (derivation->output-path
- d out-name)))
- (derivation-outputs d))))
- drv)
- (for-each (cut register-root store <> <>)
- (map (lambda (drv)
- (map cdr
- (derivation->output-paths drv)))
- drv)
- roots))))))))
+
+ (parameterize ((current-build-output-port (if quiet?
+ (%make-void-port "w")
+ (current-error-port))))
+ (let* ((mode (assoc-ref opts 'build-mode))
+ (drv (options->derivations store opts))
+ (urls (map (cut string-append <> "/log")
+ (if (assoc-ref opts 'substitutes?)
+ (or (assoc-ref opts 'substitute-urls)
+ ;; XXX: This does not necessarily match the
+ ;; daemon's substitute URLs.
+ %default-substitute-urls)
+ '())))
+ (items (filter-map (match-lambda
+ (('argument . (? store-path? file))
+ file)
+ (_ #f))
+ opts))
+ (roots (filter-map (match-lambda
+ (('gc-root . root) root)
+ (_ #f))
+ opts)))
+
+ (unless (or (assoc-ref opts 'log-file?)
+ (assoc-ref opts 'derivations-only?))
+ (show-what-to-build store drv
+ #:use-substitutes?
+ (assoc-ref opts 'substitutes?)
+ #:dry-run? (assoc-ref opts 'dry-run?)
+ #:mode mode))
+
+ (cond ((assoc-ref opts 'log-file?)
+ (for-each (cut show-build-log store <> urls)
+ (delete-duplicates
+ (append (map derivation-file-name drv)
+ items))))
+ ((assoc-ref opts 'derivations-only?)
+ (format #t "~{~a~%~}" (map derivation-file-name drv))
+ (for-each (cut register-root store <> <>)
+ (map (compose list derivation-file-name) drv)
+ roots))
+ ((not (assoc-ref opts 'dry-run?))
+ (and (build-derivations store drv mode)
+ (for-each show-derivation-outputs drv)
+ (for-each (cut register-root store <> <>)
+ (map (lambda (drv)
+ (map cdr
+ (derivation->output-paths drv)))
+ drv)
+ roots))))))))))
HCoop / jackhill / guix / guix.git / blobdiff