unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 43159@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#43159] [PATCH 1/2] scripts: Use 'define-command' and have 'guix help' use that.
Date: Tue,  1 Sep 2020 22:41:35 +0200	[thread overview]
Message-ID: <20200901204136.21375-1-ludo@gnu.org> (raw)
In-Reply-To: <20200901203520.21103-1-ludo@gnu.org>

This changes 'guix help' to print a short synopsis for each command and
to group commands by category.

* guix/scripts.scm (synopsis, category): New variables.
(define-command): New macro.
* guix/ui.scm (<command>): New record type.
(source-file-command): New procedure.
(command-files): Return absolute file names.
(commands): Return a list of <command> records.
(show-guix-help)[display-commands, category-predicate]: New procedures.
Display commands grouped in three categories.
* guix/scripts/archive.scm (guix-archive): Use 'define-command'.
* guix/scripts/authenticate.scm (guix-authenticate): Likewise.
* guix/scripts/build.scm (guix-build): Likewise.
* guix/scripts/challenge.scm (guix-challenge): Likewise.
* guix/scripts/container.scm (guix-container): Likewise.
* guix/scripts/copy.scm (guix-copy): Likewise.
* guix/scripts/deploy.scm (guix-deploy): Likewise.
* guix/scripts/describe.scm (guix-describe): Likewise.
* guix/scripts/download.scm (guix-download): Likewise.
* guix/scripts/edit.scm (guix-edit): Likewise.
* guix/scripts/environment.scm (guix-environment): Likewise.
* guix/scripts/gc.scm (guix-gc): Likewise.
* guix/scripts/git.scm (guix-git): Likewise.
* guix/scripts/graph.scm (guix-graph): Likewise.
* guix/scripts/hash.scm (guix-hash): Likewise.
* guix/scripts/import.scm (guix-import): Likewise.
* guix/scripts/install.scm (guix-install): Likewise.
* guix/scripts/lint.scm (guix-lint): Likewise.
* guix/scripts/offload.scm (guix-offload): Likewise.
* guix/scripts/pack.scm (guix-pack): Likewise.
* guix/scripts/package.scm (guix-package): Likewise.
* guix/scripts/perform-download.scm (guix-perform-download): Likewise.
* guix/scripts/processes.scm (guix-processes): Likewise.
* guix/scripts/publish.scm (guix-publish): Likewise.
* guix/scripts/pull.scm (guix-pull): Likewise.
* guix/scripts/refresh.scm (guix-refresh): Likewise.
* guix/scripts/remove.scm (guix-remove): Likewise.
* guix/scripts/repl.scm (guix-repl): Likewise.
* guix/scripts/search.scm (guix-search): Likewise.
* guix/scripts/show.scm (guix-show): Likewise.
* guix/scripts/size.scm (guix-size): Likewise.
* guix/scripts/substitute.scm (guix-substitute): Likewise.
* guix/scripts/system.scm (guix-system): Likewise.
* guix/scripts/time-machine.scm (guix-time-machine): Likewise.
* guix/scripts/upgrade.scm (guix-upgrade): Likewise.
* guix/scripts/weather.scm (guix-weather): Likewise.
---
 guix/scripts.scm                  | 29 +++++++++++-
 guix/scripts/archive.scm          |  5 +-
 guix/scripts/authenticate.scm     |  8 +++-
 guix/scripts/build.scm            |  5 +-
 guix/scripts/challenge.scm        |  5 +-
 guix/scripts/container.scm        |  6 ++-
 guix/scripts/copy.scm             |  5 +-
 guix/scripts/deploy.scm           |  3 +-
 guix/scripts/describe.scm         |  3 +-
 guix/scripts/download.scm         |  5 +-
 guix/scripts/edit.scm             |  7 ++-
 guix/scripts/environment.scm      |  5 +-
 guix/scripts/gc.scm               |  4 +-
 guix/scripts/git.scm              |  6 ++-
 guix/scripts/graph.scm            |  5 +-
 guix/scripts/hash.scm             |  5 +-
 guix/scripts/import.scm           |  8 +++-
 guix/scripts/install.scm          |  6 ++-
 guix/scripts/lint.scm             |  5 +-
 guix/scripts/offload.scm          |  6 ++-
 guix/scripts/pack.scm             |  5 +-
 guix/scripts/package.scm          |  4 +-
 guix/scripts/perform-download.scm | 18 ++++----
 guix/scripts/processes.scm        |  4 +-
 guix/scripts/publish.scm          |  5 +-
 guix/scripts/pull.scm             |  4 +-
 guix/scripts/refresh.scm          |  7 ++-
 guix/scripts/remove.scm           |  6 ++-
 guix/scripts/repl.scm             |  5 +-
 guix/scripts/search.scm           |  6 ++-
 guix/scripts/show.scm             |  4 +-
 guix/scripts/size.scm             |  7 ++-
 guix/scripts/substitute.scm       |  7 ++-
 guix/scripts/system.scm           |  4 +-
 guix/scripts/time-machine.scm     |  4 +-
 guix/scripts/upgrade.scm          |  6 ++-
 guix/scripts/weather.scm          |  4 +-
 guix/ui.scm                       | 77 +++++++++++++++++++++++++++----
 38 files changed, 246 insertions(+), 62 deletions(-)

diff --git a/guix/scripts.scm b/guix/scripts.scm
index 8534948892..013b775818 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -34,7 +34,10 @@
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
-  #:export (args-fold*
+  #:export (synopsis
+            category
+            define-command
+            args-fold*
             parse-command-line
             maybe-build
             build-package
@@ -50,6 +53,30 @@
 ;;;
 ;;; Code:
 
+;; Syntactic keywords.
+(define synopsis 'command-synopsis)
+(define category 'command-category)
+
+(define-syntax define-command
+  (syntax-rules (category synopsis)
+    "Define the given command as a procedure along with its synopsis and,
+optionally, its category.  The synopsis becomes the docstring of the
+procedure, but both the category and synopsis are meant to be read (parsed) by
+'guix help'."
+    ;; The (synopsis ...) form is here so that xgettext sees those strings as
+    ;; translatable.
+    ((_ (name . args)
+        (synopsis doc) body ...)
+     (define (name . args)
+       doc
+       body ...))
+    ((_ (name . args)
+        (category _)
+        (synopsis doc) body ...)
+     (define (name . args)
+       doc
+       body ...))))
+
 (define (args-fold* args options unrecognized-option-proc operand-proc . seeds)
   "A wrapper on top of `args-fold' that does proper user-facing error
 reporting."
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index f3b86fba14..8796774a01 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -355,7 +355,10 @@ output port."
 ;;; Entry point.
 ;;;
 
-(define (guix-archive . args)
+(define-command (guix-archive . args)
+  (category advanced)
+  (synopsis "manipulate, export, and import normalized archives (nars)")
+
   (define (lines port)
     ;; Return lines read from PORT.
     (let loop ((line   (read-line port))
diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index f1fd8ee895..a4b9171fc7 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts authenticate)
   #:use-module (guix config)
+  #:use-module (guix scripts)
   #:use-module (guix base16)
   #:use-module (gcrypt pk-crypto)
   #:use-module (guix pki)
@@ -90,7 +91,10 @@ to stdout upon success."
 ;;; unmodified currently.
 ;;;
 
-(define (guix-authenticate . args)
+(define-command (guix-authenticate . args)
+  (category internal)
+  (synopsis "sign or verify signatures on normalized archives (nars)")
+
   ;; Signature sexps written to stdout may contain binary data, so force
   ;; ISO-8859-1 encoding so that things are not mangled.  See
   ;; <http://bugs.gnu.org/17312> for details.
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 6286a43c02..37b8d82fd5 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -945,7 +945,10 @@ needed."
 ;;; Entry point.
 ;;;
 
-(define (guix-build . args)
+(define-command (guix-build . args)
+  (category development)
+  (synopsis "build packages or derivations without installing them")
+
   (define opts
     (parse-command-line args %options
                         (list %default-options)))
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 624f51b200..6aab53152e 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -475,7 +475,10 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-challenge . args)
+(define-command (guix-challenge . args)
+  (category advanced)
+  (synopsis "challenge substitute servers, comparing their binaries")
+
   (with-error-handling
     (let* ((opts     (parse-command-line args %options (list %default-options)
                                          #:build-options? #f))
diff --git a/guix/scripts/container.scm b/guix/scripts/container.scm
index 8041d64b6b..2369437043 100644
--- a/guix/scripts/container.scm
+++ b/guix/scripts/container.scm
@@ -20,6 +20,7 @@
 (define-module (guix scripts container)
   #:use-module (ice-9 match)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:export (guix-container))
 
 (define (show-help)
@@ -46,7 +47,10 @@ Build and manipulate Linux containers.\n"))
         (proc (string->symbol (string-append "guix-container-" name))))
     (module-ref module proc)))
 
-(define (guix-container . args)
+(define-command (guix-container . args)
+  (category development)
+  (synopsis "run code in containers created by 'guix environment -C'")
+
   (with-error-handling
     (match args
       (()
diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index 274620fc1e..b2eccae7a6 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -170,7 +170,10 @@ Copy ITEMS to or from the specified host over SSH.\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-copy . args)
+(define-command (guix-copy . args)
+  (category advanced)
+  (synopsis "copy store items remotely over SSH")
+
   (with-error-handling
     (let* ((opts     (parse-command-line args %options (list %default-options)))
            (source   (assoc-ref opts 'source))
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 4a68197620..1b5be307be 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -136,7 +136,8 @@ Perform the deployment specified by FILE.\n"))
           (machine-display-name machine))))
 
 \f
-(define (guix-deploy . args)
+(define-command (guix-deploy . args)
+  (synopsis "deploy operating systems on a set of machines")
   (define (handle-argument arg result)
     (alist-cons 'file arg result))
 
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index bc868ffbbf..c3667516eb 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -304,7 +304,8 @@ text.  The hyperlink links to a web view of COMMIT, when available."
 ;;; Entry point.
 ;;;
 
-(define (guix-describe . args)
+(define-command (guix-describe . args)
+  (synopsis "describe the channel revisions currently used")
   (let* ((opts    (args-fold* args %options
                               (lambda (opt name arg result)
                                 (leave (G_ "~A: unrecognized option~%")
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 589f62da9d..7192aa14d0 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -156,7 +156,10 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-download . args)
+(define-command (guix-download . args)
+  (category advanced)
+  (synopsis "download a file to the store and print its hash")
+
   (define (parse-options)
     ;; Return the alist of option values.
     (args-fold* args %options
diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm
index 43f3011869..39bd4f8a6c 100644
--- a/guix/scripts/edit.scm
+++ b/guix/scripts/edit.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
@@ -78,7 +78,10 @@ line."
         (search-path* %load-path (location-file location))))
 
 \f
-(define (guix-edit . args)
+(define-command (guix-edit . args)
+  (category development)
+  (synopsis "view and edit package definitions")
+
   (define (parse-arguments)
     ;; Return the list of package names.
     (args-fold* args %options
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 1fb3505307..ad50281eb2 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -678,7 +678,10 @@ message if any test fails."
 ;;; Entry point.
 ;;;
 
-(define (guix-environment . args)
+(define-command (guix-environment . args)
+  (category development)
+  (synopsis "spawn one-off software environments")
+
   (with-error-handling
     (let* ((opts       (parse-args args))
            (pure?      (assoc-ref opts 'pure))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index ab7c13315f..043273f491 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -220,7 +220,9 @@ is deprecated; use '-D'~%"))
 ;;; Entry point.
 ;;;
 
-(define (guix-gc . args)
+(define-command (guix-gc . args)
+  (synopsis "invoke the garbage collector")
+
   (define (parse-options)
     ;; Return the alist of option values.
     (parse-command-line args %options (list %default-options)
diff --git a/guix/scripts/git.scm b/guix/scripts/git.scm
index bc829cbe99..58a496a1b2 100644
--- a/guix/scripts/git.scm
+++ b/guix/scripts/git.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts git)
   #:use-module (ice-9 match)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:export (guix-git))
 
 (define (show-help)
@@ -45,7 +46,10 @@ Operate on Git repositories.\n"))
         (proc (string->symbol (string-append "guix-git-" name))))
     (module-ref module proc)))
 
-(define (guix-git . args)
+(define-command (guix-git . args)
+  (category advanced)
+  (synopsis "operate on Git repositories")
+
   (with-error-handling
     (match args
       (()
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 73d9269de2..bfeda4f61b 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -565,7 +565,10 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-graph . args)
+(define-command (guix-graph . args)
+  (category advanced)
+  (synopsis "view and query package dependency graphs")
+
   (with-error-handling
     (define opts
       (parse-command-line args %options
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index 9b4f419a24..480814df20 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -116,7 +116,10 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-hash . args)
+(define-command (guix-hash . args)
+  (category advanced)
+  (synopsis "compute the cryptographic hash of a file")
+
   (define (parse-options)
     ;; Return the alist of option values.
     (parse-command-line args %options (list %default-options)
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index c6cc93fad8..6e972561fb 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
@@ -21,6 +21,7 @@
 
 (define-module (guix scripts import)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -98,7 +99,10 @@ Run IMPORTER with ARGS.\n"))
   (newline)
   (show-bug-report-information))
 
-(define (guix-import . args)
+(define-command (guix-import . args)
+  (category development)
+  (synopsis "import a package definition from an external repository")
+
   (match args
     (()
      (format (current-error-port)
diff --git a/guix/scripts/install.scm b/guix/scripts/install.scm
index d88e86e77a..894e60f9da 100644
--- a/guix/scripts/install.scm
+++ b/guix/scripts/install.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -66,7 +66,9 @@ This is an alias for 'guix package -i'.\n"))
                  %transformation-options
                  %standard-build-options)))
 
-(define (guix-install . args)
+(define-command (guix-install . args)
+  (synopsis "install packages")
+
   (define (handle-argument arg result arg-handler)
     ;; Treat all non-option arguments as package specs.
     (values (alist-cons 'install arg result)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 5168a1ca17..76bf18220a 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -157,7 +157,10 @@ run the checkers on all packages.\n"))
 ;;; Entry Point
 ;;;
 
-(define (guix-lint . args)
+(define-command (guix-lint . args)
+  (category advanced)
+  (synopsis "validate package definitions")
+
   (define (parse-options)
     ;; Return the alist of option values.
     (parse-command-line args %options (list %default-options)
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 1e0e9d7905..4afdb9396d 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -39,6 +39,7 @@
                 #:select (fcntl-flock set-thread-name))
   #:use-module ((guix build utils) #:select (which mkdir-p))
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix diagnostics)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -725,7 +726,10 @@ machine."
 ;;; Entry point.
 ;;;
 
-(define (guix-offload . args)
+(define-command (guix-offload . args)
+  (category advanced)
+  (synopsis "set up and operate build offloading")
+
   (define request-line-rx
     ;; The request format.  See 'tryBuildHook' method in build.cc.
     (make-regexp "([01]) ([a-z0-9_-]+) (/[[:graph:]]+.drv) ([[:graph:]]*)"))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 9d6881fdaf..379e6a3ac6 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1089,7 +1089,10 @@ Create a bundle of PACKAGE.\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-pack . args)
+(define-command (guix-pack . args)
+  (category development)
+  (synopsis "create application bundles")
+
   (define opts
     (parse-command-line args %options (list %default-options)))
 
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index ac8dedb5f3..4eb968a49b 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -941,7 +941,9 @@ processed, #f otherwise."
 ;;; Entry point.
 ;;;
 
-(define (guix-package . args)
+(define-command (guix-package . args)
+  (synopsis "manage packages and profiles")
+
   (define (handle-argument arg result arg-handler)
     ;; Process non-option argument ARG by calling back ARG-HANDLER.
     (if arg-handler
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index df787a9940..8d409092ba 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts perform-download)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix derivations)
   #:use-module ((guix store) #:select (derivation-path? store-path?))
   #:use-module (guix build download)
@@ -91,14 +92,15 @@ actual output is different from that when we're doing a 'bmCheck' or
     (leave (G_ "refusing to run with elevated privileges (UID ~a)~%")
            (getuid))))
 
-(define (guix-perform-download . args)
-  "Perform the download described by the given fixed-output derivation.
+(define-command (guix-perform-download . args)
+  (category internal)
+  (synopsis "perform download described by fixed-output derivations")
 
-This is an \"out-of-band\" download in that this code is executed directly by
-the daemon and not explicitly described as an input of the derivation.  This
-allows us to sidestep bootstrapping problems, such downloading the source code
-of GnuTLS over HTTPS, before we have built GnuTLS.  See
-<http://bugs.gnu.org/22774>."
+  ;; This is an "out-of-band" download in that this code is executed directly
+  ;; by the daemon and not explicitly described as an input of the derivation.
+  ;; This allows us to sidestep bootstrapping problems, such as downloading
+  ;; the source code of GnuTLS over HTTPS before we have built GnuTLS.  See
+  ;; <https://bugs.gnu.org/22774>.
 
   (define print-build-trace?
     (match (getenv "_NIX_OPTIONS")
diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index 35698a0216..272eae2f6f 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -223,7 +223,9 @@ List the current Guix sessions and their processes."))
 ;;; Entry point.
 ;;;
 
-(define (guix-processes . args)
+(define-command (guix-processes . args)
+  (category advanced)
+  (synopsis "list currently running sessions")
   (define options
     (args-fold* args %options
                 (lambda (opt name arg result)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 61542f83a0..872931840a 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -1013,7 +1013,10 @@ methods, return the applicable compression."
 ;;; Entry point.
 ;;;
 
-(define (guix-publish . args)
+(define-command (guix-publish . args)
+  (category advanced)
+  (synopsis "publish build results over HTTP")
+
   (with-error-handling
     (let* ((opts    (args-fold* args %options
                                 (lambda (opt name arg result)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 3b980b8f3f..bb1b560a22 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -751,7 +751,9 @@ Use '~/.config/guix/channels.scm' instead."))
         channels)))
 
 \f
-(define (guix-pull . args)
+(define-command (guix-pull . args)
+  (synopsis "pull the latest revision of Guix")
+
   (with-error-handling
     (with-git-error-handling
      (let* ((opts         (parse-command-line args %options
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index efada1df5a..eba996d6c6 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
@@ -496,7 +496,10 @@ all are dependent packages: ~{~a~^ ~}~%")
 ;;; Entry point.
 ;;;
 
-(define (guix-refresh . args)
+(define-command (guix-refresh . args)
+  (category development)
+  (synopsis "update existing package definitions")
+
   (define (parse-options)
     ;; Return the alist of option values.
     (parse-command-line args %options (list %default-options)
diff --git a/guix/scripts/remove.scm b/guix/scripts/remove.scm
index 2f06ea4f37..e05fb05f07 100644
--- a/guix/scripts/remove.scm
+++ b/guix/scripts/remove.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -63,7 +63,9 @@ This is an alias for 'guix package -r'.\n"))
 
                  %standard-build-options)))
 
-(define (guix-remove . args)
+(define-command (guix-remove . args)
+  (synopsis "removed installed packages")
+
   (define (handle-argument arg result arg-handler)
     ;; Treat all non-option arguments as package specs.
     (values (alist-cons 'remove arg result)
diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm
index 0ea9c3655c..202a3a197f 100644
--- a/guix/scripts/repl.scm
+++ b/guix/scripts/repl.scm
@@ -137,7 +137,10 @@ call THUNK."
              (loop)))))))
 
 \f
-(define (guix-repl . args)
+(define-command (guix-repl . args)
+  (category advanced)
+  (synopsis "read-eval-print loop (REPL) for interactive programming")
+
   (define opts
     (args-fold* args %options
                 (lambda (opt name arg result)
diff --git a/guix/scripts/search.scm b/guix/scripts/search.scm
index 827b2eb7a9..0c9e6af07b 100644
--- a/guix/scripts/search.scm
+++ b/guix/scripts/search.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,7 +57,9 @@ This is an alias for 'guix package -s'.\n"))
                 (member "load-path" (option-names option)))
               %standard-build-options)))
 
-(define (guix-search . args)
+(define-command (guix-search . args)
+  (synopsis "search for packages")
+
   (define (handle-argument arg result)
     ;; Treat all non-option arguments as regexps.
     (cons `(query search ,(or arg ""))
diff --git a/guix/scripts/show.scm b/guix/scripts/show.scm
index a2b0030a63..535d03c1a6 100644
--- a/guix/scripts/show.scm
+++ b/guix/scripts/show.scm
@@ -57,7 +57,9 @@ This is an alias for 'guix package --show='.\n"))
                 (member "load-path" (option-names option)))
               %standard-build-options)))
 
-(define (guix-show . args)
+(define-command (guix-show . args)
+  (synopsis "show information about packages")
+
   (define (handle-argument arg result)
     ;; Treat all non-option arguments as regexps.
     (cons `(query show ,arg)
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index c42f4f7782..2ed5d3cdd0 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -298,7 +298,10 @@ Report the size of the PACKAGE or STORE-ITEM, with its dependencies.\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-size . args)
+(define-command (guix-size . args)
+  (category advanced)
+  (synopsis "profile the on-disk size of packages")
+
   (with-error-handling
     (let* ((opts     (parse-command-line args %options (list %default-options)
                                          #:build-options? #f))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index f9d19fd735..1462ce9918 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -20,6 +20,7 @@
 
 (define-module (guix scripts substitute)
   #:use-module (guix ui)
+  #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix combinators)
@@ -1095,8 +1096,10 @@ default value."
   (unless (string->uri uri)
     (leave (G_ "~a: invalid URI~%") uri)))
 
-(define (guix-substitute . args)
-  "Implement the build daemon's substituter protocol."
+(define-command (guix-substitute . args)
+  (category internal)
+  (synopsis "implement the build daemon's substituter protocol")
+
   (define print-build-trace?
     (match (or (find-daemon-option "untrusted-print-extended-build-trace")
                (find-daemon-option "print-extended-build-trace"))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3222a53c8f..2a514166eb 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1240,7 +1240,9 @@ argument list and OPTS is the option alist."
     ;; need an operating system configuration file.
     (else (process-action command args opts))))
 
-(define (guix-system . args)
+(define-command (guix-system . args)
+  (synopsis "build and deploy full operating systems")
+
   (define (parse-sub-command arg result)
     ;; Parse sub-command ARG and augment RESULT accordingly.
     (if (assoc-ref result 'action)
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 441673b780..0d27414702 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -128,7 +128,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
 ;;; Entry point.
 ;;;
 
-(define (guix-time-machine . args)
+(define-command (guix-time-machine . args)
+  (synopsis "run commands from a different revision")
+
   (with-error-handling
     (with-git-error-handling
      (let* ((opts         (parse-args args))
diff --git a/guix/scripts/upgrade.scm b/guix/scripts/upgrade.scm
index d2784669be..8c7abd133a 100644
--- a/guix/scripts/upgrade.scm
+++ b/guix/scripts/upgrade.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -67,7 +67,9 @@ This is an alias for 'guix package -u'.\n"))
                  %transformation-options
                  %standard-build-options)))
 
-(define (guix-upgrade . args)
+(define-command (guix-upgrade . args)
+  (synopsis "upgrade packages to their latest version")
+
   (define (handle-argument arg result arg-handler)
     ;; Accept at most one non-option argument, and treat it as an upgrade
     ;; regexp.
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 3035ff6ca8..48207d4205 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -495,7 +495,9 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
 ;;; Entry point.
 ;;;
 
-(define (guix-weather . args)
+(define-command (guix-weather . args)
+  (synopsis "report on the available of pre-built package binaries")
+
   (define (package-list opts)
     ;; Return the package list specified by OPTS.
     (let ((files (filter-map (match-lambda
diff --git a/guix/ui.scm b/guix/ui.scm
index efc3f39186..4d90a47bb9 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -60,6 +60,7 @@
                         ;; Avoid "overrides core binding" warning.
                         delete))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
@@ -1988,6 +1989,44 @@ optionally contain a version number and an output name, as in these examples:
           (G_ "Try `guix --help' for more information.~%"))
   (exit 1))
 
+;; Representation of a 'guix' command.
+(define-immutable-record-type <command>
+  (command name synopsis category)
+  command?
+  (name     command-name)
+  (synopsis command-synopsis)
+  (category command-category))
+
+(define (source-file-command file)
+  "Read FILE, a Scheme source file, and return either a <command> object based
+on the 'define-command' top-level form found therein, or #f if FILE does not
+contain a 'define-command' form."
+  (define command-name
+    (match (string-split file #\/)
+      ((_ ... "guix" "scripts" name)
+       (list (file-sans-extension name)))
+      ((_ ... "guix" "scripts" first second)
+       (list first (file-sans-extension second)))))
+
+  ;; The strategy here is to parse FILE.  This is much cheaper than a
+  ;; technique based on run-time introspection where we'd load FILE and all
+  ;; the modules it depends on.
+  (call-with-input-file file
+    (lambda (port)
+      (let loop ()
+        (match (read port)
+          (('define-command _ ('synopsis synopsis)
+             _ ...)
+           (command command-name synopsis 'main))
+          (('define-command _
+             ('category category) ('synopsis synopsis)
+             _ ...)
+           (command command-name synopsis category))
+          ((? eof-object?)
+           #f)
+          (_
+           (loop)))))))
+
 (define (command-files)
   "Return the list of source files that define Guix sub-commands."
   (define directory
@@ -1999,28 +2038,50 @@ optionally contain a version number and an output name, as in these examples:
     (cut string-suffix? ".scm" <>))
 
   (if directory
-      (scandir directory dot-scm?)
+      (map (cut string-append directory "/" <>)
+           (scandir directory dot-scm?))
       '()))
 
 (define (commands)
-  "Return the list of Guix command names."
-  (map (compose (cut string-drop-right <> 4)
-                basename)
-       (command-files)))
+  "Return the list of commands, alphabetically sorted."
+  (filter-map source-file-command (command-files)))
 
 (define (show-guix-help)
   (define (internal? command)
     (member command '("substitute" "authenticate" "offload"
                       "perform-download")))
 
+  (define (display-commands commands)
+    (let* ((names     (map (lambda (command)
+                             (string-join (command-name command)))
+                           commands))
+           (max-width (reduce max 0 (map string-length names))))
+      (for-each (lambda (name command)
+                  (format #t "    ~a  ~a~%"
+                          (string-pad-right name max-width)
+                          (G_ (command-synopsis command))))
+                names
+                commands)))
+
+  (define (category-predicate category)
+    (lambda (command)
+      (eq? category (command-category command))))
+
   (format #t (G_ "Usage: guix COMMAND ARGS...
 Run COMMAND with ARGS.\n"))
   (newline)
   (format #t (G_ "COMMAND must be one of the sub-commands listed below:\n"))
   (newline)
-  ;; TODO: Display a synopsis of each command.
-  (format #t "~{   ~a~%~}" (sort (remove internal? (commands))
-                                 string<?))
+  (let ((commands (commands)))
+    ;; Note: commands in other categories, such as "internal", are not shown.
+    (format #t (G_ "  main commands:~%"))
+    (display-commands (filter (category-predicate 'main) commands))
+    (newline)
+    (format #t (G_ "  commands for developers:~%"))
+    (display-commands (filter (category-predicate 'development) commands))
+    (newline)
+    (format #t (G_ "  advanced usage:~%"))
+    (display-commands (filter (category-predicate 'advanced) commands)))
   (show-bug-report-information))
 
 (define (run-guix-command command . args)
-- 
2.28.0





  reply	other threads:[~2020-09-01 20:42 UTC|newest]

Thread overview: 17+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-09-01 20:35 [bug#43159] [PATCH 0/2] Make 'guix help' helpful Ludovic Courtès
2020-09-01 20:41 ` Ludovic Courtès [this message]
2020-09-01 20:41   ` [bug#43159] [PATCH 2/2] ui: '--help' output links to <https://guix.gnu.org/help/> Ludovic Courtès
2020-09-02 18:27     ` Maxim Cournoyer
2020-09-02 18:24   ` [bug#43159] [PATCH 1/2] scripts: Use 'define-command' and have 'guix help' use that Maxim Cournoyer
2020-09-03 13:41     ` Ludovic Courtès
2020-09-11 18:58       ` Maxim Cournoyer
2020-09-13 13:03         ` Ludovic Courtès
2020-09-13 23:33           ` Maxim Cournoyer
2020-09-07 12:56     ` [bug#43159] [PATCHES v2] " Ludovic Courtès
2020-09-10 10:34       ` bug#43159: " Ludovic Courtès
2020-09-10 10:55         ` [bug#43159] " Ricardo Wurmus
2020-09-02  8:06 ` [bug#43159] [PATCH 0/2] Make 'guix help' helpful Efraim Flashner
2020-09-02  9:50   ` Ludovic Courtès
2020-09-02 11:09     ` Efraim Flashner
2020-09-03 16:40 ` zimoun
2020-09-07 12:58   ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20200901204136.21375-1-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=43159@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).