summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/describe.scm29
-rw-r--r--guix/scripts/lint.scm56
2 files changed, 50 insertions, 35 deletions
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index e59502076c..d817d7f7ca 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -40,7 +40,11 @@
(lambda (opt name arg result)
(unless (member arg '("human" "channels"))
(leave (G_ "~a: unsupported output format~%") arg))
- (alist-cons 'format 'channels result)))
+ (alist-cons 'format (string->symbol arg) result)))
+ (option '(#\p "profile") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'profile (canonicalize-profile arg)
+ result)))
(option '(#\h "help") #f #f
(lambda args
(show-help)
@@ -58,6 +62,8 @@
Display information about the channels currently in use.\n"))
(display (G_ "
-f, --format=FORMAT display information in the given FORMAT"))
+ (display (G_ "
+ -p, --profile=PROFILE display information about PROFILE"))
(newline)
(display (G_ "
-h, --help display this help and exit"))
@@ -78,11 +84,11 @@ Display information about the channels currently in use.\n"))
(format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%")
string))))))
-(define (display-checkout-info fmt)
+(define* (display-checkout-info fmt #:optional directory)
"Display information about the current checkout according to FMT, a symbol
denoting the requested format. Exit if the current directory does not lie
within a Git checkout."
- (let* ((program (car (command-line)))
+ (let* ((program (or directory (car (command-line))))
(directory (catch 'git-error
(lambda ()
(repository-discover (dirname program)))
@@ -146,15 +152,16 @@ in the format specified by FMT."
;;;
(define (guix-describe . args)
- (let* ((opts (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%")
- name))
- cons
- %default-options))
- (format (assq-ref opts 'format)))
+ (let* ((opts (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (G_ "~A: unrecognized option~%")
+ name))
+ cons
+ %default-options))
+ (format (assq-ref opts 'format))
+ (profile (or (assq-ref opts 'profile) (current-profile))))
(with-error-handling
- (match (current-profile)
+ (match profile
(#f
(display-checkout-info format))
(profile
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index e477bf0ddc..2314f3b28c 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -33,6 +33,7 @@
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix records)
+ #:use-module (guix grafts)
#:use-module (guix ui)
#:use-module (guix upstream)
#:use-module (guix utils)
@@ -774,30 +775,37 @@ descriptions maintained upstream."
(define (check-derivation package)
"Emit a warning if we fail to compile PACKAGE to a derivation."
- (catch #t
- (lambda ()
- (guard (c ((nix-protocol-error? c)
- (emit-warning package
- (format #f (G_ "failed to create derivation: ~a")
- (nix-protocol-error-message c))))
- ((message-condition? c)
- (emit-warning package
- (format #f (G_ "failed to create derivation: ~a")
- (condition-message c)))))
- (with-store store
- ;; Disable grafts since it can entail rebuilds.
- (package-derivation store package #:graft? #f)
-
- ;; If there's a replacement, make sure we can compute its
- ;; derivation.
- (match (package-replacement package)
- (#f #t)
- (replacement
- (package-derivation store replacement #:graft? #f))))))
- (lambda args
- (emit-warning package
- (format #f (G_ "failed to create derivation: ~s~%")
- args)))))
+ (define (try system)
+ (catch #t
+ (lambda ()
+ (guard (c ((nix-protocol-error? c)
+ (emit-warning package
+ (format #f (G_ "failed to create ~a derivation: ~a")
+ system
+ (nix-protocol-error-message c))))
+ ((message-condition? c)
+ (emit-warning package
+ (format #f (G_ "failed to create ~a derivation: ~a")
+ system
+ (condition-message c)))))
+ (with-store store
+ ;; Disable grafts since it can entail rebuilds.
+ (parameterize ((%graft? #f))
+ (package-derivation store package system #:graft? #f)
+
+ ;; If there's a replacement, make sure we can compute its
+ ;; derivation.
+ (match (package-replacement package)
+ (#f #t)
+ (replacement
+ (package-derivation store replacement system
+ #:graft? #f)))))))
+ (lambda args
+ (emit-warning package
+ (format #f (G_ "failed to create ~a derivation: ~s")
+ system args)))))
+
+ (for-each try (package-supported-systems package)))
(define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE."