diff options
29 files changed, 183 insertions, 91 deletions
diff --git a/Makefile.am b/Makefile.am index 9a810e4ebd..a8dab5d326 100644 --- a/Makefile.am +++ b/Makefile.am @@ -102,6 +102,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ + guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -214,6 +215,7 @@ SCM_TESTS = \ tests/gremlin.scm \ tests/lint.scm \ tests/publish.scm \ + tests/scripts.scm \ tests/size.scm \ tests/graph.scm \ tests/file-systems.scm \ diff --git a/guix/scripts.scm b/guix/scripts.scm new file mode 100644 index 0000000000..6bb3e2169e --- /dev/null +++ b/guix/scripts.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com> +;;; +;;; 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) + #:use-module (guix utils) + #:use-module (guix ui) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (args-fold* + parse-command-line)) + +;;; Commentary: +;;; +;;; General code for Guix scripts. +;;; +;;; Code: + +(define (args-fold* options unrecognized-option-proc operand-proc . seeds) + "A wrapper on top of `args-fold' that does proper user-facing error +reporting." + (catch 'misc-error + (lambda () + (apply args-fold options unrecognized-option-proc + operand-proc seeds)) + (lambda (key proc msg args . rest) + ;; XXX: MSG is not i18n'd. + (leave (_ "invalid argument: ~a~%") + (apply format #f msg args))))) + +(define (environment-build-options) + "Return additional build options passed as environment variables." + (arguments-from-environment-variable "GUIX_BUILD_OPTIONS")) + +(define %default-argument-handler + ;; The default handler for non-option command-line arguments. + (lambda (arg result) + (alist-cons 'argument arg result))) + +(define* (parse-command-line args options seeds + #:key + (argument-handler %default-argument-handler)) + "Parse the command-line arguments ARGS as well as arguments passed via the +'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of +SRFI-37 options) and return the result, seeded by SEEDS. +Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'. + +ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc' +parameter of 'args-fold'." + (define (parse-options-from args seeds) + ;; Actual parsing takes place here. + (apply args-fold* args options + (lambda (opt name arg . rest) + (leave (_ "~A: unrecognized option~%") name)) + argument-handler + seeds)) + + (call-with-values + (lambda () + (parse-options-from (environment-build-options) seeds)) + (lambda seeds + ;; ARGS take precedence over what the environment variable specifies. + (parse-options-from args seeds)))) + +;;; scripts.scm ends here diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index ab2fc46c31..b120c555e3 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -27,6 +27,7 @@ #:use-module (guix ui) #:use-module (guix pki) #:use-module (guix pk-crypto) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (gnu packages) #:use-module (ice-9 match) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index ab2a39b1f8..1d766c0b01 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -19,6 +19,7 @@ (define-module (guix scripts build) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix packages) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 87b420405c..533970ffbb 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -18,6 +18,7 @@ (define-module (guix scripts download) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix hash) #:use-module (guix utils) diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index fc453ac38d..30146af10b 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -18,6 +18,7 @@ (define-module (guix scripts edit) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix utils) #:use-module (guix packages) #:use-module (gnu packages) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index ecdbc7aa37..7aa52e8a8a 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -27,6 +27,7 @@ #:use-module (guix utils) #:use-module (guix monads) #:use-module ((guix gexp) #:select (lower-inputs)) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (gnu packages) #:use-module (ice-9 format) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 6403893687..7e06c72ccb 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -18,6 +18,7 @@ (define-module (guix scripts gc) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (ice-9 regex) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index cddd63e5b7..725ae42030 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -18,6 +18,7 @@ (define-module (guix scripts graph) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix monads) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index e2305d73ee..d44095377b 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -22,6 +22,7 @@ #:use-module (guix hash) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix utils) #:use-module (rnrs io ports) #:use-module (rnrs files) diff --git a/guix/scripts/import/cpan.scm b/guix/scripts/import/cpan.scm index 1f4dedf23f..3d470f684d 100644 --- a/guix/scripts/import/cpan.scm +++ b/guix/scripts/import/cpan.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import cpan) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import cpan) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index f11fa1004f..8d001ac494 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -20,6 +20,7 @@ (define-module (guix scripts import cran) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import cran) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index c72aaf0760..b22a7c4c23 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import elpa) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import elpa) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index 9f8094feac..a5dd2a7822 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import gem) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import gem) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/gnu.scm b/guix/scripts/import/gnu.scm index 5fac6db516..92bd8305ea 100644 --- a/guix/scripts/import/gnu.scm +++ b/guix/scripts/import/gnu.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import gnu) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import gnu) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index 1e33556481..8d31128c47 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import hackage) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import hackage) #:use-module (guix scripts import) #:use-module (srfi srfi-1) @@ -47,7 +48,7 @@ package will be generated. If no version suffix is pecified, then the generated package definition will correspond to the latest available version.\n")) (display (_ " - -e ALIST, --cabal-environment=ALIST + -e ALIST, --cabal-environment=ALIST specify environment for Cabal evaluation")) (display (_ " -h, --help display this help and exit")) diff --git a/guix/scripts/import/nix.scm b/guix/scripts/import/nix.scm index 2dc2677c54..dba053b313 100644 --- a/guix/scripts/import/nix.scm +++ b/guix/scripts/import/nix.scm @@ -20,6 +20,7 @@ (define-module (guix scripts import nix) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import snix) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 1e03843840..7166b014eb 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import pypi) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import pypi) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 71f582afe7..26b40182a5 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -29,6 +29,7 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix gnu-maintenance) #:use-module (guix monads) #:use-module (gnu packages) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 23f1597856..e0fe1ddb27 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -29,6 +29,7 @@ #:use-module (guix monads) #:use-module (guix utils) #:use-module (guix config) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p search-path-as-list)) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index cc96355947..e352090d2d 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -45,6 +45,7 @@ #:use-module (guix store) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix scripts) #:export (guix-publish)) (define (show-help) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index e8459e5ffb..56ee9acb18 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -18,6 +18,7 @@ (define-module (guix scripts pull) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix config) #:use-module (guix packages) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index e7980a97b0..097059e372 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -21,6 +21,7 @@ (define-module (guix scripts refresh) #:use-module (guix ui) #:use-module (guix hash) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index ee070f14b1..44ff92655b 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -18,6 +18,7 @@ (define-module (guix scripts size) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix utils) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 56a9011e94..32d40576ff 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -26,6 +26,7 @@ #:use-module (guix utils) #:use-module (guix monads) #:use-module (guix profiles) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (guix build utils) #:use-module (gnu build install) diff --git a/guix/ui.scm b/guix/ui.scm index ca5b844a43..e028e40f6e 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -2,9 +2,11 @@ ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> +;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com> +;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com> ;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> -;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,7 +41,6 @@ #:use-module (srfi srfi-31) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:use-module (srfi srfi-37) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -79,8 +80,6 @@ package-specification->name+version+output string->generations string->duration - args-fold* - parse-command-line run-guix-command run-guix program-name @@ -959,52 +958,6 @@ optionally contain a version number and an output name, as in these examples: ;;; Command-line option processing. ;;; -(define (args-fold* options unrecognized-option-proc operand-proc . seeds) - "A wrapper on top of `args-fold' that does proper user-facing error -reporting." - (catch 'misc-error - (lambda () - (apply args-fold options unrecognized-option-proc - operand-proc seeds)) - (lambda (key proc msg args . rest) - ;; XXX: MSG is not i18n'd. - (leave (_ "invalid argument: ~a~%") - (apply format #f msg args))))) - -(define (environment-build-options) - "Return additional build options passed as environment variables." - (arguments-from-environment-variable "GUIX_BUILD_OPTIONS")) - -(define %default-argument-handler - ;; The default handler for non-option command-line arguments. - (lambda (arg result) - (alist-cons 'argument arg result))) - -(define* (parse-command-line args options seeds - #:key - (argument-handler %default-argument-handler)) - "Parse the command-line arguments ARGS as well as arguments passed via the -'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of -SRFI-37 options) and return the result, seeded by SEEDS. -Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'. - -ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc' -parameter of 'args-fold'." - (define (parse-options-from args seeds) - ;; Actual parsing takes place here. - (apply args-fold* args options - (lambda (opt name arg . rest) - (leave (_ "~A: unrecognized option~%") name)) - argument-handler - seeds)) - - (call-with-values - (lambda () - (parse-options-from (environment-build-options) seeds)) - (lambda seeds - ;; ARGS take precedence over what the environment variable specifies. - (parse-options-from args seeds)))) - (define (show-guix-usage) (format (current-error-port) (_ "Try `guix --help' for more information.~%")) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 5c2639129b..c0f169eca4 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -4,6 +4,7 @@ gnu/packages.scm gnu/system.scm gnu/services/dmd.scm gnu/system/shadow.scm +guix/scripts.scm guix/scripts/build.scm guix/scripts/download.scm guix/scripts/package.scm diff --git a/tests/scripts.scm b/tests/scripts.scm new file mode 100644 index 0000000000..3bf41aed4d --- /dev/null +++ b/tests/scripts.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (test-scripts) + #:use-module (guix scripts) + #:use-module ((guix scripts build) + #:select (%standard-build-options)) + #:use-module (srfi srfi-64)) + +;; Test the (guix scripts) module. + +(define-syntax-rule (with-environment-variable variable value body ...) + "Run BODY with VARIABLE set to VALUE." + (let ((orig (getenv variable))) + (dynamic-wind + (lambda () + (setenv variable value)) + (lambda () + body ...) + (lambda () + (if orig + (setenv variable orig) + (unsetenv variable)))))) + + +(test-begin "scripts") + +(test-equal "parse-command-line" + '((argument . "bar") (argument . "foo") + (cores . 10) ;takes precedence + (substitutes? . #f) (keep-failed? . #t) + (max-jobs . 77) (cores . 42)) + + (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77" + (parse-command-line '("--keep-failed" "--no-substitutes" + "--cores=10" "foo" "bar") + %standard-build-options + (list '())))) + +(test-equal "parse-command-line and --no options" + '((argument . "foo") + (substitutes? . #f)) ;takes precedence + + (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes" + (parse-command-line '("foo") + %standard-build-options + (list '((substitutes? . #t)))))) + +(test-end "scripts") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) +;;; End: diff --git a/tests/ui.scm b/tests/ui.scm index 1478fe213e..25fc709431 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -22,8 +22,6 @@ #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix derivations) - #:use-module ((guix scripts build) - #:select (%standard-build-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -54,43 +52,9 @@ interface, and powerful string processing.") (item "/gnu/store/...") (output "out"))) -(define-syntax-rule (with-environment-variable variable value body ...) - "Run BODY with VARIABLE set to VALUE." - (let ((orig (getenv variable))) - (dynamic-wind - (lambda () - (setenv variable value)) - (lambda () - body ...) - (lambda () - (if orig - (setenv variable orig) - (unsetenv variable)))))) - (test-begin "ui") -(test-equal "parse-command-line" - '((argument . "bar") (argument . "foo") - (cores . 10) ;takes precedence - (substitutes? . #f) (keep-failed? . #t) - (max-jobs . 77) (cores . 42)) - - (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77" - (parse-command-line '("--keep-failed" "--no-substitutes" - "--cores=10" "foo" "bar") - %standard-build-options - (list '())))) - -(test-equal "parse-command-line and --no options" - '((argument . "foo") - (substitutes? . #f)) ;takes precedence - - (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes" - (parse-command-line '("foo") - %standard-build-options - (list '((substitutes? . #t)))))) - (test-assert "fill-paragraph" (every (lambda (column) (every (lambda (width) @@ -282,7 +246,3 @@ Second line" 24)) (exit (= (test-runner-fail-count (test-runner-current)) 0)) - -;;; Local Variables: -;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) -;;; End: |