summaryrefslogtreecommitdiff
path: root/guix/scripts/build.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/build.scm')
-rw-r--r--guix/scripts/build.scm181
1 files changed, 106 insertions, 75 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index a06755dc7a..dd9a9b8127 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -23,6 +23,7 @@
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix utils)
+ #:use-module (guix monads)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
@@ -38,19 +39,23 @@
(define %store
(make-parameter #f))
-(define (derivations-from-package-expressions str package-derivation
- system source?)
+(define (derivation-from-expression str package-derivation
+ system source?)
"Read/eval STR and return the corresponding derivation path for SYSTEM.
-When SOURCE? is true, return the derivations of the package sources;
-otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
- (let ((p (read/eval-package-expression str)))
- (if source?
- (let ((source (package-source p)))
- (if source
- (package-source-derivation (%store) source)
- (leave (_ "package `~a' has no source~%")
- (package-name p))))
- (package-derivation (%store) p system))))
+When SOURCE? is true and STR evaluates to a package, return the derivation of
+the package source; otherwise, use PACKAGE-DERIVATION to compute the
+derivation of a package."
+ (match (read/eval str)
+ ((? package? p)
+ (if source?
+ (let ((source (package-source p)))
+ (if source
+ (package-source-derivation (%store) source)
+ (leave (_ "package `~a' has no source~%")
+ (package-name p))))
+ (package-derivation (%store) p system)))
+ ((? procedure? proc)
+ (run-with-store (%store) (proc) #:system system))))
;;;
@@ -68,7 +73,7 @@ otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
(display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ "
- -e, --expression=EXPR build the package EXPR evaluates to"))
+ -e, --expression=EXPR build the package or derivation EXPR evaluates to"))
(display (_ "
-S, --source build the packages' source derivations"))
(display (_ "
@@ -95,6 +100,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
as a garbage collector root"))
(display (_ "
--verbosity=LEVEL use the given verbosity LEVEL"))
+ (display (_ "
+ --log-file return the log file names for the given derivations"))
(newline)
(display (_ "
-h, --help display this help and exit"))
@@ -161,7 +168,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(lambda (opt name arg result)
(let ((level (string->number arg)))
(alist-cons 'verbosity level
- (alist-delete 'verbosity result)))))))
+ (alist-delete 'verbosity result)))))
+ (option '("log-file") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'log-file? #t result)))))
;;;
@@ -235,68 +245,89 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(leave (_ "~A: unknown package~%") name))))))
(with-error-handling
- (let ((opts (parse-options)))
- (define package->derivation
- (match (assoc-ref opts 'target)
- (#f package-derivation)
- (triplet
- (cut package-cross-derivation <> <> triplet <>))))
+ ;; 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-options)))
+ (define package->derivation
+ (match (assoc-ref opts 'target)
+ (#f package-derivation)
+ (triplet
+ (cut package-cross-derivation <> <> triplet <>))))
- (parameterize ((%store (open-connection)))
- (let* ((src? (assoc-ref opts 'source?))
- (sys (assoc-ref opts 'system))
- (drv (filter-map (match-lambda
- (('expression . str)
- (derivations-from-package-expressions
- str package->derivation sys src?))
- (('argument . (? derivation-path? drv))
- (call-with-input-file drv read-derivation))
- (('argument . (? string? x))
- (let ((p (find-package x)))
- (if src?
- (let ((s (package-source p)))
- (package-source-derivation
- (%store) s))
- (package->derivation (%store) p sys))))
- (_ #f))
- opts))
- (roots (filter-map (match-lambda
- (('gc-root . root) root)
- (_ #f))
- opts)))
+ (parameterize ((%store (open-connection)))
+ (let* ((src? (assoc-ref opts 'source?))
+ (sys (assoc-ref opts 'system))
+ (drv (filter-map (match-lambda
+ (('expression . str)
+ (derivation-from-expression
+ str package->derivation sys src?))
+ (('argument . (? derivation-path? drv))
+ (call-with-input-file drv read-derivation))
+ (('argument . (? store-path?))
+ ;; Nothing to do; maybe for --log-file.
+ #f)
+ (('argument . (? string? x))
+ (let ((p (find-package x)))
+ (if src?
+ (let ((s (package-source p)))
+ (package-source-derivation
+ (%store) s))
+ (package->derivation (%store) p sys))))
+ (_ #f))
+ opts))
+ (roots (filter-map (match-lambda
+ (('gc-root . root) root)
+ (_ #f))
+ opts)))
- (show-what-to-build (%store) drv
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:dry-run? (assoc-ref opts 'dry-run?))
+ (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?)))
- ;; TODO: Add more options.
- (set-build-options (%store)
- #:keep-failed? (assoc-ref opts 'keep-failed?)
- #:build-cores (or (assoc-ref opts 'cores) 0)
- #:fallback? (assoc-ref opts 'fallback?)
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:max-silent-time (assoc-ref opts 'max-silent-time)
- #:verbosity (assoc-ref opts 'verbosity))
+ ;; TODO: Add more options.
+ (set-build-options (%store)
+ #:keep-failed? (assoc-ref opts 'keep-failed?)
+ #:build-cores (or (assoc-ref opts 'cores) 0)
+ #:fallback? (assoc-ref opts 'fallback?)
+ #:use-substitutes? (assoc-ref opts 'substitutes?)
+ #:max-silent-time (assoc-ref opts 'max-silent-time)
+ #:verbosity (assoc-ref opts 'verbosity))
- (if (assoc-ref opts 'derivations-only?)
- (begin
- (format #t "~{~a~%~}" (map derivation-file-name drv))
- (for-each (cut register-root <> <>)
- (map (compose list derivation-file-name) drv)
- roots))
- (or (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 <> <>)
- (map (lambda (drv)
- (map cdr
- (derivation->output-paths drv)))
- drv)
- roots)))))))))
+ (cond ((assoc-ref opts 'log-file?)
+ (for-each (lambda (file)
+ (let ((log (log-file (%store) file)))
+ (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 <> <>)
+ (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 <> <>)
+ (map (lambda (drv)
+ (map cdr
+ (derivation->output-paths drv)))
+ drv)
+ roots))))))))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-08 11:01:25 +0000