diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/challenge.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/style.scm | 36 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 100 |
3 files changed, 86 insertions, 55 deletions
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index 5c0f837d13..f1e5f67dab 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -537,8 +537,9 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (current-terminal-columns (terminal-columns))) (let ((files (match files (() - (filter (cut locally-built? store <>) - (live-paths store))) + (warning + (G_ "no arguments specified, nothing to do~%")) + (exit 0)) (x files)))) (set-build-options store diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index ca3853af5e..9fd652beb1 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -44,6 +44,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:export (pretty-print-with-comments read-with-comments @@ -272,6 +273,16 @@ included in the output. Lists longer than LONG-LIST are written as one element per line. Comments are passed through FORMAT-COMMENT before being emitted; a useful value for FORMAT-COMMENT is 'canonicalize-comment'." + (define (list-of-lists? head tail) + ;; Return true if HEAD and TAIL denote a list of lists--e.g., a list of + ;; 'let' bindings. + (match head + ((thing _ ...) ;proper list + (and (not (memq thing + '(quote quasiquote unquote unquote-splicing))) + (pair? tail))) + (_ #f))) + (let loop ((indent indent) (column indent) (delimited? #t) ;true if comes after a delimiter @@ -436,7 +447,8 @@ FORMAT-COMMENT is 'canonicalize-comment'." (column (if overflow? (+ indent 1) (+ column (if delimited? 1 2)))) - (newline? (newline-form? head context)) + (newline? (or (newline-form? head context) + (list-of-lists? head tail))) ;'let' bindings (context (cons head context))) (if overflow? (begin @@ -672,7 +684,16 @@ doing it." "Replace the file name in LOC by an absolute location." (location (if (string-prefix? "/" (location-file loc)) (location-file loc) - (search-path %load-path (location-file loc))) + + ;; 'search-path' might return #f in obscure cases, such as + ;; when %LOAD-PATH includes "." or ".." and LOC comes from a + ;; file in a subdirectory thereof. + (match (search-path %load-path (location-file loc)) + (#f + (raise (formatted-message + (G_ "file '~a' not found on load path") + (location-file loc)))) + (str str))) (location-line loc) (location-column loc))) @@ -798,15 +819,26 @@ PACKAGE." (lambda args (show-help) (exit 0))) + (option '(#\l "list-stylings") #f #f + (lambda args + (show-stylings) + (exit 0))) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix style"))))) +(define (show-stylings) + (display (G_ "Available styling rules:\n")) + (display (G_ "- format: Format the given package definition(s)\n")) + (display (G_ "- inputs: Rewrite package inputs to the “new style”\n"))) + (define (show-help) (display (G_ "Usage: guix style [OPTION]... [PACKAGE]... Update package definitions to the latest style.\n")) (display (G_ " -S, --styling=RULE apply RULE, a styling rule")) + (display (G_ " + -l, --list-stylings display the list of available style rules")) (newline) (display (G_ " -n, --dry-run display files that would be edited but do nothing")) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index c5f5d23b47..cdf591ac4d 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> @@ -55,11 +55,11 @@ #:use-module (ice-9 ftw) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (web uri) #:use-module (guix http-client) #:export (%allow-unauthenticated-substitutes? @@ -293,10 +293,10 @@ daemon." (for-each (cute format port "~a/~a~%" (%store-prefix) <>) (narinfo-references narinfo)) - (let-values (((uri compression file-size) - (narinfo-best-uri narinfo - #:fast-decompression? - %prefer-fast-decompression?))) + (let ((uri compression file-size + (narinfo-best-uri narinfo + #:fast-decompression? + %prefer-fast-decompression?))) (format port "~a\n~a\n" (or file-size 0) (or (narinfo-size narinfo) 0)))) @@ -378,13 +378,13 @@ server certificates." (#f ;; Open a new connection to URI and evict old entries from ;; CACHE, if any. - (let-values (((socket) - (guix:open-connection-for-uri - uri - #:verify-certificate? verify-certificate? - #:timeout timeout)) - ((new-cache evicted) - (at-most (- %max-cached-connections 1) cache))) + (let ((socket + (guix:open-connection-for-uri + uri + #:verify-certificate? verify-certificate? + #:timeout timeout)) + (new-cache evicted + (at-most (- %max-cached-connections 1) cache))) (for-each (match-lambda ((_ . port) (false-if-exception (close-port port)))) @@ -494,49 +494,47 @@ PORT." (leave (G_ "no valid substitute for '~a'~%") store-item)) - (let-values (((uri compression file-size) - (narinfo-best-uri narinfo - #:fast-decompression? - %prefer-fast-decompression?))) + (let ((uri compression file-size + (narinfo-best-uri narinfo + #:fast-decompression? + %prefer-fast-decompression?))) (unless print-build-trace? (format (current-error-port) (G_ "Downloading ~a...~%") (uri->string uri))) - (let*-values (((raw download-size) - ;; 'guix publish' without '--cache' doesn't specify a - ;; Content-Length, so DOWNLOAD-SIZE is #f in this case. - (fetch uri)) - ((progress) - (let* ((dl-size (or download-size - (and (equal? compression "none") - (narinfo-size narinfo)))) - (reporter (if print-build-trace? - (progress-reporter/trace - destination - (uri->string uri) dl-size - (current-error-port)) - (progress-reporter/file - (uri->string uri) dl-size - (current-error-port) - #:abbreviation nar-uri-abbreviation)))) - ;; Keep RAW open upon completion so we can later reuse - ;; the underlying connection. Pass the download size so - ;; that this procedure won't block reading from RAW. - (progress-report-port reporter raw - #:close? #f - #:download-size dl-size))) - ((input pids) - ;; NOTE: This 'progress' port of current process will be - ;; closed here, while the child process doing the - ;; reporting will close it upon exit. - (decompressed-port (string->symbol compression) - progress)) + (let* ((raw download-size + ;; 'guix publish' without '--cache' doesn't specify a + ;; Content-Length, so DOWNLOAD-SIZE is #f in this case. + (fetch uri)) + (progress + (let* ((dl-size (or download-size + (and (equal? compression "none") + (narinfo-size narinfo)))) + (reporter (if print-build-trace? + (progress-reporter/trace + destination + (uri->string uri) dl-size + (current-error-port)) + (progress-reporter/file + (uri->string uri) dl-size + (current-error-port) + #:abbreviation nar-uri-abbreviation)))) + ;; Keep RAW open upon completion so we can later reuse + ;; the underlying connection. Pass the download size so + ;; that this procedure won't block reading from RAW. + (progress-report-port reporter raw + #:close? #f + #:download-size dl-size))) + (input pids + ;; NOTE: This 'progress' port of current process will be + ;; closed here, while the child process doing the + ;; reporting will close it upon exit. + (decompressed-port (string->symbol compression) + progress)) - ;; Compute the actual nar hash as we read it. - ((algorithm expected) - (narinfo-hash-algorithm+value narinfo)) - ((hashed get-hash) - (open-hash-input-port algorithm input))) + ;; Compute the actual nar hash as we read it. + (algorithm expected (narinfo-hash-algorithm+value narinfo)) + (hashed get-hash (open-hash-input-port algorithm input))) ;; Unpack the Nar at INPUT into DESTINATION. (define cpu-usage (with-cpu-usage-monitoring |