01/06: scripts: Factorize option parsing sans 'GUIX_BUILD_OPTIONS'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit a1ff7e1d8dfb86ae1817d4e0db4ddeebd2083e83
Author: Ludovic Courtès <address@hidden>
Date:   Fri Oct 27 13:28:00 2017 -0700

    scripts: Factorize option parsing sans 'GUIX_BUILD_OPTIONS'.
    
    * guix/scripts.scm (parse-command-line): Add #:build-options? parameter
    and honor it.
    * guix/scripts/challenge.scm (guix-challenge): Use 'parse-command-line'
    with #:build-options? #f instead of 'args-fold*'.
    * guix/scripts/gc.scm (guix-gc): Likewise.
    * guix/scripts/graph.scm (guix-graph): Likewise.
    * guix/scripts/hash.scm (guix-hash): Likewise.
    * guix/scripts/lint.scm (guix-lint): Likewise.
    * guix/scripts/refresh.scm (guix-refresh): Likewise.
    * guix/scripts/size.scm (guix-size): Likewise.
    * guix/scripts/weather.scm (guix-weather): Likewise.
---
 guix/scripts.scm           | 14 +++++++++-----
 guix/scripts/challenge.scm |  8 ++------
 guix/scripts/gc.scm        |  8 ++------
 guix/scripts/graph.scm     |  9 +++------
 guix/scripts/hash.scm      |  9 ++-------
 guix/scripts/lint.scm      |  8 ++------
 guix/scripts/refresh.scm   |  8 ++------
 guix/scripts/size.scm      |  8 ++------
 guix/scripts/weather.scm   |  9 +++------
 9 files changed, 27 insertions(+), 54 deletions(-)

diff --git a/guix/scripts.scm b/guix/scripts.scm
index 9ff7f25..4a7ae7b 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -67,11 +67,13 @@ reporting."
 
 (define* (parse-command-line args options seeds
                              #:key
+                             (build-options? #t)
                              (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'.
+  "Parse the command-line arguments ARGS according to OPTIONS (a list of
+SRFI-37 options) and return the result, seeded by SEEDS.  When BUILD-OPTIONS?
+is true, also pass arguments passed via the 'GUIX_BUILD_OPTIONS' environment
+variable.  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'."
@@ -85,7 +87,9 @@ parameter of 'args-fold'."
 
   (call-with-values
       (lambda ()
-        (parse-options-from (environment-build-options) seeds))
+        (if build-options?
+            (parse-options-from (environment-build-options) seeds)
+            (apply values seeds)))
     (lambda seeds
       ;; ARGS take precedence over what the environment variable specifies.
       (parse-options-from args seeds))))
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 5c59fbe..f0693ed 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -278,12 +278,8 @@ Challenge the substitutes for PACKAGE... provided by one 
or more servers.\n"))
 
 (define (guix-challenge . args)
   (with-error-handling
-    (let* ((opts     (args-fold* args %options
-                                 (lambda (opt name arg . rest)
-                                   (leave (G_ "~A: unrecognized option~%") 
name))
-                                 (lambda (arg result)
-                                   (alist-cons 'argument arg result))
-                                 %default-options))
+    (let* ((opts     (parse-command-line args %options (list %default-options)
+                                         #:build-options? #f))
            (files    (filter-map (match-lambda
                                    (('argument . file) file)
                                    (_ #f))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 0a9719d..378a47d 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -159,12 +159,8 @@ Invoke the garbage collector.\n"))
 (define (guix-gc . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (G_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (alist-cons 'argument arg result))
-                %default-options))
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
 
   (define (symlink-target file)
     (let ((s (false-if-exception (lstat file))))
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index d5be442..6b809d3 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -447,12 +447,9 @@ Emit a Graphviz (dot) representation of the dependencies 
of PACKAGE...\n"))
 
 (define (guix-graph . args)
   (with-error-handling
-    (let* ((opts     (args-fold* args %options
-                                 (lambda (opt name arg . rest)
-                                   (leave (G_ "~A: unrecognized option~%") 
name))
-                                 (lambda (arg result)
-                                   (alist-cons 'argument arg result))
-                                 %default-options))
+    (let* ((opts     (parse-command-line args %options
+                                         (list %default-options)
+                                         #:build-options? #f))
            (backend  (assoc-ref opts 'backend))
            (type     (assoc-ref opts 'node-type))
            (items    (filter-map (match-lambda
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index 1fa6bb8..cae5d6b 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -104,13 +104,8 @@ and 'hexadecimal' can be used as well).\n"))
 (define (guix-hash . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (G_ "unrecognized option: ~a~%")
-                         name))
-                (lambda (arg result)
-                  (alist-cons 'argument arg result))
-                %default-options))
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
 
   (define (vcs-file? file stat)
     (case (stat:type stat)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index a26f92f..0338d4c 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1123,12 +1123,8 @@ run the checkers on all packages.\n"))
 (define (guix-lint . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (G_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (alist-cons 'argument arg result))
-                %default-options))
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
 
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index d638d74..852b44b 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -338,12 +338,8 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
 (define (guix-refresh . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (G_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (alist-cons 'argument arg result))
-                %default-options))
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
 
   (define (options->updaters opts)
     ;; Return the list of updaters to use.
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index dee3604..b7b53e4 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -291,12 +291,8 @@ Report the size of PACKAGE and its dependencies.\n"))
 
 (define (guix-size . args)
   (with-error-handling
-    (let* ((opts     (args-fold* args %options
-                                 (lambda (opt name arg . rest)
-                                   (leave (G_ "~A: unrecognized option~%") 
name))
-                                 (lambda (arg result)
-                                   (alist-cons 'argument arg result))
-                                 %default-options))
+    (let* ((opts     (parse-command-line args %options (list %default-options)
+                                         #:build-options? #f))
            (files    (filter-map (match-lambda
                                    (('argument . file) file)
                                    (_ #f))
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 7f42f94..0d4a7fa 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -204,12 +204,9 @@ Report the availability of substitutes.\n"))
 
 (define (guix-weather . args)
   (with-error-handling
-    (let* ((opts     (args-fold* args %options
-                                 (lambda (opt name arg . rest)
-                                   (leave (G_ "~A: unrecognized option~%") 
name))
-                                 (lambda (arg result)
-                                   (alist-cons 'argument arg result))
-                                 %default-options))
+    (let* ((opts     (parse-command-line args %options
+                                         (list %default-options)
+                                         #:build-options? #f))
            (urls     (assoc-ref opts 'substitute-urls))
            (systems  (match (filter-map (match-lambda
                                           (('system . system) system)