summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-build.in139
-rw-r--r--guix/packages.scm2
2 files changed, 79 insertions, 62 deletions
diff --git a/guix-build.in b/guix-build.in
index 9bc0f684d3..c241bf4fef 100644
--- a/guix-build.in
+++ b/guix-build.in
@@ -30,11 +30,12 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
- #:use-module ((guix utils) #:select (%current-system))
+ #:use-module (guix utils)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:autoload (distro) (find-packages-by-name)
#:export (guix-build))
@@ -169,65 +170,79 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
- (let* ((opts (parse-options))
- (src? (assoc-ref opts 'source?))
- (sys (assoc-ref opts 'system))
- (drv (filter-map (match-lambda
- (('expression . exp)
- (derivations-from-package-expressions exp sys
- src?))
- (('argument . (? derivation-path? drv))
- drv)
- (('argument . (? string? x))
- (match (find-packages-by-name x)
- ((p _ ...)
- (if src?
- (let ((s (package-source p)))
- (package-source-derivation %store s))
- (package-derivation %store p sys)))
- (_
- (leave (_ "~A: unknown package~%") x))))
- (_ #f))
- opts))
- (req (append-map (lambda (drv-path)
- (let ((d (call-with-input-file drv-path
- read-derivation)))
- (derivation-prerequisites-to-build %store d)))
- drv))
- (req* (delete-duplicates
- (append (remove (compose (cut valid-path? %store <>)
- derivation-path->output-path)
- drv)
- (map derivation-input-path req)))))
- (if (assoc-ref opts 'dry-run?)
- (format (current-error-port)
- (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*)
- (format (current-error-port)
- (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*))
-
- ;; TODO: Add more options.
- (set-build-options %store
- #:keep-failed? (assoc-ref opts 'keep-failed?)
- #:build-cores (or (assoc-ref opts 'cores) 0)
- #:use-substitutes? (assoc-ref opts 'substitutes?))
-
- (if (assoc-ref opts 'derivations-only?)
- (format #t "~{~a~%~}" drv)
- (or (assoc-ref opts 'dry-run?)
- (and (build-derivations %store drv)
- (for-each (lambda (d)
- (let ((drv (call-with-input-file d
+ (guard (c ((package-input-error? c)
+ (let* ((package (package-error-package c))
+ (input (package-error-invalid-input c))
+ (location (package-location package))
+ (file (location-file location))
+ (line (location-line location))
+ (column (location-column location)))
+ (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
+ file line column
+ (package-full-name package) input))))
+ (let* ((opts (parse-options))
+ (src? (assoc-ref opts 'source?))
+ (sys (assoc-ref opts 'system))
+ (drv (filter-map (match-lambda
+ (('expression . exp)
+ (derivations-from-package-expressions exp sys
+ src?))
+ (('argument . (? derivation-path? drv))
+ drv)
+ (('argument . (? string? x))
+ (match (find-packages-by-name x)
+ ((p _ ...)
+ (if src?
+ (let ((s (package-source p)))
+ (package-source-derivation %store s))
+ (package-derivation %store p sys)))
+ (_
+ (leave (_ "~A: unknown package~%") x))))
+ (_ #f))
+ opts))
+ (req (append-map (lambda (drv-path)
+ (let ((d (call-with-input-file drv-path
read-derivation)))
- (format #t "~{~a~%~}"
- (map (match-lambda
- ((out-name . out)
- (derivation-path->output-path
- d out-name)))
- (derivation-outputs drv)))))
- drv))))))
+ (derivation-prerequisites-to-build %store d)))
+ drv))
+ (req* (delete-duplicates
+ (append (remove (compose (cut valid-path? %store <>)
+ derivation-path->output-path)
+ drv)
+ (map derivation-input-path req)))))
+ (if (assoc-ref opts 'dry-run?)
+ (format (current-error-port)
+ (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
+ "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
+ (length req*))
+ (null? req*) req*)
+ (format (current-error-port)
+ (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
+ "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
+ (length req*))
+ (null? req*) req*))
+
+ ;; TODO: Add more options.
+ (set-build-options %store
+ #:keep-failed? (assoc-ref opts 'keep-failed?)
+ #:build-cores (or (assoc-ref opts 'cores) 0)
+ #:use-substitutes? (assoc-ref opts 'substitutes?))
+
+ (if (assoc-ref opts 'derivations-only?)
+ (format #t "~{~a~%~}" drv)
+ (or (assoc-ref opts 'dry-run?)
+ (and (build-derivations %store drv)
+ (for-each (lambda (d)
+ (let ((drv (call-with-input-file d
+ read-derivation)))
+ (format #t "~{~a~%~}"
+ (map (match-lambda
+ ((out-name . out)
+ (derivation-path->output-path
+ d out-name)))
+ (derivation-outputs drv)))))
+ drv)))))))
+
+;; Local Variables:
+;; eval: (put 'guard 'scheme-indent-function 1)
+;; End:
diff --git a/guix/packages.scm b/guix/packages.scm
index 0020783211..25acab1864 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -61,8 +61,10 @@
package-cross-derivation
&package-error
+ package-error?
package-error-package
&package-input-error
+ package-input-error?
package-error-invalid-input))
;;; Commentary: