raco pkg: improve command-line checking and error reporting
For example, complain if both `-u' and `-i' are specified, or if a bad `--deps' mode is provided.
This commit is contained in:
Matthew Flatt
parent
61e0610b2a
commit
853f959622
|
|
@ -3,7 +3,8 @@
|
|||
racket/cmdline
|
||||
(for-syntax racket/base))
|
||||
|
||||
(provide svn-style-command-line)
|
||||
(provide svn-style-command-line
|
||||
current-svn-style-command)
|
||||
|
||||
;; implements an "svn-style" command-line interface as a wrapper around racket/cmdline. At the moment,
|
||||
;; it is light on error-checking and makes choices that are somewhat specific to the PLaneT commandline
|
||||
|
|
@ -31,6 +32,8 @@
|
|||
;; This means that no command name may be a prefix of any other command name, because it
|
||||
;; would mean there was no way to unambiguously name the shorter one.
|
||||
|
||||
(define current-svn-style-command (make-parameter #f))
|
||||
|
||||
(define-syntax (svn-style-command-line stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:program prog
|
||||
|
|
@ -52,19 +55,20 @@
|
|||
(values (car argslist) (cdr argslist)))])
|
||||
(prefix-case the-command
|
||||
[n
|
||||
(command-line
|
||||
#:program (format "~a ~a" p n)
|
||||
#:argv remainder
|
||||
body ...
|
||||
#:handlers
|
||||
(λ (_ . formals) final-expr)
|
||||
(ensure-list (pimap symbol->string 'formals))
|
||||
(λ (help-string)
|
||||
(for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80))
|
||||
(newline)
|
||||
(display "Usage:\n")
|
||||
(display help-string)
|
||||
(exit)))] ...
|
||||
(parameterize ([current-svn-style-command n])
|
||||
(command-line
|
||||
#:program (format "~a ~a" p n)
|
||||
#:argv remainder
|
||||
body ...
|
||||
#:handlers
|
||||
(λ (_ . formals) final-expr)
|
||||
(ensure-list (pimap symbol->string 'formals))
|
||||
(λ (help-string)
|
||||
(for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80))
|
||||
(newline)
|
||||
(display "Usage:\n")
|
||||
(display help-string)
|
||||
(exit))))] ...
|
||||
["help" (help)]
|
||||
[else (help)]))))]))
|
||||
|
||||
|
|
|
|||
|
|
@ -8,6 +8,22 @@
|
|||
racket/syntax
|
||||
syntax/parse))
|
||||
|
||||
(define ((string->option what valid-options) str)
|
||||
(define s (string->symbol str))
|
||||
(unless (memq s valid-options)
|
||||
(raise-user-error (string->symbol
|
||||
(format "~a ~a"
|
||||
(short-program+command-name)
|
||||
(current-svn-style-command)))
|
||||
"invalid <~a>: ~a\n valid <~a>s are:~a"
|
||||
what
|
||||
str
|
||||
what
|
||||
(apply string-append
|
||||
(for/list ([s (in-list valid-options)])
|
||||
(format " ~a" s)))))
|
||||
s)
|
||||
|
||||
(begin-for-syntax
|
||||
(define symbol->keyword
|
||||
(compose string->keyword symbol->string))
|
||||
|
|
@ -18,11 +34,11 @@
|
|||
#:attr (arg-val 1) empty
|
||||
#:attr default #'#f
|
||||
#:attr fun #'(λ () #t)]
|
||||
[pattern (#:sym default:expr)
|
||||
#:attr (arg-val 1) (list #'string)
|
||||
#:attr fun #'string->symbol]
|
||||
[pattern (#:str default:expr)
|
||||
#:attr (arg-val 1) (list #'string)
|
||||
[pattern (#:sym name:id [opt:id ...] default:expr)
|
||||
#:attr (arg-val 1) (list #'name)
|
||||
#:attr fun #'(string->option 'name '(opt ...))]
|
||||
[pattern (#:str name:id default:expr)
|
||||
#:attr (arg-val 1) (list #'name)
|
||||
#:attr fun #'identity])
|
||||
|
||||
(define-syntax-class option
|
||||
|
|
@ -50,26 +66,42 @@
|
|||
doc
|
||||
(set! #,arg-var (k.fun k.arg-val ...))])])
|
||||
|
||||
(define-syntax-class group-kind
|
||||
[pattern #:once-any]
|
||||
[pattern #:once-each]
|
||||
[pattern #:multi])
|
||||
|
||||
(define-splicing-syntax-class option-group
|
||||
#:attributes ((command-line 1) variable (param 1) (call 1))
|
||||
[pattern (~seq k:group-kind o:option ...)
|
||||
#:attr (command-line 1)
|
||||
(syntax->list #'(k o.command-line ...))
|
||||
#:attr variable
|
||||
#'(begin o.variable ...)
|
||||
#:attr (param 1)
|
||||
(syntax->list #'(o.param ... ...))
|
||||
#:attr (call 1)
|
||||
(syntax->list #'(o.call ... ...))])
|
||||
|
||||
(define-syntax-class command
|
||||
#:attributes (name function variables command-line)
|
||||
[pattern (name:id doc:expr o:option ... #:args args body:expr ...)
|
||||
[pattern (name:id doc:expr og:option-group ... #:args args body:expr ...)
|
||||
#:do
|
||||
[(define name-str (symbol->string (syntax->datum #'name)))]
|
||||
#:attr function
|
||||
(syntax/loc #'name
|
||||
(define (name o.param ... ... . args)
|
||||
(define (name og.param ... ... . args)
|
||||
body ...))
|
||||
#:attr variables
|
||||
(syntax/loc #'name
|
||||
(begin o.variable ...))
|
||||
(begin og.variable ...))
|
||||
#:attr command-line
|
||||
(quasisyntax/loc #'name
|
||||
[#,name-str
|
||||
doc doc
|
||||
#:once-each
|
||||
o.command-line ...
|
||||
og.command-line ... ...
|
||||
#:args args
|
||||
(args-app args (name o.call ... ...))])]))
|
||||
(args-app args (name og.call ... ...))])]))
|
||||
|
||||
(define-syntax (args-app stx)
|
||||
(syntax-parse stx
|
||||
|
|
|
|||
|
|
@ -1062,7 +1062,7 @@
|
|||
(unless (directory-exists? dir)
|
||||
(pkg-error "directory does not exist\n path: ~a" dir))
|
||||
(match create:format
|
||||
["MANIFEST"
|
||||
['MANIFEST
|
||||
(with-output-to-file
|
||||
(build-path dir "MANIFEST")
|
||||
#:exists 'replace
|
||||
|
|
@ -1079,7 +1079,7 @@
|
|||
(path->string (file-name-from-path pkg))
|
||||
""))
|
||||
(match create:format
|
||||
["tgz"
|
||||
['tgz
|
||||
(define pkg/complete (path->complete-path pkg))
|
||||
(when (file-exists? pkg/complete)
|
||||
(delete-file pkg/complete))
|
||||
|
|
@ -1089,7 +1089,7 @@
|
|||
(delete-file pkg/complete))
|
||||
(raise exn))])
|
||||
(apply tar-gzip pkg/complete (directory-list))))]
|
||||
["zip"
|
||||
['zip
|
||||
(define pkg/complete (path->complete-path pkg))
|
||||
(when (file-exists? pkg/complete)
|
||||
(delete-file pkg/complete))
|
||||
|
|
@ -1099,7 +1099,7 @@
|
|||
(delete-file pkg/complete))
|
||||
(raise exn))])
|
||||
(apply zip pkg/complete (directory-list))))]
|
||||
["plt"
|
||||
['plt
|
||||
(define dest (path->complete-path pkg))
|
||||
(parameterize ([current-directory dir])
|
||||
(define names (filter std-filter (directory-list)))
|
||||
|
|
@ -1140,7 +1140,7 @@
|
|||
(-> boolean? list?
|
||||
void?)]
|
||||
[create-cmd
|
||||
(-> string? path-string?
|
||||
(-> (or/c 'zip 'tgz 'plt 'MANIFEST) path-string?
|
||||
void?)]
|
||||
[update-packages
|
||||
(->* ((listof string?))
|
||||
|
|
|
|||
|
|
@ -27,18 +27,23 @@
|
|||
"This tool is used for managing installed packages."
|
||||
[install
|
||||
"Install packages"
|
||||
[(#:sym #f) type ("-t") ("Type of <pkg-source>;"
|
||||
"options are: file, dir, file-url, dir-url, github, or name;"
|
||||
"if not specified, the type is inferred syntactically")]
|
||||
[(#:str #f) name ("-n") ("Name of package, instead of inferred"
|
||||
"(makes sense only when a single <pkg-source> is given)")]
|
||||
[#:bool no-setup () ("Don't run 'raco setup' after changing packages"
|
||||
#:once-each
|
||||
[(#:sym type [file dir file-url dir-url github name] #f) type ("-t")
|
||||
("Type of <pkg-source>;"
|
||||
"valid <types>s are: file, dir, file-url, dir-url, github, or name;"
|
||||
"if not specified, the type is inferred syntactically")]
|
||||
[(#:str name #f) name ("-n") ("Name of package, instead of inferred"
|
||||
"(makes sense only when a single <pkg-source> is given)")]
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages"
|
||||
"(generally not a good idea)")]
|
||||
[#:bool installation ("-i") "Operate on the installation-wide package database"]
|
||||
[#:bool shared ("-s") "Install user-specific packages as shared for all versions"]
|
||||
[(#:sym #f) deps ()
|
||||
#:once-any
|
||||
[#:bool installation ("-i") "Install for all users of the Racket installation"]
|
||||
[#:bool shared ("-s") "Install as user-specific but shared for all Racket versions"]
|
||||
[#:bool user ("-u") "Install as user- and version-specific (the default)"]
|
||||
#:once-each
|
||||
[(#:sym mode [fail force search-ask search-auto] #f) deps ()
|
||||
("Specify the behavior for dependencies;"
|
||||
"options are:"
|
||||
"valid <mode>s are:"
|
||||
" fail: cancels the installation if dependencies are unmet"
|
||||
" (default for most packages)"
|
||||
" force: installs the package despite missing dependencies"
|
||||
|
|
@ -63,15 +68,19 @@
|
|||
(setup no-setup installation setup-collects)))]
|
||||
[update
|
||||
"Update packages"
|
||||
[#:bool no-setup () ("Don't run 'raco setup' after changing packages"
|
||||
#:once-each
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages"
|
||||
"(generally not a good idea)")]
|
||||
[#:bool installation ("-i") "Operate on the installation-wide package database"]
|
||||
[#:bool shared ("-s") "Operate on the user-specific all-version package database"]
|
||||
#:once-any
|
||||
[#:bool installation ("-i") "Update only for all users of the Racket installation"]
|
||||
[#:bool shared ("-s") "Update only user-specific packages for all Racket versions"]
|
||||
[#:bool user ("-u") "Update only user- and version-specific packages (the default)"]
|
||||
#:once-each
|
||||
[#:bool all ("-a") ("Update all packages;"
|
||||
"only if no packages are given on the command line")]
|
||||
[(#:sym #f) deps ()
|
||||
[(#:sym mode [fail force search-ask search-auto] #f) deps ()
|
||||
("Specify the behavior for dependencies;"
|
||||
"options are:"
|
||||
"valid <mods>s are:"
|
||||
" fail: cancels the installation if dependencies are unmet"
|
||||
" (default for most packages)"
|
||||
" force: installs the package despite missing dependencies"
|
||||
|
|
@ -94,10 +103,14 @@
|
|||
(setup no-setup installation setup-collects))))]
|
||||
[remove
|
||||
"Remove packages"
|
||||
[#:bool no-setup () ("Don't run 'raco setup' after changing packages"
|
||||
#:once-each
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages"
|
||||
"(generally not a good idea)")]
|
||||
[#:bool installation ("-i") "Operate on the installation-wide package database"]
|
||||
[#:bool shared ("-s") "Operate on the user-specific all-version package database"]
|
||||
#:once-any
|
||||
[#:bool installation ("-i") "Remove packages for all users of the Racket installation"]
|
||||
[#:bool shared ("-s") "Remove user-specific packages for all Racket versions"]
|
||||
[#:bool user ("-u") "Remove user- and version-specific packages (the default)"]
|
||||
#:once-each
|
||||
[#:bool force () "Force removal of packages"]
|
||||
[#:bool auto () "Remove automatically installed packages with no dependencies"]
|
||||
#:args pkgs
|
||||
|
|
@ -111,10 +124,11 @@
|
|||
(setup no-setup installation #f)))]
|
||||
[show
|
||||
"Show information about installed packages"
|
||||
[#:bool installation ("-i") "Show only the installation-wide package database"]
|
||||
[#:bool shared ("-s") "Show only the user-specific all-version package database"]
|
||||
[#:bool user ("-u") "Show only the user- and version-specific package database"]
|
||||
[(#:str #f) version ("-v") "Show only user--specific packages for specified version"]
|
||||
#:once-any
|
||||
[#:bool installation ("-i") "Show only for all users of the Racket installation"]
|
||||
[#:bool shared ("-s") "Show only user-specific for all Racket versions"]
|
||||
[#:bool user ("-u") "Show only the user- and version-specific"]
|
||||
[(#:str vers #f) version ("-v") "Show only user-specific for Racket <vers>"]
|
||||
#:args ()
|
||||
(define only-mode (cond
|
||||
[installation 'i]
|
||||
|
|
@ -136,8 +150,11 @@
|
|||
(show-cmd (if only-mode "" " "))))))]
|
||||
[config
|
||||
"View and modify the package configuration"
|
||||
#:once-any
|
||||
[#:bool installation ("-i") "Operate on the installation-wide package database"]
|
||||
[#:bool shared ("-s") "Operate on the user-specific all-version package database"]
|
||||
[#:bool user ("-u") "Operate on the user-specific, version-specific package database"]
|
||||
#:once-each
|
||||
[#:bool set () "Completely replace the value"]
|
||||
#:args key+vals
|
||||
(parameterize ([current-install-system-wide? installation]
|
||||
|
|
@ -147,10 +164,11 @@
|
|||
(config-cmd set key+vals)))]
|
||||
[create
|
||||
"Bundle a new package"
|
||||
[(#:str #f) format ()
|
||||
#:once-any
|
||||
[(#:sym fmt [zip tgz plt] #f) format ()
|
||||
("Select the format of the package to be created;"
|
||||
"options are: zip (the default), tgz, plt")]
|
||||
"valid <fmt>s are: zip (the default), tgz, plt")]
|
||||
[#:bool manifest () "Creates a manifest file for a directory, rather than an archive"]
|
||||
#:args (maybe-dir)
|
||||
(parameterize ([current-pkg-error (pkg-error 'create)])
|
||||
(create-cmd (if manifest "MANIFEST" (or format "zip")) maybe-dir))])
|
||||
(create-cmd (if manifest 'MANIFEST (or format 'zip)) maybe-dir))])
|
||||
|
|
|
|||
|
|
@ -229,8 +229,9 @@ sub-sub-commands:
|
|||
@item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the
|
||||
environment variable @envvar{PLT_PLANET2_NOSETUP} is set to any non-empty value.}
|
||||
|
||||
@item{@DFlag{installation} or @Flag{i} --- Install system-wide, rather than user-local.}
|
||||
@item{@DFlag{shared} or @Flag{s} --- Install for all Racket versions, rather than user-local and version-specific.}
|
||||
@item{@DFlag{installation} or @Flag{i} --- Install packages for all users of a Racket installation, rather than user-specific.}
|
||||
@item{@DFlag{shared} or @Flag{s} --- Install packages as user-specific, but for all Racket versions.}
|
||||
@item{@DFlag{user} or @Flag{u} --- Install packages as user-specific and Racket version-specific (the default).}
|
||||
|
||||
@item{@DFlag{deps} @nonterm{behavior} --- Selects the behavior for dependencies, where @nonterm{behavior} is one of
|
||||
@itemlist[
|
||||
|
|
@ -262,6 +263,7 @@ the following @nonterm{option}s:
|
|||
@item{@DFlag{no-setup} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{shared} or @Flag{s} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{user} or @Flag{u} --- Same as for @exec{install} (the default).}
|
||||
@item{@DFlag{deps} @nonterm{behavior} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{all} or @Flag{a} --- Update all packages, if no packages are given in the argument list.}
|
||||
@item{@DFlag{update-deps} --- Checks the named packages, and their dependencies (transitively) for updates.}
|
||||
|
|
@ -276,6 +278,7 @@ listed, this command fails atomically. It accepts the following @nonterm{option}
|
|||
@item{@DFlag{no-setup} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{shared} or @Flag{s} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{user} or @Flag{u} --- Same as for @exec{install} (the default).}
|
||||
@item{@DFlag{force} --- Ignore dependencies when removing packages.}
|
||||
@item{@DFlag{auto} --- Remove packages that were installed by the @exec{search-auto} or @exec{search-ask}
|
||||
dependency behavior and are no longer required.}
|
||||
|
|
@ -289,8 +292,8 @@ listed, this command fails atomically. It accepts the following @nonterm{option}
|
|||
|
||||
@itemlist[
|
||||
@item{@DFlag{installation} or @Flag{i} --- Show only installation-wide packages.}
|
||||
@item{@DFlag{user} or @Flag{u} --- Show only user-specific, version-specific packages.}
|
||||
@item{@DFlag{shared} or @Flag{s} --- Show only user-specific, all-version packages.}
|
||||
@item{@DFlag{user} or @Flag{u} --- Show only user-specific, version-specific packages.}
|
||||
@item{@DFlag{version} @nonterm{vers} or @Flag{v} @nonterm{vers} --- Show only user-specific packages for Racket version @nonterm{vers}.}
|
||||
]
|
||||
}
|
||||
|
|
@ -301,6 +304,7 @@ View and modify package configuration options. It accepts the following @nonterm
|
|||
@itemlist[
|
||||
@item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{shared} or @Flag{s} --- Same as for @exec{install}.}
|
||||
@item{@DFlag{user} or @Flag{u} --- Same as for @exec{install} (the default).}
|
||||
@item{@DFlag{set} --- Sets an option, rather than printing it.}
|
||||
]
|
||||
|
||||
|
|
@ -328,9 +332,8 @@ View and modify package configuration options. It accepts the following @nonterm
|
|||
|
||||
The @racketmodname[planet2] module provides a programmatic interface
|
||||
to the command sub-sub-commands. Each long form option is keyword
|
||||
argument. An argument corresponding to @DFlag{type} or @DFlag{deps}
|
||||
accepts its argument as a symbol, and @DFlag{format} accepts its
|
||||
argument as a string. All other options accept booleans, where
|
||||
argument. An argument corresponding to @DFlag{type}, @DFlag{deps}, or @DFlag{format}
|
||||
accepts its argument as a symbol. All other options accept booleans, where
|
||||
@racket[#t] is equivalent to the presence of the option.
|
||||
|
||||
@deftogether[
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user