diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-09-01 22:13:11 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-09-10 12:27:24 +0200 |
commit | 3794ce93be8216d8378df7b808ce7f53b1e05a53 (patch) | |
tree | e2e99b24dfbfbe642f263d403ca78d6baabf5aae /guix/ui.scm | |
parent | 991fdb0d6496358c8f11708b1d0de4f06ebf7785 (diff) | |
download | guix-patches-3794ce93be8216d8378df7b808ce7f53b1e05a53.tar guix-patches-3794ce93be8216d8378df7b808ce7f53b1e05a53.tar.gz |
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 (<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.
Diffstat (limited to 'guix/ui.scm')
-rw-r--r-- | guix/ui.scm | 80 |
1 files changed, 71 insertions, 9 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index 6841b0f324..9006f82144 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) @@ -1993,6 +1994,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 @@ -2004,28 +2043,51 @@ 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)) + (categories (module-ref (resolve-interface '(guix scripts)) + '%command-categories))) + (for-each (match-lambda + (('internal . _) + #t) ;hide internal commands + ((category . synopsis) + (format #t "~% ~a~%" (G_ synopsis)) + (display-commands (filter (category-predicate category) + commands)))) + categories)) (show-bug-report-information)) (define (run-guix-command command . args) |