raco pkg config: show all by default

Also, better help, checking, and error reporting on arguments.

Related to PR 14180

Merge to v6.0

pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl

@@ -157,11 +157,15 @@ directory should be removed after the package content is no longer
 needed, and a list of module paths provided by the package.}
 
 
-@defproc[(pkg-config [set? boolean?] [keys/vals list?])
+@defproc[(pkg-config [set? boolean?] [keys/vals list?]
+                     [#:from-command-line? from-command-line? boolean? #f])
          void?]{
 
 Implements @racket[pkg-config-command].
 
+If @racket[from-command-line?]  is true, error messages may suggest
+specific command-line flags for @command-ref{config}.
+
 The package lock must be held (allowing writes if @racket[set?] is true); see
 @racket[with-pkg-lock].}
 

pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -599,8 +599,14 @@ the given @nonterm{pkg}s.
   ]
 }
 
-@subcommand{@command/toc{config} @nonterm{option} ... @nonterm{key} @nonterm{val} ... --- 
+@subcommand{@command/toc{config} @nonterm{option} ... @optional[@nonterm{key}] @nonterm{val} ... --- 
-View and modify configuration of the package manager itself, with the following @nonterm{option}s:
+View and modify the configuration of the package manager. If @nonterm{key} is not provided,
+the values for all recognized keys are shown. The @nonterm{val} arguments are allowed
+only when @DFlag{set} is used, in which case the @nonterm{val}s are used as the new values
+for @nonterm{key}.
+
+ The @exec{config} sub-command accepts 
+ with the following @nonterm{option}s:
 
  @itemlist[
  @item{@DFlag{set} --- Sets an option, rather than printing it.}
@@ -614,6 +620,8 @@ View and modify configuration of the package manager itself, with the following
 
  The valid @nonterm{key}s are:
  @itemlist[
+  @item{@exec{name} --- A string for the installation's name, which is used by @exec{user}
+        @tech{package scope} and defaults to the Racket version.}
   @item{@exec{catalogs} --- A list of URLs for @tech{package catalogs}.}
   @item{@exec{default-scope} --- Either @exec{installation} or @exec{user}.
         The value of this key at @exec{user} scope (possibly defaulting from
@@ -621,8 +629,6 @@ View and modify configuration of the package manager itself, with the following
         the default @tech{package scope} for @exec{raco pkg} commands for which
         a scope is not inferred from a given set of package names
         (even for @command{config}, which is consistent but potentially confusing).}
-  @item{@exec{name} --- A string for the installation's name, which is used by @exec{user}
-        @tech{package scope} and defaults to the Racket version.}
   @item{@exec{download-cache-dir} --- A directory that holds copies of
         downloaded packages, used to avoid re-downloading if the
         same URL and checksum combination is requested again. The default cache directory is

racket/collects/pkg/commands.rkt

@@ -6,7 +6,8 @@
          (for-syntax racket/base
                      racket/list
                      racket/syntax
-                     syntax/parse))
+                     syntax/parse
+                     syntax/stx))
 
 (define ((string->option what valid-options) str)
   (define s (string->symbol str))
@@ -104,15 +105,36 @@
              #:attr (command-line 1)
              (syntax->list #'(#:usage-help s ...))])
 
+  (define-splicing-syntax-class arguments
+    #:attributes (accum args (body 1) help-strs)
+    [pattern (~seq #:args args 
+                   body:expr ...)
+             #:with accum #'ignored
+             #:with help-strs (with-syntax ([strs 
+                                             (map symbol->string
+                                                  (map syntax->datum
+                                                       (let loop ([args #'args])
+                                                         (cond 
+                                                          [(stx-null? args) null]
+                                                          [(stx-pair? args)
+                                                           (cons (stx-car args)
+                                                                 (loop (stx-cdr args)))]
+                                                          [else
+                                                           (list args)]))))])
+                                #`(list . strs))]
+    [pattern (~seq #:handlers
+                   (lambda (accum . args) body:expr ...) 
+                   help-strs:expr)])
+
   (define-syntax-class command
     #:attributes (name function variables command-line)
-    [pattern (name:id doc:expr uh:usage-help ... og:option-group ... #:args args body:expr ...)
+    [pattern (name:id doc:expr uh:usage-help ... og:option-group ... arg:arguments)
              #:do
              [(define name-str (symbol->string (syntax->datum #'name)))]
              #:attr function
              (syntax/loc #'name
-               (define (name og.param ... ... . args)
+               (define (name og.param ... ... . arg.args)
-                 body ...))
+                 arg.body ...))
              #:attr variables
              (syntax/loc #'name
                (begin og.variable ...))
@@ -122,8 +144,10 @@
                 doc doc
                 uh.command-line ... ...
                 og.command-line ... ...
-                #:args args
+                #:handlers
-                (args-app args (name og.call ... ...))])]))
+                (lambda (accum . arg.args)
+                  (args-app arg.args (name og.call ... ...)))
+                arg.help-strs])]))
 
 (define-syntax (args-app stx)
   (syntax-parse stx

racket/collects/pkg/lib.rkt

@@ -2360,10 +2360,35 @@
        (unless quiet?
          (printf "Packages migrated\n")))))
 
-(define (pkg-config config:set key+vals)
+(define (pkg-config config:set key+vals
+                    #:from-command-line? [from-command-line? #f])
   (cond
     [config:set
      (match key+vals
+       [(list)
+        (pkg-error "no config key given")]
+       [(list (and key
+                   (or "default-scope"
+                       "name"
+                       "download-cache-max-files"
+                       "download-cache-max-bytes"
+                       "download-cache-dir")))
+        (pkg-error (~a "missing value for config key\n"
+                       "  config key: ~a")
+                   key)]
+       [(list* (and key
+                    (or "default-scope"
+                        "name"
+                        "download-cache-max-files"
+                        "download-cache-max-bytes"
+                        "download-cache-dir"))
+               val
+               more-vals)
+        (pkg-error (~a "too many values provided for config key\n"
+                       "  config key: ~a\n"
+                       "  given values:~a")
+                   key
+                   (format-list (cons val more-vals)))]
        [(list* (and key "catalogs") val)
         (update-pkg-cfg! 'catalogs val)]
        [(list (and key "default-scope") val)
@@ -2381,6 +2406,16 @@
                          "  current package scope: ~a")
                      (current-pkg-scope)))
         (update-pkg-cfg! 'installation-name val)]
+       [(list (and key "download-cache-dir")
+              val)
+        (unless (complete-path? val)
+          (pkg-error (~a "invalid value for config key\n"
+                         " not an absolute path\n"
+                         "  config key: ~a\n"
+                         "  given value: ~a")
+                     key
+                     val))
+        (update-pkg-cfg! (string->symbol key) val)]
        [(list (and key (or "download-cache-max-files"
                            "download-cache-max-bytes"))
               val)
@@ -2391,32 +2426,45 @@
                          "  valid values: real numbers")
                      key
                      val))
-        (update-pkg-cfg! (string->symbol key) val)]
+        (update-pkg-cfg! (string->symbol key) (string->number val))]
-       [(list key)
+       [(list* key args)
-        (pkg-error "unsupported config key\n  key: ~e" key)]
+        (pkg-error "unsupported config key\n  key: ~a" key)])]
-       [(list)
-        (pkg-error "config key not provided")])]
     [else
+     (define (show key+vals indent)
        (match key+vals
          [(list key)
           (match key
             ["catalogs"
              (for ([s (in-list (read-pkg-cfg/def 'catalogs))])
-             (printf "~a\n" s))]
+               (printf "~a~a\n" indent s))]
             ["default-scope"
-           (printf "~a\n" (read-pkg-cfg/def 'default-scope))]
+             (printf "~a~a\n" indent (read-pkg-cfg/def 'default-scope))]
             ["name"
-           (printf "~a\n" (read-pkg-cfg/def 'installation-name))]
+             (printf "~a~a\n" indent (read-pkg-cfg/def 'installation-name))]
             [(or "download-cache-dir"
                  "download-cache-max-files"
                  "download-cache-max-bytes")
-           (printf "~a\n" (read-pkg-cfg/def (string->symbol key)))]
+             (printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))]
             [_
              (pkg-error "unsupported config key\n  key: ~e" key)])]
          [(list)
           (pkg-error "config key not provided")]
          [_
-        (pkg-error "multiple config keys provided (not in value-setting mode)")])]))
+          (pkg-error (~a "multiple config keys provided"
+                         (if from-command-line?
+                             ";\n supply `--set' to set a config key's value"
+                             "")))]))
+     (match key+vals
+       [(list)
+        (for ([key (in-list '("name"
+                              "catalogs"
+                              "default-scope"
+                              "download-cache-dir"
+                              "download-cache-max-files"
+                              "download-cache-max-bytes"))])
+          (printf "~a:\n" key)
+          (show (list key) "  "))]
+       [_ (show key+vals "")])]))
 
 (define (create-as-is create:format pkg-name dir orig-dir
                       #:quiet? [quiet? #f]
@@ -3057,7 +3105,8 @@
        boolean?
        pkg-desc?)]
   [pkg-config
-   (-> boolean? list?
+   (->* (boolean? (listof string?))
+        (#:from-command-line? boolean?)
         void?)]
   [pkg-create
    (->* ((or/c 'zip 'tgz 'plt 'MANIFEST)

racket/collects/pkg/main.rkt

@@ -138,8 +138,8 @@
             ;; ----------------------------------------
             [install
              "Install packages"
-             #:usage-help "Installs the packages specified by <pkg-source> ..."
+             #:usage-help "Installs the packages specified by <pkg-source> ..., and"
-                          "If no sources are specified, installs the current directory."
+                          "if no sources are specified, installs the current directory"
              #:once-each
              install-type-flags ...
              #:once-any
@@ -385,20 +385,27 @@
             ;; ----------------------------------------
             [config
              "View and modify the package manager's configuration"
-             #:once-each
+             #:usage-help "Shows value for <key>, shows values for all <key>s if"
-             [#:bool set () "Set <key> to <val> ..."]
+                          " none is given, or sets a single <key>"
+                          " if --set is specified"
+             #:once-any
+             [#:bool set () "Set <key> to <val>s"]
              #:once-any
              scope-flags ...
-             #:args (key . val)
+             #:handlers
+             (lambda (accum . key+vals)
                (call-with-package-scope
                 'config
                 scope scope-dir installation user #f #f
                 (lambda ()
                   (if set
                       (with-pkg-lock
-                     (pkg-config #t (cons key val)))
+                       (pkg-config #t key+vals
+                                   #:from-command-line? #t))
                       (with-pkg-lock/read-only
-                     (pkg-config #f (cons key val))))))]
+                       (pkg-config #f key+vals
+                                   #:from-command-line? #t))))))
+             (list "key" "val")]
             ;; ----------------------------------------
             [catalog-show
              "Show package information as reported by a catalog"

racket/collects/planet/private/command.rkt

@@ -39,7 +39,21 @@
     [(_ #:program prog 
         #:argv args
         general-description
-        [name description long-description body ... #:args formals final-expr] ...)
+        clause ...)
+     (with-syntax ([(((name description long-description body ...)
+                      accum formals arg-help-strs final-expr)
+                     ...)
+                    (map (lambda (clause)
+                           (syntax-case clause ()
+                             [[name description long-description body ...
+                                    #:args formals final-expr]
+                              #'((name description long-description body ...)
+                                 ignored formals (pimap symbol->string 'formals) final-expr)]
+                             [(name description long-description body ...
+                                    #:handlers (lambda (accum . formals) final-expr) arg-help-strs)
+                              #'((name description long-description body ...)
+                                 accum formals arg-help-strs final-expr)]))
+                         (syntax->list #'(clause ...)))])
        (with-syntax ([(n ...) (generate-temporaries #'(name ...))])
          #'(let* ([p prog]
                   [a args]
@@ -61,8 +75,8 @@
                                 #:argv remainder 
                                 body ...
                                 #:handlers
-                              (λ (_ . formals) final-expr)
+                                (λ (accum . formals) final-expr)
-                              (pimap symbol->string 'formals)
+                                arg-help-strs
                                 (λ (help-string)
                                   (for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80))
                                   (newline)
@@ -70,7 +84,7 @@
                                   (display help-string)
                                   (exit))))] ...
                                   ["help" (help)]
-                          [else (help)]))))]))
+                                  [else (help)])))))]))
 
 
 ;; display-help-message : string string (listof (list string string)) -> void