From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id CC/AHGMuVl9yIgAA0tVLHw (envelope-from ) for ; Mon, 07 Sep 2020 12:58:11 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id 4LWSGGMuVl9VEgAAbx9fmQ (envelope-from ) for ; Mon, 07 Sep 2020 12:58:11 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id BDD9594013C for ; Mon, 7 Sep 2020 12:58:10 +0000 (UTC) Received: from localhost ([::1]:52752 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kFGin-0001UJ-Pg for larch@yhetil.org; Mon, 07 Sep 2020 08:58:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:56242) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kFGig-0001U5-Dd for guix-patches@gnu.org; Mon, 07 Sep 2020 08:58:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36835) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kFGig-0004oC-4I for guix-patches@gnu.org; Mon, 07 Sep 2020 08:58:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kFGig-0007ZG-1s for guix-patches@gnu.org; Mon, 07 Sep 2020 08:58:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#43159] [PATCHES v2] scripts: Use 'define-command' and have 'guix help' use that. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 07 Sep 2020 12:58:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 43159 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Maxim Cournoyer , Efraim Flashner , zimoun Cc: 43159@debbugs.gnu.org Received: via spool by 43159-submit@debbugs.gnu.org id=B43159.159948343629038 (code B ref 43159); Mon, 07 Sep 2020 12:58:01 +0000 Received: (at 43159) by debbugs.gnu.org; 7 Sep 2020 12:57:16 +0000 Received: from localhost ([127.0.0.1]:48381 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kFGhl-0007Y7-LH for submit@debbugs.gnu.org; Mon, 07 Sep 2020 08:57:16 -0400 Received: from eggs.gnu.org ([209.51.188.92]:45712) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kFGhh-0007XV-L9 for 43159@debbugs.gnu.org; Mon, 07 Sep 2020 08:57:05 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:41842) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kFGhc-0004hQ-9G; Mon, 07 Sep 2020 08:56:56 -0400 Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=44066 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kFGha-0008A2-I4; Mon, 07 Sep 2020 08:56:55 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= References: <20200901203520.21103-1-ludo@gnu.org> <20200901204136.21375-1-ludo@gnu.org> <87r1rk595p.fsf@gmail.com> Date: Mon, 07 Sep 2020 14:56:47 +0200 In-Reply-To: <87r1rk595p.fsf@gmail.com> (Maxim Cournoyer's message of "Wed, 02 Sep 2020 14:24:34 -0400") Message-ID: <87tuw9iw34.fsf_-_@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -1.0 (-) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: 0.49 X-TUID: rq/Mf66eQvAT --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi all! Here=E2=80=99s a v2 of the patches, where I tried to take your feedback into account. Changes: =E2=80=A2 Categories that appear in uses of =E2=80=98define-command=E2=80= =99 are now validated at macro-expansion time. =E2=80=A2 (guix scripts) contains an alist of the known categories and =E2=80=98show-help=E2=80=99 traverses it. =E2=80=A2 Changed the label for development commands to =E2=80=9Ccommands= for development=E2=80=9D, and changed =E2=80=9Cadvanced=E2=80=9D to =E2=80= =9Cplumbing=E2=80=9D. =E2=80=A2 Added a =E2=80=9Cpackaging=E2=80=9D category. =E2=80=A2 Fixed the typos you reported. The end result is: --8<---------------cut here---------------start------------->8--- Usage: guix COMMAND ARGS... Run COMMAND with ARGS. COMMAND must be one of the sub-commands listed below: main commands deploy deploy operating systems on a set of machines describe describe the channel revisions currently used gc invoke the garbage collector install install packages package manage packages and profiles pull pull the latest revision of Guix remove remove installed packages search search for packages show show information about packages system build and deploy full operating systems time-machine run commands from a different revision upgrade upgrade packages to their latest version weather report on the availability of pre-built package binaries software development commands container run code in containers created by 'guix environment -C' environment spawn one-off software environments pack create application bundles packaging commands build build packages or derivations without installing them challenge challenge substitute servers, comparing their binaries download download a file to the store and print its hash edit view and edit package definitions graph view and query package dependency graphs hash compute the cryptographic hash of a file import import a package definition from an external repository lint validate package definitions publish publish build results over HTTP refresh update existing package definitions size profile the on-disk size of packages plumbing commands archive manipulate, export, and import normalized archives (nars) copy copy store items remotely over SSH git operate on Git repositories offload set up and operate build offloading processes list currently running sessions repl read-eval-print loop (REPL) for interactive programming Report bugs to: bug-guix@gnu.org. GNU Guix home page: General help using Guix and GNU software: --8<---------------cut here---------------end--------------->8--- Let me know what you think! Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0002-scripts-Use-define-command-and-have-guix-help-use-th.patch Content-Transfer-Encoding: quoted-printable >From 63c3ab624d6bee53a0221c35a0e280dd0673d64c Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Ludovic=3D20Court=3DC3=3DA8s?=3D Date: Tue, 1 Sep 2020 22:13:11 +0200 Subject: [PATCH 2/2] scripts: Use 'define-command' and have 'guix help' use that. 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-categories, define-command): New macros. (%command-categories): New variable. * guix/ui.scm (): New record type. (source-file-command): New procedure. (command-files): Return absolute file names. (commands): Return a list of 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 | 62 +++++++++++++++++++++++- 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 | 80 +++++++++++++++++++++++++++---- 38 files changed, 281 insertions(+), 63 deletions(-) diff --git a/guix/scripts.scm b/guix/scripts.scm index 8534948892..9792aaebe9 100644 --- a/guix/scripts.scm +++ b/guix/scripts.scm @@ -34,7 +34,12 @@ #:use-module (srfi srfi-19) #:use-module (srfi srfi-37) #:use-module (ice-9 match) - #:export (args-fold* + #:export (synopsis + category + define-command + %command-categories + + args-fold* parse-command-line maybe-build build-package @@ -50,6 +55,61 @@ ;;; ;;; Code: =20 +;; Syntactic keywords. +(define synopsis 'command-synopsis) +(define category 'command-category) + +(define-syntax define-command-categories + (syntax-rules (G_) + "Define command categories." + ((_ name assert-valid (identifiers (G_ synopses)) ...) + (begin + (define-public identifiers + ;; Define and export syntactic keywords. + (list 'syntactic-keyword-for-command-category)) + ... + + (define-syntax assert-valid + ;; Validate at expansion time that we're passed a valid category. + (syntax-rules (identifiers ...) + ((_ identifiers) #t) + ...)) + + (define name + ;; Alist mapping category name to synopsis. + `((identifiers . synopses) ...)))))) + +;; Command categories. +(define-command-categories %command-categories + assert-valid-command-category + (main (G_ "main commands")) + (development (G_ "software development commands")) + (packaging (G_ "packaging commands")) + (plumbing (G_ "plumbing commands")) + (internal (G_ "internal commands"))) + +(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 cat) (synopsis doc) + body ...) + (begin + (assert-valid-command-category cat) + (define (name . args) + doc + body ...))))) + (define (args-fold* args options unrecognized-option-proc operand-proc . s= eeds) "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..02557ce454 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -355,7 +355,10 @@ output port." ;;; Entry point. ;;; =20 -(define (guix-archive . args) +(define-command (guix-archive . args) + (category plumbing) + (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 =C2=A9 2013, 2014, 2015, 2016, 2017 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017, 2020 Ludovic Court=C3= =A8s ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,7 @@ =20 (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. ;;; =20 -(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 ;; for details. diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 6286a43c02..25418661b9 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -945,7 +945,10 @@ needed." ;;; Entry point. ;;; =20 -(define (guix-build . args) +(define-command (guix-build . args) + (category packaging) + (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..39bd2c1c0f 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -475,7 +475,10 @@ Challenge the substitutes for PACKAGE... provided by o= ne or more servers.\n")) ;;; Entry point. ;;; =20 -(define (guix-challenge . args) +(define-command (guix-challenge . args) + (category packaging) + (synopsis "challenge substitute servers, comparing their binaries") + (with-error-handling (let* ((opts (parse-command-line args %options (list %default-opti= ons) #: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)) =20 (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))) =20 -(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..2780d4fbe9 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. ;;; =20 -(define (guix-copy . args) +(define-command (guix-copy . args) + (category plumbing) + (synopsis "copy store items remotely over SSH") + (with-error-handling (let* ((opts (parse-command-line args %options (list %default-opti= ons))) (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)))) =20 -(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)) =20 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, whe= n available." ;;; Entry point. ;;; =20 -(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..ce8dd8b02c 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -156,7 +156,10 @@ and 'base16' ('hex' and 'hexadecimal' can be used as w= ell).\n")) ;;; Entry point. ;;; =20 -(define (guix-download . args) +(define-command (guix-download . args) + (category packaging) + (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..49c9d945b6 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2015, 2016, 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2015, 2016, 2019, 2020 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2015 Mathieu Lirzin ;;; Copyright =C2=A9 2020 Simon Tournier ;;; @@ -78,7 +78,10 @@ line." (search-path* %load-path (location-file location)))) =20 -(define (guix-edit . args) +(define-command (guix-edit . args) + (category packaging) + (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. ;;; =20 -(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. ;;; =20 -(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..4436d8a6e0 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)) =20 (define (show-help) @@ -45,7 +46,10 @@ Operate on Git repositories.\n")) (proc (string->symbol (string-append "guix-git-" name)))) (module-ref module proc))) =20 -(define (guix-git . args) +(define-command (guix-git . args) + (category plumbing) + (synopsis "operate on Git repositories") + (with-error-handling (match args (() diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 73d9269de2..d7a08a4fe1 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -565,7 +565,10 @@ Emit a representation of the dependency graph of PACKA= GE...\n")) ;;; Entry point. ;;; =20 -(define (guix-graph . args) +(define-command (guix-graph . args) + (category packaging) + (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..797b99f053 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -116,7 +116,10 @@ and 'base16' ('hex' and 'hexadecimal' can be used as w= ell).\n")) ;;; Entry point. ;;; =20 -(define (guix-hash . args) +(define-command (guix-hash . args) + (category packaging) + (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..0a3863f965 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2012, 2013, 2014 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2012, 2013, 2014, 2020 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2014 David Thompson ;;; Copyright =C2=A9 2018 Kyle Meyer ;;; Copyright =C2=A9 2019 Ricardo Wurmus @@ -21,6 +21,7 @@ =20 (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)) =20 -(define (guix-import . args) +(define-command (guix-import . args) + (category packaging) + (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 =C2=A9 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2019, 2020 Ludovic Court=C3=A8s ;;; ;;; 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))) =20 -(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..979d4f8363 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -157,7 +157,10 @@ run the checkers on all packages.\n")) ;;; Entry Point ;;; =20 -(define (guix-lint . args) +(define-command (guix-lint . args) + (category packaging) + (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..3dc8ccefcb 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. ;;; =20 -(define (guix-offload . args) +(define-command (guix-offload . args) + (category plumbing) + (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. ;;; =20 -(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))) =20 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. ;;; =20 -(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-downl= oad.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 =C2=A9 2016, 2017, 2018 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2016, 2017, 2018, 2020 Ludovic Court=C3=A8s ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,7 @@ =20 (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)))) =20 -(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") =20 -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. Th= is -allows us to sidestep bootstrapping problems, such downloading the source = code -of GnuTLS over HTTPS, before we have built GnuTLS. See -." + ;; This is an "out-of-band" download in that this code is executed direc= tly + ;; by the daemon and not explicitly described as an input of the derivat= ion. + ;; This allows us to sidestep bootstrapping problems, such as downloading + ;; the source code of GnuTLS over HTTPS before we have built GnuTLS. See + ;; . =20 (define print-build-trace? (match (getenv "_NIX_OPTIONS") diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm index 35698a0216..b4ca7b1687 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. ;;; =20 -(define (guix-processes . args) +(define-command (guix-processes . args) + (category plumbing) + (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..4eaf961ab2 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -1013,7 +1013,10 @@ methods, return the applicable compression." ;;; Entry point. ;;; =20 -(define (guix-publish . args) +(define-command (guix-publish . args) + (category packaging) + (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))) =20 -(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..4a71df28d1 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Cour= t=C3=A8s +;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovi= c Court=C3=A8s ;;; Copyright =C2=A9 2013 Nikita Karetnikov ;;; Copyright =C2=A9 2014 Eric Bavier ;;; Copyright =C2=A9 2015 Alex Kost @@ -496,7 +496,10 @@ all are dependent packages: ~{~a~^ ~}~%") ;;; Entry point. ;;; =20 -(define (guix-refresh . args) +(define-command (guix-refresh . args) + (category packaging) + (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..a46ad04d56 100644 --- a/guix/scripts/remove.scm +++ b/guix/scripts/remove.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2019, 2020 Ludovic Court=C3=A8s ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,7 +63,9 @@ This is an alias for 'guix package -r'.\n")) =20 %standard-build-options))) =20 -(define (guix-remove . args) +(define-command (guix-remove . args) + (synopsis "remove 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..3c79e89f8d 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -137,7 +137,10 @@ call THUNK." (loop))))))) =20 -(define (guix-repl . args) +(define-command (guix-repl . args) + (category plumbing) + (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 =C2=A9 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2019, 2020 Ludovic Court=C3=A8s ;;; ;;; 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))) =20 -(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=3D'.\n")) (member "load-path" (option-names option))) %standard-build-options))) =20 -(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..e46983382a 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2015, 2016, 2017, 2018, 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Court=C3= =A8s ;;; Copyright =C2=A9 2019 Simon Tournier ;;; ;;; 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. ;;; =20 -(define (guix-size . args) +(define-command (guix-size . args) + (category packaging) + (synopsis "profile the on-disk size of packages") + (with-error-handling (let* ((opts (parse-command-line args %options (list %default-opti= ons) #: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 @@ =20 (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))) =20 -(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)))) =20 -(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. ;;; =20 -(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 =C2=A9 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2019, 2020 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2020 Jakub K=C4=85dzio=C5=82ka ;;; ;;; 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))) =20 -(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..6a2582c997 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. ;;; =20 -(define (guix-weather . args) +(define-command (guix-weather . args) + (synopsis "report on the availability 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 981e133aaf..51a61be687 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) @@ -1989,6 +1990,44 @@ optionally contain a version number and an output na= me, as in these examples: (G_ "Try `guix --help' for more information.~%")) (exit 1)) =20 +;; Representation of a 'guix' command. +(define-immutable-record-type + (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 object b= ased +on the 'define-command' top-level form found therein, or #f if FILE does n= ot +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 @@ -2000,28 +2039,51 @@ optionally contain a version number and an output n= ame, as in these examples: (cut string-suffix? ".scm" <>)) =20 (if directory - (scandir directory dot-scm?) + (map (cut string-append directory "/" <>) + (scandir directory dot-scm?)) '())) =20 (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))) =20 (define (show-guix-help) (define (internal? command) (member command '("substitute" "authenticate" "offload" "perform-download"))) =20 + (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)) - stringFrom b3494f3cd670e0d1e5842b9b022c2606a520d34a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 1 Sep 2020 22:23:50 +0200 Subject: [PATCH 1/2] ui: '--help' output links to . * guix/ui.scm (show-bug-report-information): Link to instead of . The former is much more useful and includes links to GNU manuals. --- guix/ui.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/guix/ui.scm b/guix/ui.scm index efc3f39186..981e133aaf 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -541,8 +541,9 @@ There is NO WARRANTY, to the extent permitted by law. Report bugs to: ~a.") %guix-bug-report-address) (format #t (G_ " ~a home page: <~a>") %guix-package-name %guix-home-page-url) - (display (G_ " -General help using GNU software: ")) + (format #t (G_ " +General help using Guix and GNU software: <~a>") + "https://guix.gnu.org/help/") (newline)) (define (augmented-system-error-handler file) -- 2.28.0 --=-=-=--