- (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 (G_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
- file line column
- (package-full-name package) input)))
- ((package-cross-build-system-error? c)
- (let* ((package (package-error-package c))
- (loc (package-location package))
- (system (package-build-system package)))
- (leave (G_ "~a: ~a: build system `~a' does not support cross builds~%")
- (location->string loc)
- (package-full-name package)
- (build-system-name system))))
- ((gexp-input-error? c)
- (let ((input (package-error-invalid-input c)))
- (leave (G_ "~s: invalid G-expression input~%")
- (gexp-error-invalid-input c))))
- ((profile-not-found-error? c)
- (leave (G_ "profile '~a' does not exist~%")
- (profile-error-profile c)))
- ((missing-generation-error? c)
- (leave (G_ "generation ~a of profile '~a' does not exist~%")
- (missing-generation-error-generation c)
- (profile-error-profile c)))
- ((unmatched-pattern-error? c)
- (let ((pattern (unmatched-pattern-error-pattern c)))
- (leave (G_ "package '~a~@[@~a~]~@[:~a~]' not found in profile~%")
- (manifest-pattern-name pattern)
- (manifest-pattern-version pattern)
- (match (manifest-pattern-output pattern)
- ("out" #f)
- (output output)))))
- ((profile-collision-error? c)
- (let ((entry (profile-collision-error-entry c))
- (conflict (profile-collision-error-conflict c)))
- (define (report-parent-entries entry)
- (let ((parent (force (manifest-entry-parent entry))))
- (when (manifest-entry? parent)
- (report-error (G_ " ... propagated from ~a@~a~%")
- (manifest-entry-name parent)
- (manifest-entry-version parent))
- (report-parent-entries parent))))
-
- (define (manifest-entry-output* entry)
- (match (manifest-entry-output entry)
- ("out" "")
- (output (string-append ":" output))))
-
- (report-error (G_ "profile contains conflicting entries for ~a~a~%")
- (manifest-entry-name entry)
- (manifest-entry-output* entry))
- (report-error (G_ " first entry: ~a@~a~a ~a~%")
- (manifest-entry-name entry)
- (manifest-entry-version entry)
- (manifest-entry-output* entry)
- (manifest-entry-item entry))
- (report-parent-entries entry)
- (report-error (G_ " second entry: ~a@~a~a ~a~%")
- (manifest-entry-name conflict)
- (manifest-entry-version conflict)
- (manifest-entry-output* conflict)
- (manifest-entry-item conflict))
- (report-parent-entries conflict)
- (display-collision-resolution-hint c)
- (exit 1)))
- ((nar-error? c)
- (let ((file (nar-error-file c))
- (port (nar-error-port c)))
- (if file
- (leave (G_ "corrupt input while restoring '~a' from ~s~%")
- file (or (port-filename* port) port))
- (leave (G_ "corrupt input while restoring archive from ~s~%")
- (or (port-filename* port) port)))))
- ((store-connection-error? c)
- (leave (G_ "failed to connect to `~a': ~a~%")
- (store-connection-error-file c)
- (strerror (store-connection-error-code c))))
- ((store-protocol-error? c)
- ;; FIXME: Server-provided error messages aren't i18n'd.
- (leave (G_ "~a~%")
- (store-protocol-error-message c)))
- ((derivation-missing-output-error? c)
- (leave (G_ "reference to invalid output '~a' of derivation '~a'~%")
- (derivation-missing-output c)
- (derivation-file-name (derivation-error-derivation c))))
- ((file-search-error? c)
- (leave (G_ "file '~a' could not be found in these \
+ (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 (G_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
+ file line column
+ (package-full-name package) input)))
+ ((package-cross-build-system-error? c)
+ (let* ((package (package-error-package c))
+ (loc (package-location package))
+ (system (package-build-system package)))
+ (leave (G_ "~a: ~a: build system `~a' does not support cross builds~%")
+ (location->string loc)
+ (package-full-name package)
+ (build-system-name system))))
+ ((gexp-input-error? c)
+ (let ((input (package-error-invalid-input c)))
+ (leave (G_ "~s: invalid G-expression input~%")
+ (gexp-error-invalid-input c))))
+ ((profile-not-found-error? c)
+ (leave (G_ "profile '~a' does not exist~%")
+ (profile-error-profile c)))
+ ((missing-generation-error? c)
+ (leave (G_ "generation ~a of profile '~a' does not exist~%")
+ (missing-generation-error-generation c)
+ (profile-error-profile c)))
+ ((unmatched-pattern-error? c)
+ (let ((pattern (unmatched-pattern-error-pattern c)))
+ (leave (G_ "package '~a~@[@~a~]~@[:~a~]' not found in profile~%")
+ (manifest-pattern-name pattern)
+ (manifest-pattern-version pattern)
+ (match (manifest-pattern-output pattern)
+ ("out" #f)
+ (output output)))))
+ ((profile-collision-error? c)
+ (let ((entry (profile-collision-error-entry c))
+ (conflict (profile-collision-error-conflict c)))
+ (define (report-parent-entries entry)
+ (let ((parent (force (manifest-entry-parent entry))))
+ (when (manifest-entry? parent)
+ (report-error (G_ " ... propagated from ~a@~a~%")
+ (manifest-entry-name parent)
+ (manifest-entry-version parent))
+ (report-parent-entries parent))))
+
+ (define (manifest-entry-output* entry)
+ (match (manifest-entry-output entry)
+ ("out" "")
+ (output (string-append ":" output))))
+
+ (report-error (G_ "profile contains conflicting entries for ~a~a~%")
+ (manifest-entry-name entry)
+ (manifest-entry-output* entry))
+ (report-error (G_ " first entry: ~a@~a~a ~a~%")
+ (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (manifest-entry-output* entry)
+ (manifest-entry-item entry))
+ (report-parent-entries entry)
+ (report-error (G_ " second entry: ~a@~a~a ~a~%")
+ (manifest-entry-name conflict)
+ (manifest-entry-version conflict)
+ (manifest-entry-output* conflict)
+ (manifest-entry-item conflict))
+ (report-parent-entries conflict)
+ (display-collision-resolution-hint c)
+ (exit 1)))
+ ((nar-error? c)
+ (let ((file (nar-error-file c))
+ (port (nar-error-port c)))
+ (if file
+ (leave (G_ "corrupt input while restoring '~a' from ~s~%")
+ file (or (port-filename* port) port))
+ (leave (G_ "corrupt input while restoring archive from ~s~%")
+ (or (port-filename* port) port)))))
+ ((store-connection-error? c)
+ (leave (G_ "failed to connect to `~a': ~a~%")
+ (store-connection-error-file c)
+ (strerror (store-connection-error-code c))))
+ ((store-protocol-error? c)
+ ;; FIXME: Server-provided error messages aren't i18n'd.
+ (leave (G_ "~a~%")
+ (store-protocol-error-message c)))
+ ((derivation-missing-output-error? c)
+ (leave (G_ "reference to invalid output '~a' of derivation '~a'~%")
+ (derivation-missing-output c)
+ (derivation-file-name (derivation-error-derivation c))))
+ ((file-search-error? c)
+ (leave (G_ "file '~a' could not be found in these \