diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/build.scm | 22 | ||||
| -rw-r--r-- | guix/scripts/challenge.scm | 185 | ||||
| -rw-r--r-- | guix/scripts/container/exec.scm | 13 | ||||
| -rw-r--r-- | guix/scripts/copy.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 33 | ||||
| -rw-r--r-- | guix/scripts/graph.scm | 15 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 3 | ||||
| -rw-r--r-- | guix/scripts/import/stackage.scm | 115 | ||||
| -rw-r--r-- | guix/scripts/lint.scm | 25 | ||||
| -rw-r--r-- | guix/scripts/refresh.scm | 1 |
10 files changed, 293 insertions, 123 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index ccb4c275fc..68402fda18 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -24,7 +24,6 @@ #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix grafts) - #:use-module (guix combinators) ;; Use the procedure that destructures "NAME-VERSION" forms. #:use-module ((guix utils) #:hide (package-name->name+version)) @@ -99,8 +98,10 @@ found. Return #f if no build log was found." (define (register-root store paths root) "Register ROOT as an indirect GC root for all of PATHS." - (let* ((root (string-append (canonicalize-path (dirname root)) - "/" root))) + (let* ((root (if (string-prefix? "/" root) + root + (string-append (canonicalize-path (dirname root)) + "/" root)))) (catch 'system-error (lambda () (match paths @@ -344,8 +345,8 @@ options handled by 'set-build-options-from-command-line', and listed in #:keep-failed? (assoc-ref opts 'keep-failed?) #:keep-going? (assoc-ref opts 'keep-going?) #:rounds (assoc-ref opts 'rounds) - #:build-cores (or (assoc-ref opts 'cores) 0) - #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1) + #:build-cores (assoc-ref opts 'cores) + #:max-build-jobs (assoc-ref opts 'max-jobs) #:fallback? (assoc-ref opts 'fallback?) #:use-substitutes? (assoc-ref opts 'substitutes?) #:substitute-urls (assoc-ref opts 'substitute-urls) @@ -462,7 +463,6 @@ options handled by 'set-build-options-from-command-line', and listed in (substitutes? . #t) (build-hook? . #t) (print-build-trace? . #t) - (max-silent-time . 3600) (verbosity . 0))) (define (show-help) @@ -487,6 +487,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (display (_ " --check rebuild items to check for non-determinism issues")) (display (_ " + --repair repair the specified items")) + (display (_ " -r, --root=FILE make FILE a symlink to the result, and register it as a garbage collector root")) (display (_ " @@ -536,6 +538,12 @@ must be one of 'package', 'all', or 'transitive'~%") (alist-cons 'build-mode (build-mode check) result) rest))) + (option '("repair") #f #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'build-mode (build-mode repair) + result) + rest))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index 9ab4fbe2a9..815bb789c3 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,12 +37,17 @@ #:use-module (ice-9 vlist) #:use-module (ice-9 format) #:use-module (web uri) - #:export (discrepancies + #:export (compare-contents - discrepancy? - discrepancy-item - discrepancy-local-sha256 - discrepancy-narinfos + comparison-report? + comparison-report-item + comparison-report-result + comparison-report-local-sha256 + comparison-report-narinfos + + comparison-report-match? + comparison-report-mismatch? + comparison-report-inconclusive? guix-challenge)) @@ -61,13 +66,38 @@ (define ensure-store-item ;XXX: move to (guix ui)? (@@ (guix scripts size) ensure-store-item)) -;; Representation of a hash mismatch for ITEM. -(define-record-type <discrepancy> - (discrepancy item local-sha256 narinfos) - discrepancy? - (item discrepancy-item) ;string, /gnu/store/… item - (local-sha256 discrepancy-local-sha256) ;bytevector | #f - (narinfos discrepancy-narinfos)) ;list of <narinfo> +;; Representation of a comparison report for ITEM. +(define-record-type <comparison-report> + (%comparison-report item result local-sha256 narinfos) + comparison-report? + (item comparison-report-item) ;string, /gnu/store/… item + (result comparison-report-result) ;'match | 'mismatch | 'inconclusive + (local-sha256 comparison-report-local-sha256) ;bytevector | #f + (narinfos comparison-report-narinfos)) ;list of <narinfo> + +(define-syntax comparison-report + ;; Some sort of a an enum to make sure 'result' is correct. + (syntax-rules (match mismatch inconclusive) + ((_ item 'match rest ...) + (%comparison-report item 'match rest ...)) + ((_ item 'mismatch rest ...) + (%comparison-report item 'mismatch rest ...)) + ((_ item 'inconclusive rest ...) + (%comparison-report item 'inconclusive rest ...)))) + +(define (comparison-report-predicate result) + "Return a predicate that returns true when pass a REPORT that has RESULT." + (lambda (report) + (eq? (comparison-report-result report) result))) + +(define comparison-report-mismatch? + (comparison-report-predicate 'mismatch)) + +(define comparison-report-match? + (comparison-report-predicate 'match)) + +(define comparison-report-inconclusive? + (comparison-report-predicate 'inconclusive)) (define (locally-built? store item) "Return true if ITEM was built locally." @@ -88,10 +118,10 @@ Otherwise return #f." (define-syntax-rule (report args ...) (format (current-error-port) args ...)) -(define (discrepancies items servers) +(define (compare-contents items servers) "Challenge the substitute servers whose URLs are listed in SERVERS by comparing the hash of the substitutes of ITEMS that they serve. Return the -list of discrepancies. +list of <comparison-report> objects. This procedure does not authenticate narinfos from SERVERS, nor does it verify that they are signed by an authorized public keys. The reason is that, by @@ -100,11 +130,7 @@ taken since we do not import the archives." (define (compare item reference) ;; Return a procedure to compare the hash of ITEM with REFERENCE. (lambda (narinfo url) - (if (not narinfo) - (begin - (warning (_ "~a: no substitute at '~a'~%") - item url) - #t) + (or (not narinfo) (let ((value (narinfo-hash->sha256 (narinfo-hash narinfo)))) (bytevector=? reference value))))) @@ -116,9 +142,7 @@ taken since we do not import the archives." ((url urls ...) (if (not first) (select-reference item narinfos urls) - (narinfo-hash->sha256 (narinfo-hash first)))))) - (() - (warning (_ "no substitutes for '~a'; cannot conclude~%") item)))) + (narinfo-hash->sha256 (narinfo-hash first)))))))) (mlet* %store-monad ((local (mapm %store-monad query-locally-built-hash items)) @@ -130,42 +154,61 @@ taken since we do not import the archives." vhash)) vlist-null remote))) - (return (filter-map (lambda (item local) - (let ((narinfos (vhash-fold* cons '() item narinfos))) - (define reference - (or local - (begin - (warning (_ "no local build for '~a'~%") item) - (select-reference item narinfos servers)))) - - (if (every (compare item reference) - narinfos servers) - #f - (discrepancy item local narinfos)))) - items - local)))) - -(define* (summarize-discrepancy discrepancy - #:key (hash->string - bytevector->nix-base32-string)) - "Write to the current error port a summary of DISCREPANCY, a <discrepancy> -object that denotes a hash mismatch." - (match discrepancy - (($ <discrepancy> item local (narinfos ...)) + (return (map (lambda (item local) + (match (vhash-fold* cons '() item narinfos) + (() ;no substitutes + (comparison-report item 'inconclusive local '())) + ((narinfo) + (if local + (if ((compare item local) narinfo (first servers)) + (comparison-report item 'match + local (list narinfo)) + (comparison-report item 'mismatch + local (list narinfo))) + (comparison-report item 'inconclusive + local (list narinfo)))) + ((narinfos ...) + (let ((reference + (or local (select-reference item narinfos + servers)))) + (if (every (compare item reference) narinfos servers) + (comparison-report item 'match + local narinfos) + (comparison-report item 'mismatch + local narinfos)))))) + items + local)))) + +(define* (summarize-report comparison-report + #:key + (hash->string bytevector->nix-base32-string) + verbose?) + "Write to the current error port a summary of REPORT, a <comparison-report> +object. When VERBOSE?, display matches in addition to mismatches and +inconclusive reports." + (define (report-hashes item local narinfos) + (if local + (report (_ " local hash: ~a~%") (hash->string local)) + (report (_ " no local build for '~a'~%") item)) + (for-each (lambda (narinfo) + (report (_ " ~50a: ~a~%") + (uri->string (narinfo-uri narinfo)) + (hash->string + (narinfo-hash->sha256 (narinfo-hash narinfo))))) + narinfos)) + + (match comparison-report + (($ <comparison-report> item 'mismatch local (narinfos ...)) (report (_ "~a contents differ:~%") item) - (if local - (report (_ " local hash: ~a~%") (hash->string local)) - (warning (_ "no local build for '~a'~%") item)) - - (for-each (lambda (narinfo) - (if narinfo - (report (_ " ~50a: ~a~%") - (uri->string (narinfo-uri narinfo)) - (hash->string - (narinfo-hash->sha256 (narinfo-hash narinfo)))) - (report (_ " ~50a: unavailable~%") - (uri->string (narinfo-uri narinfo))))) - narinfos)))) + (report-hashes item local narinfos)) + (($ <comparison-report> item 'inconclusive #f narinfos) + (warning (_ "could not challenge '~a': no local build~%") item)) + (($ <comparison-report> item 'inconclusive locals ()) + (warning (_ "could not challenge '~a': no substitutes~%") item)) + (($ <comparison-report> item 'match local (narinfos ...)) + (when verbose? + (report (_ "~a contents match:~%") item) + (report-hashes item local narinfos))))) ;;; @@ -178,6 +221,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (display (_ " --substitute-urls=URLS compare build results with those at URLS")) + (display (_ " + -v, --verbose show details about successful comparisons")) (newline) (display (_ " -h, --help display this help and exit")) @@ -201,6 +246,11 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (alist-cons 'substitute-urls (string-tokenize arg) (alist-delete 'substitute-urls result)) + rest))) + (option '("verbose" #\v) #f #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'verbose? #t result) rest))))) (define %default-options @@ -220,7 +270,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (_ #f)) opts)) (system (assoc-ref opts 'system)) - (urls (assoc-ref opts 'substitute-urls))) + (urls (assoc-ref opts 'substitute-urls)) + (verbose? (assoc-ref opts 'verbose?))) (leave-on-EPIPE (with-store store ;; Disable grafts since substitute servers normally provide only @@ -236,13 +287,15 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) #:use-substitutes? #f) (run-with-store store - (mlet* %store-monad ((items (mapm %store-monad - ensure-store-item files)) - (issues (discrepancies items urls))) - (for-each summarize-discrepancy issues) - (unless (null? issues) - (exit 2)) - (return (null? issues))) + (mlet* %store-monad ((items (mapm %store-monad + ensure-store-item files)) + (reports (compare-contents items urls))) + (for-each (cut summarize-report <> #:verbose? verbose?) + reports) + + (exit (cond ((any comparison-report-mismatch? reports) 2) + ((every comparison-report-match? reports) 0) + (else 1)))) #:system system)))))))) ;;; challenge.scm ends here diff --git a/guix/scripts/container/exec.scm b/guix/scripts/container/exec.scm index 10e70568cc..d6d267daff 100644 --- a/guix/scripts/container/exec.scm +++ b/guix/scripts/container/exec.scm @@ -74,7 +74,14 @@ and the other containing arguments for the command to be executed." (let* ((opts (parse-command-line args %options '(()) #:argument-handler handle-argument)) - (pid (assoc-ref opts 'pid))) + (pid (assoc-ref opts 'pid)) + (environment (filter-map (lambda (name) + (let ((value (getenv name))) + (and value (cons name value)))) + ;; Pass through the TERM environment + ;; variable to inform processes about + ;; the capabilities of the terminal. + '("TERM")))) (unless pid (leave (_ "no pid specified~%"))) @@ -89,6 +96,10 @@ and the other containing arguments for the command to be executed." (lambda () (match command ((program . program-args) + (for-each (match-lambda + ((name . value) + (setenv name value))) + environment) (apply execlp program program program-args))))))) (unless (zero? result) (leave (_ "exec failed with status ~d~%") result))))))) diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm index 9ae204e6c6..624ef73e96 100644 --- a/guix/scripts/copy.scm +++ b/guix/scripts/copy.scm @@ -63,8 +63,8 @@ Throw an error on failure." (match (connect! session) ('ok - ;; Let the SSH agent authenticate us to the server. - (match (userauth-agent! session) + ;; Use public key authentication, via the SSH agent if it's available. + (match (userauth-public-key/auto! session) ('success session) (x diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 1d3be6a84f..44f490043c 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 David Thompson <davet@gnu.org> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -60,12 +60,6 @@ directories in PROFILE, the store path of a profile." (define %default-shell (or (getenv "SHELL") "/bin/sh")) -(define %network-configuration-files - '("/etc/resolv.conf" - "/etc/nsswitch.conf" - "/etc/services" - "/etc/hosts")) - (define (purify-environment) "Unset almost all environment variables. A small number of variables such as 'HOME' and 'USER' are left untouched." @@ -408,21 +402,7 @@ host file systems to mount inside the container." ;; When in Rome, do as Nix build.cc does: Automagically ;; map common network configuration files. (if network? - (filter-map (lambda (file) - (and (file-exists? file) - (file-system-mapping - (source file) - (target file) - ;; XXX: On some GNU/Linux - ;; systems, /etc/resolv.conf is a - ;; symlink to a file in a tmpfs - ;; which, for an unknown reason, - ;; cannot be bind mounted - ;; read-only within the - ;; container. - (writable? - (string=? "/etc/resolv.conf"))))) - %network-configuration-files) + %network-file-mappings '()) ;; Mappings for the union closure of all inputs. (map (lambda (dir) @@ -432,7 +412,8 @@ host file systems to mount inside the container." (writable? #f))) reqs))) (file-systems (append %container-file-systems - (map mapping->file-system mappings)))) + (map file-system-mapping->bind-mount + mappings)))) (exit/status (call-with-container file-systems (lambda () @@ -531,8 +512,10 @@ message if any test fails." (define (register-gc-root target root) "Make ROOT an indirect root to TARGET. This is procedure is idempotent." - (let* ((root (string-append (canonicalize-path (dirname root)) - "/" root))) + (let* ((root (if (string-prefix? "/" root) + root + (string-append (canonicalize-path (dirname root)) + "/" root)))) (catch 'system-error (lambda () (symlink target root) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 79ce503a2e..9804d41929 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,12 +21,12 @@ #:use-module (guix graph) #:use-module (guix grafts) #:use-module (guix scripts) - #:use-module (guix combinators) #:use-module (guix packages) #:use-module (guix monads) #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix derivations) + #:use-module (guix memoization) #:use-module ((guix build-system gnu) #:select (standard-packages)) #:use-module (gnu packages) #:use-module (guix sets) @@ -191,12 +191,11 @@ Dependencies may include packages, origin, and file names." %store-monad)))) (define standard-package-set - (memoize - (lambda () - "Return the set of standard packages provided by GNU-BUILD-SYSTEM." - (match (standard-packages) - (((labels packages . output) ...) - (list->setq packages)))))) + (mlambda () + "Return the set of standard packages provided by GNU-BUILD-SYSTEM." + (match (standard-packages) + (((labels packages . output) ...) + (list->setq packages))))) (define (bag-node-edges-sans-bootstrap thing) "Like 'bag-node-edges', but pretend that the standard packages of diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 4d07e0fd69..8c2f705738 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,8 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran" "crate")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" + "cran" "crate")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/stackage.scm b/guix/scripts/import/stackage.scm new file mode 100644 index 0000000000..cf47bff259 --- /dev/null +++ b/guix/scripts/import/stackage.scm @@ -0,0 +1,115 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import stackage) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix scripts) + #:use-module (guix import stackage) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-stackage)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + `((lts-version . "") + (include-test-dependencies? . #t))) + +(define (show-help) + (display (_ "Usage: guix import stackage PACKAGE-NAME +Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) + (display (_ " + -r VERSION, --lts-version=VERSION + specify the LTS version to use")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -t, --no-test-dependencies don't include test-only dependencies")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import stackage"))) + (option '(#\t "no-test-dependencies") #f #f + (lambda (opt name arg result) + (alist-cons 'include-test-dependencies? #f + (alist-delete 'include-test-dependencies? + result)))) + (option '(#\r "lts-version") #t #f + (lambda (opt name arg result) + (alist-cons 'lts-version arg + (alist-delete 'lts-version + result)))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-stackage . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (stackage->guix-package + package-name + #:include-test-dependencies? + (assoc-ref opts 'include-test-dependencies?) + #:lts-version (assoc-ref opts 'lts-version)))) + (unless sexp + (leave (_ "failed to download cabal file for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) + +;;; stackage.scm ends here diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 9b991786c3..776e7332c5 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> @@ -32,7 +32,7 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix scripts) #:use-module (guix gnu-maintenance) #:use-module (guix monads) @@ -90,9 +90,9 @@ ;; provided MESSAGE. (let ((loc (or (package-field-location package field) (package-location package)))) - (format (guix-warning-port) "~a: ~a: ~a~%" + (format (guix-warning-port) "~a: ~a@~a: ~a~%" (location->string loc) - (package-full-name package) + (package-name package) (package-version package) message))) (define (call-with-accumulated-warnings thunk) @@ -559,12 +559,11 @@ patch could not be found." str))) (define official-gnu-packages* - (memoize - (lambda () - "A memoizing version of 'official-gnu-packages' that returns the empty + (mlambda () + "A memoizing version of 'official-gnu-packages' that returns the empty list when something goes wrong, such as a networking issue." - (let ((gnus (false-if-exception (official-gnu-packages)))) - (or gnus '()))))) + (let ((gnus (false-if-exception (official-gnu-packages)))) + (or gnus '())))) (define (check-gnu-synopsis+description package) "Make sure that, if PACKAGE is a GNU package, it uses the synopsis and @@ -959,12 +958,12 @@ or a list thereof") (define* (run-checkers package #:optional (checkers %checkers)) "Run the given CHECKERS on PACKAGE." - (let ((tty? (isatty? (current-error-port))) - (name (package-full-name package))) + (let ((tty? (isatty? (current-error-port)))) (for-each (lambda (checker) (when tty? - (format (current-error-port) "checking ~a [~a]...\x1b[K\r" - name (lint-checker-name checker)) + (format (current-error-port) "checking ~a@~a [~a]...\x1b[K\r" + (package-name package) (package-version package) + (lint-checker-name checker)) (force-output (current-error-port))) ((lint-checker-check checker) package)) checkers) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 0dd7eee974..4d3c695aaf 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -205,6 +205,7 @@ unavailable optional dependencies such as Guile-JSON." %elpa-updater %cran-updater %bioconductor-updater + ((guix import stackage) => %stackage-updater) %hackage-updater ((guix import cpan) => %cpan-updater) ((guix import pypi) => %pypi-updater) |