guix build: Factorize common options.

* guix/scripts/build.scm (show-build-options-help,
  set-build-options-from-command-line): New procedures.
  (show-help): Remove description of --dry-run,
  --fallback, --no-substitutes, --max-silent-time, and --cores.  Call
  'show-build-options-help'.
  (%standard-build-options): New variable.
  (%options): Remove --dry-run, --fallback, --no-substitutes,
  --verbosity, --max-silent-time, and --cores.  Add
  %STANDARD-BUILD-OPTIONS.
  (guix-build): Use 'set-build-options-from-command-line' instead of
  'set-build-options'.
* guix/scripts/archive.scm (show-help): Remove description of --dry-run,
  --fallback, --no-substitutes, --max-silent-time, and --cores.  Call
  'show-build-options-help'.
  (%options): Remove --dry-run, --fallback, --no-substitutes,
  --verbosity, --max-silent-time, and --cores.  Add
  %STANDARD-BUILD-OPTIONS.
  (export-from-store): Call 'set-build-options-from-command-line'
  instead of 'set-build-options.

guix/scripts/archive.scm

@@ -71,17 +71,10 @@ Export/import one or more packages from/to the store.\n"))
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
-  (display (_ "
+
-  -n, --dry-run          do not build the derivations"))
+  (newline)
-  (display (_ "
+  (show-build-options-help)
-      --fallback         fall back to building when the substituter fails"))
+
-  (display (_ "
-      --no-substitutes   build instead of resorting to pre-built substitutes"))
-  (display (_ "
-      --max-silent-time=SECONDS
-                         mark the build as failed after SECONDS of silence"))
-  (display (_ "
-  -c, --cores=N          allow the use of up to N CPU cores for the build"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -92,7 +85,7 @@ Export/import one or more packages from/to the store.\n"))
 
 (define %options
   ;; Specifications of the command-line options.
-  (list (option '(#\h "help") #f #f
+  (cons* (option '(#\h "help") #f #f
                  (lambda args
                    (show-help)
                    (exit 0)))
@@ -138,35 +131,14 @@ Export/import one or more packages from/to the store.\n"))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
-        (option '(#\c "cores") #t #f
-                (lambda (opt name arg result)
-                  (let ((c (false-if-exception (string->number arg))))
-                    (if c
-                        (alist-cons 'cores c result)
-                        (leave (_ "~a: not a number~%") arg)))))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
-        (option '("fallback") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'fallback? #t
-                              (alist-delete 'fallback? result))))
-        (option '("no-substitutes") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'substitutes? #f
-                              (alist-delete 'substitutes? result))))
-        (option '("max-silent-time") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'max-silent-time (string->number* arg)
-                              result)))
          (option '(#\r "root") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'gc-root arg result)))
-        (option '("verbosity") #t #f
+
-                (lambda (opt name arg result)
+         %standard-build-options))
-                  (let ((level (string->number arg)))
-                    (alist-cons 'verbosity level
-                                (alist-delete 'verbosity result)))))))
 
 (define (options->derivations+files store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
@@ -219,16 +191,11 @@ build and a list of store files to transfer."
 resulting archive to the standard output port."
   (let-values (((drv files)
                 (options->derivations+files store opts)))
+    (set-build-options-from-command-line store opts)
     (show-what-to-build store drv
                         #:use-substitutes? (assoc-ref opts 'substitutes?)
                         #:dry-run? (assoc-ref opts 'dry-run?))
 
-    (set-build-options store
-                       #:build-cores (or (assoc-ref opts 'cores) 0)
-                       #:fallback? (assoc-ref opts 'fallback?)
-                       #:use-substitutes? (assoc-ref opts 'substitutes?)
-                       #:max-silent-time (assoc-ref opts 'max-silent-time))
-
     (if (or (assoc-ref opts 'dry-run?)
             (build-derivations store drv))
         (export-paths store files (current-output-port))

guix/scripts/build.scm

@@ -34,6 +34,11 @@
   #:use-module (srfi srfi-37)
   #:autoload   (gnu packages) (find-best-packages-by-name)
   #:export (derivation-from-expression
+
+            %standard-build-options
+            set-build-options-from-command-line
+            show-build-options-help
+
             guix-build))
 
 (define (derivation-from-expression store str package-derivation
@@ -99,6 +104,79 @@ present, return the preferred newest version."
         (leave (_ "failed to create GC root `~a': ~a~%")
                root (strerror (system-error-errno args)))))))
 
+
+;;;
+;;; Standard command-line build options.
+;;;
+
+(define (show-build-options-help)
+  "Display on the current output port help about the standard command-line
+options handled by 'set-build-options-from-command-line', and listed in
+'%standard-build-options'."
+  (display (_ "
+  -K, --keep-failed      keep build tree of failed builds"))
+  (display (_ "
+  -n, --dry-run          do not build the derivations"))
+  (display (_ "
+      --fallback         fall back to building when the substituter fails"))
+  (display (_ "
+      --no-substitutes   build instead of resorting to pre-built substitutes"))
+  (display (_ "
+      --no-build-hook    do not attempt to offload builds via the build hook"))
+  (display (_ "
+      --max-silent-time=SECONDS
+                         mark the build as failed after SECONDS of silence"))
+  (display (_ "
+      --verbosity=LEVEL  use the given verbosity LEVEL"))
+  (display (_ "
+  -c, --cores=N          allow the use of up to N CPU cores for the build")))
+
+(define (set-build-options-from-command-line store opts)
+  "Given OPTS, an alist as returned by 'args-fold' given
+'%standard-build-options', set the corresponding build options on STORE."
+  ;; TODO: Add more options.
+  (set-build-options store
+                     #:keep-failed? (assoc-ref opts 'keep-failed?)
+                     #:build-cores (or (assoc-ref opts 'cores) 0)
+                     #:fallback? (assoc-ref opts 'fallback?)
+                     #:use-substitutes? (assoc-ref opts 'substitutes?)
+                     #:use-build-hook? (assoc-ref opts 'build-hook?)
+                     #:max-silent-time (assoc-ref opts 'max-silent-time)
+                     #:verbosity (assoc-ref opts 'verbosity)))
+
+(define %standard-build-options
+  ;; List of standard command-line options for tools that build something.
+  (list (option '(#\K "keep-failed") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'keep-failed? #t result)))
+        (option '("fallback") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'fallback? #t
+                              (alist-delete 'fallback? result))))
+        (option '("no-substitutes") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'substitutes? #f
+                              (alist-delete 'substitutes? result))))
+        (option '("no-build-hook") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'build-hook? #f
+                              (alist-delete 'build-hook? result))))
+        (option '("max-silent-time") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'max-silent-time (string->number* arg)
+                              result)))
+        (option '("verbosity") #t #f
+                (lambda (opt name arg result)
+                  (let ((level (string->number arg)))
+                    (alist-cons 'verbosity level
+                                (alist-delete 'verbosity result)))))
+        (option '(#\c "cores") #t #f
+                (lambda (opt name arg result)
+                  (let ((c (false-if-exception (string->number arg))))
+                    (if c
+                        (alist-cons 'cores c result)
+                        (leave (_ "~a: not a number~%") arg)))))))
+
 
 ;;;
 ;;; Command-line options.
@@ -126,28 +204,13 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
   -d, --derivations      return the derivation paths of the given packages"))
   (display (_ "
-  -K, --keep-failed      keep build tree of failed builds"))
-  (display (_ "
-  -n, --dry-run          do not build the derivations"))
-  (display (_ "
-      --fallback         fall back to building when the substituter fails"))
-  (display (_ "
-      --no-substitutes   build instead of resorting to pre-built substitutes"))
-  (display (_ "
-      --no-build-hook    do not attempt to offload builds via the build hook"))
-  (display (_ "
-      --max-silent-time=SECONDS
-                         mark the build as failed after SECONDS of silence"))
-  (display (_ "
-  -c, --cores=N          allow the use of up to N CPU cores for the build"))
-  (display (_ "
   -r, --root=FILE        make FILE a symlink to the result, and register it
                          as a garbage collector root"))
-  (display (_ "
-      --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (_ "
       --log-file         return the log file names for the given derivations"))
   (newline)
+  (show-build-options-help)
+  (newline)
   (display (_ "
   -h, --help             display this help and exit"))
   (display (_ "
@@ -157,7 +220,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
 
 (define %options
   ;; Specifications of the command-line options.
-  (list (option '(#\h "help") #f #f
+  (cons* (option '(#\h "help") #f #f
                  (lambda args
                    (show-help)
                    (exit 0)))
@@ -182,45 +245,17 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
-        (option '(#\K "keep-failed") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'keep-failed? #t result)))
-        (option '(#\c "cores") #t #f
-                (lambda (opt name arg result)
-                  (let ((c (false-if-exception (string->number arg))))
-                    (if c
-                        (alist-cons 'cores c result)
-                        (leave (_ "~a: not a number~%") arg)))))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
-        (option '("fallback") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'fallback? #t
-                              (alist-delete 'fallback? result))))
-        (option '("no-substitutes") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'substitutes? #f
-                              (alist-delete 'substitutes? result))))
-        (option '("no-build-hook") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'build-hook? #f
-                              (alist-delete 'build-hook? result))))
-        (option '("max-silent-time") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'max-silent-time (string->number* arg)
-                              result)))
          (option '(#\r "root") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'gc-root arg result)))
-        (option '("verbosity") #t #f
-                (lambda (opt name arg result)
-                  (let ((level (string->number arg)))
-                    (alist-cons 'verbosity level
-                                (alist-delete 'verbosity result)))))
          (option '("log-file") #f #f
                  (lambda (opt name arg result)
-                  (alist-cons 'log-file? #t result)))))
+                   (alist-cons 'log-file? #t result)))
+
+         %standard-build-options))
 
 (define (options->derivations store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
@@ -279,16 +314,7 @@ build."
                                  (_ #f))
                                 opts)))
 
-        ;; TODO: Add more options.
+        (set-build-options-from-command-line store opts)
-        (set-build-options store
-                           #:keep-failed? (assoc-ref opts 'keep-failed?)
-                           #:build-cores (or (assoc-ref opts 'cores) 0)
-                           #:fallback? (assoc-ref opts 'fallback?)
-                           #:use-substitutes? (assoc-ref opts 'substitutes?)
-                           #:use-build-hook? (assoc-ref opts 'build-hook?)
-                           #:max-silent-time (assoc-ref opts 'max-silent-time)
-                           #:verbosity (assoc-ref opts 'verbosity))
-
         (unless (assoc-ref opts 'log-file?)
           (show-what-to-build store drv
                               #:use-substitutes? (assoc-ref opts 'substitutes?)