raco pkg install: add --update-deps flag

This option makes install and update even more consistent, also
`--auto` still implies `--update-deps` only in update mode.

Make `--update-deps' consult the user in `search-ask' mode,
make it ignored in `fail' or `force' mode.
This commit is contained in:
Matthew Flatt 2013-08-20 10:49:56 -06:00
parent 21d3c168a0
commit ccead82841
4 changed files with 79 additions and 49 deletions

View File

@ -167,6 +167,7 @@ Unless @racket[quiet?] is true, information about the output is repotred to the
[#:dep-behavior dep-behavior [#:dep-behavior dep-behavior
(or/c #f 'fail 'force 'search-ask 'search-auto) (or/c #f 'fail 'force 'search-ask 'search-auto)
#f] #f]
[#:update-deps? update-deps? boolean? #f]
[#:force? force? boolean? #f] [#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f]
[#:quiet? boolean? quiet? #f] [#:quiet? boolean? quiet? #f]
@ -196,11 +197,11 @@ The package lock must be held; see @racket[with-pkg-lock].}
@defproc[(pkg-update [names (listof (or/c string? pkg-desc?))] @defproc[(pkg-update [names (listof (or/c string? pkg-desc?))]
[#:all? all? boolean? #f]
[#:dep-behavior dep-behavior [#:dep-behavior dep-behavior
(or/c #f 'fail 'force 'search-ask 'search-auto) (or/c #f 'fail 'force 'search-ask 'search-auto)
#f] #f]
[#:all? all? boolean? #f] [#:update-deps? update-deps? boolean? #f]
[#:deps? deps? boolean? #f]
[#:force? force? boolean? #f] [#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f]
[#:quiet? boolean? quiet? #f] [#:quiet? boolean? quiet? #f]

View File

@ -283,15 +283,23 @@ sub-commands.
@item{@DFlag{deps} @nonterm{behavior} --- Selects the behavior for dependencies, where @nonterm{behavior} is one of @item{@DFlag{deps} @nonterm{behavior} --- Selects the behavior for dependencies, where @nonterm{behavior} is one of
@itemlist[ @itemlist[
@item{@exec{fail} --- Cancels the installation if dependencies are version requirements are unmet (default for most packages)} @item{@exec{fail} --- Cancels the installation if dependencies are uninstalled or version requirements are unmet.
@item{@exec{force} --- Installs the package(s) despite missing dependencies or version requirements (unsafe)} This behavior is the default for a @nonterm{pkg-source} that is not a @tech{package name}.}
@item{@exec{search-ask} --- Looks for the dependencies or updates via the configured @tech{package catalogs} @item{@exec{force} --- Installs the package(s) despite missing dependencies or version requirements (unsafe).}
(default if the dependency is a @tech{package name}) but asks if you would like it installed or updated.} @item{@exec{search-ask} --- Looks for dependencies (when uninstalled) or updates (when version requirements are unmet)
via the configured @tech{package catalogs},
but asks if you would like the packages installed or updated. This behavior is the default for a
@nonterm{pkg-source} that is a @tech{package name}.}
@item{@exec{search-auto} --- Like @exec{search-ask}, but does not ask for permission to install or update.} @item{@exec{search-auto} --- Like @exec{search-ask}, but does not ask for permission to install or update.}
]} ]}
@item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto}.} @item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto}.}
@item{@DFlag{update-deps} --- With @exec{search-ask} or @exec{search-auto} dependency behavior, checks
already-installed dependencies transitively for updates (even when
not forced by version requirements), asking or automatically updating a
package when an update is available.}
@item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type), @item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
and links the existing directory as an installed package, instead of copying the and links the existing directory as an installed package, instead of copying the
directory's content to install. Directory @tech{package sources} are treated as links directory's content to install. Directory @tech{package sources} are treated as links
@ -362,8 +370,6 @@ the given @nonterm{pkg-source}s.
@itemlist[ @itemlist[
@item{@DFlag{all} or @Flag{a} --- Update all packages, if no packages are given in the argument list.} @item{@DFlag{all} or @Flag{a} --- Update all packages, if no packages are given in the argument list.}
@item{@DFlag{update-deps} --- Checks dependencies (transitively) for updates.}
@item{@DFlag{lookup} --- Checks Causes a @tech{package name} as a @nonterm{pkg-source} to be used @item{@DFlag{lookup} --- Checks Causes a @tech{package name} as a @nonterm{pkg-source} to be used
as a replacement, instead of the name of a installed package that may have updates. as a replacement, instead of the name of a installed package that may have updates.
(If the named package was installed through a package name, then there's effectively (If the named package was installed through a package name, then there's effectively
@ -373,6 +379,8 @@ the given @nonterm{pkg-source}s.
@item{@DFlag{name} @nonterm{pkg} or @Flag{n} @nonterm{pkg} --- Same as for @command-ref{install}.} @item{@DFlag{name} @nonterm{pkg} or @Flag{n} @nonterm{pkg} --- Same as for @command-ref{install}.}
@item{@DFlag{deps} @nonterm{behavior} --- Same as for @command-ref{install}.} @item{@DFlag{deps} @nonterm{behavior} --- Same as for @command-ref{install}.}
@item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto} plus @DFlag{update-deps}.} @item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto} plus @DFlag{update-deps}.}
@item{@DFlag{update-deps} --- Same as for @command-ref{install}, but
implied by @DFlag{auto} only for @command-ref{update}.}
@item{@DFlag{link} --- Same as for @command-ref{install}.} @item{@DFlag{link} --- Same as for @command-ref{install}.}
@item{@DFlag{static-link} --- Same as for @command-ref{install}.} @item{@DFlag{static-link} --- Same as for @command-ref{install}.}
@item{@DFlag{binary} --- Same as for @command-ref{install}.} @item{@DFlag{binary} --- Same as for @command-ref{install}.}

View File

@ -1180,8 +1180,7 @@
#:skip-installed? skip-installed? #:skip-installed? skip-installed?
#:force? force? #:force? force?
#:quiet? quiet? #:quiet? quiet?
#:install-conversation install-conversation #:conversation conversation
#:update-conversation update-conversation
#:strip strip-mode #:strip strip-mode
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
descs) descs)
@ -1196,6 +1195,10 @@
(install-info pkg-name orig-pkg pkg-dir clean? checksum module-paths) (install-info pkg-name orig-pkg pkg-dir clean? checksum module-paths)
info) info)
(define name? (eq? 'catalog (first orig-pkg))) (define name? (eq? 'catalog (first orig-pkg)))
(define this-dep-behavior (or dep-behavior
(if name?
'search-ask
'fail)))
(define (clean!) (define (clean!)
(when clean? (when clean?
(delete-directory/files pkg-dir))) (delete-directory/files pkg-dir)))
@ -1207,7 +1210,7 @@
(car ud) (car ud)
(caddr ud) (caddr ud)
(cadddr ud)))))) (cadddr ud))))))
(define (show-dependencies deps update? auto? conversation) (define (show-dependencies deps update? auto?)
(unless quiet? (unless quiet?
(printf/flush "The following~a packages are listed as dependencies of ~a~a:~a\n" (printf/flush "The following~a packages are listed as dependencies of ~a~a:~a\n"
(if update? " out-of-date" " uninstalled") (if update? " out-of-date" " uninstalled")
@ -1323,11 +1326,7 @@
unsatisfied-deps))) unsatisfied-deps)))
=> =>
(λ (unsatisfied-deps) (λ (unsatisfied-deps)
(match (match this-dep-behavior
(or dep-behavior
(if name?
'search-ask
'fail))
['fail ['fail
(clean!) (clean!)
(pkg-error (~a "missing dependencies\n" (pkg-error (~a "missing dependencies\n"
@ -1336,22 +1335,23 @@
pkg pkg
(format-list unsatisfied-deps))] (format-list unsatisfied-deps))]
['search-auto ['search-auto
(show-dependencies unsatisfied-deps #f #t install-conversation) (show-dependencies unsatisfied-deps #f #t)
(raise (vector updating? infos unsatisfied-deps void 'always-yes update-conversation))] (raise (vector updating? infos unsatisfied-deps void 'always-yes))]
['search-ask ['search-ask
(show-dependencies unsatisfied-deps #f #f install-conversation) (show-dependencies unsatisfied-deps #f #f)
(case (if (eq? install-conversation 'always-yes) (case (if (eq? conversation 'always-yes)
'always-yes 'always-yes
(ask "Would you like to install these dependencies?")) (ask "Would you like to install these dependencies?"))
[(yes) [(yes)
(raise (vector updating? infos unsatisfied-deps void 'again update-conversation))] (raise (vector updating? infos unsatisfied-deps void 'again))]
[(always-yes) [(always-yes)
(raise (vector updating? infos unsatisfied-deps void 'always-yes update-conversation))] (raise (vector updating? infos unsatisfied-deps void 'always-yes))]
[(no) [(no)
(clean!) (clean!)
(pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))] (pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))]
[(and [(and
update-deps? update-deps?
(member this-dep-behavior '(search-auto search-ask))
(let () (let ()
(define deps (get-all-deps metadata-ns pkg-dir)) (define deps (get-all-deps metadata-ns pkg-dir))
(define update-pkgs (define update-pkgs
@ -1368,12 +1368,29 @@
null)) null))
deps)) deps))
(and (not (empty? update-pkgs)) (and (not (empty? update-pkgs))
update-pkgs))) update-pkgs
=> (lambda (update-pkgs) (let ()
(show-dependencies update-pkgs #t #f 'always-yes) (define (continue conversation)
(raise (vector #t infos update-pkgs (raise (vector #t infos update-pkgs
(λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs)) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs))
install-conversation update-conversation)))] conversation)))
(match this-dep-behavior
['search-auto
(show-dependencies update-pkgs #t #t)
(continue 'always-yes)]
['search-ask
(show-dependencies update-pkgs #t #f)
(case (if (eq? conversation 'always-yes)
'always-yes
(ask "Would you like to update these dependencies?"))
[(yes)
(continue 'again)]
[(always-yes)
(continue 'always-yes)]
[(no)
;; Don't fail --- just skip update
#f])])))))
(error "internal error: should have raised an exception")]
[(and [(and
(not (eq? dep-behavior 'force)) (not (eq? dep-behavior 'force))
(let () (let ()
@ -1443,25 +1460,22 @@
#:namespace metadata-ns) #:namespace metadata-ns)
update-pkgs)]) update-pkgs)])
(λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)))) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))))
(match (or dep-behavior (match this-dep-behavior
(if name?
'search-ask
'fail))
['fail ['fail
(clean!) (clean!)
(report-mismatch update-deps)] (report-mismatch update-deps)]
['search-auto ['search-auto
(show-dependencies update-deps #t #t update-conversation) (show-dependencies update-deps #t #t)
(raise (vector #t infos update-pkgs (make-pre-succeed) install-conversation 'always-yes))] (raise (vector #t infos update-pkgs (make-pre-succeed) 'always-yes))]
['search-ask ['search-ask
(show-dependencies update-deps #t #f update-conversation) (show-dependencies update-deps #t #f)
(case (if (eq? update-conversation 'always-yes) (case (if (eq? conversation 'always-yes)
'always-yes 'always-yes
(ask "Would you like to update these dependencies?")) (ask "Would you like to update these dependencies?"))
[(yes) [(yes)
(raise (vector #t infos update-pkgs (make-pre-succeed) install-conversation 'again))] (raise (vector #t infos update-pkgs (make-pre-succeed) 'again))]
[(always-yes) [(always-yes)
(raise (vector #t infos update-pkgs (make-pre-succeed) install-conversation 'always-yes))] (raise (vector #t infos update-pkgs (make-pre-succeed) 'always-yes))]
[(no) [(no)
(clean!) (clean!)
(report-mismatch update-deps)])]))] (report-mismatch update-deps)])]))]
@ -1643,8 +1657,7 @@
#:update-cache [update-cache (make-hash)] #:update-cache [update-cache (make-hash)]
#:updating? [updating? #f] #:updating? [updating? #f]
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
#:install-conversation [install-conversation #f] #:conversation [conversation #f]
#:update-conversation [update-conversation #f]
#:strip [strip-mode #f] #:strip [strip-mode #f]
#:link-dirs? [link-dirs? #f]) #:link-dirs? [link-dirs? #f])
(define new-descs (define new-descs
@ -1663,7 +1676,7 @@
pkg-desc=?)) pkg-desc=?))
(with-handlers* ([vector? (with-handlers* ([vector?
(match-lambda (match-lambda
[(vector updating? new-infos deps more-pre-succeed inst-conv updt-conv) [(vector updating? new-infos deps more-pre-succeed conv)
(pkg-install (pkg-install
#:old-infos new-infos #:old-infos new-infos
#:old-auto+pkgs (append old-descs new-descs) #:old-auto+pkgs (append old-descs new-descs)
@ -1674,8 +1687,7 @@
#:update-cache update-cache #:update-cache update-cache
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed)) #:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
#:updating? updating? #:updating? updating?
#:install-conversation inst-conv #:conversation conv
#:update-conversation updt-conv
#:strip strip-mode #:strip strip-mode
(for/list ([dep (in-list deps)]) (for/list ([dep (in-list deps)])
(if (pkg-desc? dep) (if (pkg-desc? dep)
@ -1693,8 +1705,7 @@
#:pre-succeed pre-succeed #:pre-succeed pre-succeed
#:updating? updating? #:updating? updating?
#:quiet? quiet? #:quiet? quiet?
#:install-conversation install-conversation #:conversation conversation
#:update-conversation update-conversation
#:strip strip-mode #:strip strip-mode
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
new-descs))) new-descs)))
@ -1828,7 +1839,7 @@
#:dep-behavior [dep-behavior #f] #:dep-behavior [dep-behavior #f]
#:force? [force? #f] #:force? [force? #f]
#:ignore-checksums? [ignore-checksums? #f] #:ignore-checksums? [ignore-checksums? #f]
#:deps? [update-deps? #f] #:update-deps? [update-deps? #f]
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
#:strip [strip-mode #f] #:strip [strip-mode #f]
#:link-dirs? [link-dirs? #f]) #:link-dirs? [link-dirs? #f])
@ -2652,7 +2663,7 @@
(->* ((listof (or/c string? pkg-desc?))) (->* ((listof (or/c string? pkg-desc?)))
(#:dep-behavior dep-behavior/c (#:dep-behavior dep-behavior/c
#:all? boolean? #:all? boolean?
#:deps? boolean? #:update-deps? boolean?
#:quiet? boolean? #:quiet? boolean?
#:force? boolean? #:force? boolean?
#:ignore-checksums? boolean? #:ignore-checksums? boolean?
@ -2674,6 +2685,7 @@
[pkg-install [pkg-install
(->* ((listof pkg-desc?)) (->* ((listof pkg-desc?))
(#:dep-behavior dep-behavior/c (#:dep-behavior dep-behavior/c
#:update-deps? boolean?
#:force? boolean? #:force? boolean?
#:ignore-checksums? boolean? #:ignore-checksums? boolean?
#:skip-installed? boolean? #:skip-installed? boolean?

View File

@ -96,6 +96,7 @@
#:install-dep-flags (install-dep-flags ...) #:install-dep-flags (install-dep-flags ...)
#:install-dep-desc (install-dep-desc ...) #:install-dep-desc (install-dep-desc ...)
#:install-force-flags (install-force-flags ...) #:install-force-flags (install-force-flags ...)
#:update-deps-flags (update-deps-flags ...)
#:install-copy-flags (install-copy-flags ...) #:install-copy-flags (install-copy-flags ...)
#:install-copy-defns (install-copy-defns ...)) #:install-copy-defns (install-copy-defns ...))
(with-syntax ([([scope-flags ...] (with-syntax ([([scope-flags ...]
@ -104,6 +105,7 @@
[install-type-flags ...] [install-type-flags ...]
[(install-dep-flags ... (dep-desc ...))] [(install-dep-flags ... (dep-desc ...))]
[install-force-flags ...] [install-force-flags ...]
[update-deps-flags ...]
[install-copy-flags ...] [install-copy-flags ...]
[install-copy-defns ...]) [install-copy-defns ...])
(syntax-local-introduce #'([scope-flags ...] (syntax-local-introduce #'([scope-flags ...]
@ -112,6 +114,7 @@
[install-type-flags ...] [install-type-flags ...]
[install-dep-flags ...] [install-dep-flags ...]
[install-force-flags ...] [install-force-flags ...]
[update-deps-flags ...]
[install-copy-flags ...] [install-copy-flags ...]
[install-copy-defns ...]))]) [install-copy-defns ...]))])
#`(commands #`(commands
@ -127,6 +130,8 @@
(dep-desc ... (dep-desc ...
install-dep-desc ...)] install-dep-desc ...)]
[#:bool auto () "Shorthand for `--deps search-auto'"] [#:bool auto () "Shorthand for `--deps search-auto'"]
#:once-each
update-deps-flags ...
#:once-any #:once-any
install-copy-flags ... install-copy-flags ...
#:once-any #:once-any
@ -152,6 +157,7 @@
#:force? force #:force? force
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:skip-installed? skip-installed #:skip-installed? skip-installed
#:update-deps? update-deps
#:strip (or (and source 'source) (and binary 'binary)) #:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
(for/list ([p (in-list pkg-source)]) (for/list ([p (in-list pkg-source)])
@ -162,7 +168,6 @@
"Update packages" "Update packages"
#:once-each #:once-each
[#:bool all ("-a") ("Update all packages if no <pkg-source> is given")] [#:bool all ("-a") ("Update all packages if no <pkg-source> is given")]
[#:bool update-deps () "Also update all dependencies"]
[#:bool lookup () "For each name <pkg-source>, look up in catalog"] [#:bool lookup () "For each name <pkg-source>, look up in catalog"]
#:once-any #:once-any
install-type-flags ... install-type-flags ...
@ -171,6 +176,8 @@
(dep-desc ... (dep-desc ...
install-dep-desc ...)] install-dep-desc ...)]
[#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"] [#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"]
#:once-each
update-deps-flags ...
#:once-any #:once-any
install-copy-flags ... install-copy-flags ...
#:once-any #:once-any
@ -203,7 +210,7 @@
#:dep-behavior (if auto 'search-auto deps) #:dep-behavior (if auto 'search-auto deps)
#:force? force #:force? force
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:deps? (or update-deps auto) #:update-deps? (or update-deps auto)
#:strip (or (and source 'source) (and binary 'binary)) #:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs?)))) #:link-dirs? link-dirs?))))
(setup no-setup setup-collects jobs)))] (setup no-setup setup-collects jobs)))]
@ -432,6 +439,8 @@
#:install-force-flags #:install-force-flags
([#:bool force () "Ignores conflicts"] ([#:bool force () "Ignores conflicts"]
[#:bool ignore-checksums () "Ignores checksums"]) [#:bool ignore-checksums () "Ignores checksums"])
#:update-deps-flags
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"])
#:install-copy-flags #:install-copy-flags
([#:bool link () ("Link a directory package source in place (default for a directory)")] ([#:bool link () ("Link a directory package source in place (default for a directory)")]
[#:bool static-link () ("Link in place, promising collections do not change")] [#:bool static-link () ("Link in place, promising collections do not change")]