[bug#36404] [PATCH 5/6] Add 'guix deploy'.

[zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze)]

2019-06-26  Jakob L. Kreuze  <zerodaysfordays@sdf.lonestar.org>

* guix/scripts/deploy.scm: Add on-line help and limit verbosity.
---
 guix/scripts/deploy.scm | 52 ++++++++++++++++++++++++++---------------
 1 file changed, 33 insertions(+), 19 deletions(-)

diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 0be279642b..c52434f518 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 David Thompson <davet@gnu.org>
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,17 +19,35 @@
 
 (define-module (guix scripts deploy)
   #:use-module (gnu machine)
-  #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix store)
+  #:use-module (guix ui)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-37)
   #:export (guix-deploy))
 
+;;; Commentary:
+;;;
+;;; This program provides a command-line interface to (gnu machine), allowing
+;;; users to perform remote deployments through specification files.
+;;;
+;;; Code:
+
+\f
+
 (define (show-help)
-  (display (G_ "Usage: guix deploy WHATEVER\n")))
+  (display (G_ "Usage: guix deploy [OPTION] FILE...
+Perform the deployment specified by FILE.\n"))
+  (show-build-options-help)
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
 
 (define %options
   (cons* (option '(#\h "help") #f #f
@@ -42,13 +61,11 @@
     (substitutes? . #t)
     (build-hook? . #t)
     (graft? . #t)
-    (print-build-trace? . #t)
-    (print-extended-build-trace? . #t)
-    (multiplexed-build-output? . #t)
     (debug . 0)
     (verbosity . 2)))
 
 (define (load-source-file file)
+  "Load FILE as a user module."
   (let ((module (make-user-module '())))
     (load* file module)))
 
@@ -58,19 +75,16 @@
   (let* ((opts (parse-command-line args %options (list %default-options)
                                    #:argument-handler handle-argument))
          (file (assq-ref opts 'file))
-         (machines (load-source-file file)))
+         (machines (or (and file (load-source-file file)) '())))
     (with-store store
       (set-build-options-from-command-line store opts)
-      ;; Build all the OSes and create a mapping from machine to OS derivation
-      ;; for use in the deploy step.
-      (let ((osdrvs (map (lambda (machine)
-                           (format #t "building ~a... " (machine-display-name machine))
-                           (let ((osdrv (run-with-store store (build-machine machine))))
-                             (display "done\n")
-                             (cons machine osdrv)))
-                         machines)))
-        (for-each (lambda (machine)
-                    (format #t "deploying to ~a... " (machine-display-name machine))
-                    (run-with-store store (deploy-machine machine))
-                    (display "done\n"))
-                  machines)))))
+      (for-each (lambda (machine)
+                  (format #t "building ~a... " (machine-display-name machine))
+                  (run-with-store store (build-machine machine))
+                  (display "done\n"))
+                machines)
+      (for-each (lambda (machine)
+                  (format #t "deploying to ~a... " (machine-display-name machine))
+                  (run-with-store store (deploy-machine machine))
+                  (display "done\n"))
+                machines))))
-- 
2.22.0