From ccead828416482eab69e773de3109cab437f36d2 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 20 Aug 2013 10:49:56 -0600 Subject: [PATCH] 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. --- .../racket-doc/pkg/scribblings/lib.scrbl | 5 +- .../racket-doc/pkg/scribblings/pkg.scrbl | 20 +++-- racket/collects/pkg/lib.rkt | 90 +++++++++++-------- racket/collects/pkg/main.rkt | 13 ++- 4 files changed, 79 insertions(+), 49 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 3cb5d59e0a..dbaaf05515 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -167,6 +167,7 @@ Unless @racket[quiet?] is true, information about the output is repotred to the [#:dep-behavior dep-behavior (or/c #f 'fail 'force 'search-ask 'search-auto) #f] + [#:update-deps? update-deps? boolean? #f] [#:force? force? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #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?))] + [#:all? all? boolean? #f] [#:dep-behavior dep-behavior (or/c #f 'fail 'force 'search-ask 'search-auto) #f] - [#:all? all? boolean? #f] - [#:deps? deps? boolean? #f] + [#:update-deps? update-deps? boolean? #f] [#:force? force? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f] [#:quiet? boolean? quiet? #f] diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 9899dffc27..582a9e115a 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -283,15 +283,23 @@ sub-commands. @item{@DFlag{deps} @nonterm{behavior} --- Selects the behavior for dependencies, where @nonterm{behavior} is one of @itemlist[ - @item{@exec{fail} --- Cancels the installation if dependencies are version requirements are unmet (default for most packages)} - @item{@exec{force} --- Installs the package(s) despite missing dependencies or version requirements (unsafe)} - @item{@exec{search-ask} --- Looks for the dependencies or updates via the configured @tech{package catalogs} - (default if the dependency is a @tech{package name}) but asks if you would like it installed or updated.} + @item{@exec{fail} --- Cancels the installation if dependencies are uninstalled or version requirements are unmet. + This behavior is the default for a @nonterm{pkg-source} that is not a @tech{package name}.} + @item{@exec{force} --- Installs the package(s) despite missing dependencies or version requirements (unsafe).} + @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{@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), 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 @@ -362,8 +370,6 @@ the given @nonterm{pkg-source}s. @itemlist[ @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 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 @@ -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{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{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{static-link} --- Same as for @command-ref{install}.} @item{@DFlag{binary} --- Same as for @command-ref{install}.} diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 9034896a6b..c63d558255 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -1180,8 +1180,7 @@ #:skip-installed? skip-installed? #:force? force? #:quiet? quiet? - #:install-conversation install-conversation - #:update-conversation update-conversation + #:conversation conversation #:strip strip-mode #:link-dirs? link-dirs? descs) @@ -1196,6 +1195,10 @@ (install-info pkg-name orig-pkg pkg-dir clean? checksum module-paths) info) (define name? (eq? 'catalog (first orig-pkg))) + (define this-dep-behavior (or dep-behavior + (if name? + 'search-ask + 'fail))) (define (clean!) (when clean? (delete-directory/files pkg-dir))) @@ -1207,7 +1210,7 @@ (car ud) (caddr ud) (cadddr ud)))))) - (define (show-dependencies deps update? auto? conversation) + (define (show-dependencies deps update? auto?) (unless quiet? (printf/flush "The following~a packages are listed as dependencies of ~a~a:~a\n" (if update? " out-of-date" " uninstalled") @@ -1323,11 +1326,7 @@ unsatisfied-deps))) => (λ (unsatisfied-deps) - (match - (or dep-behavior - (if name? - 'search-ask - 'fail)) + (match this-dep-behavior ['fail (clean!) (pkg-error (~a "missing dependencies\n" @@ -1336,22 +1335,23 @@ pkg (format-list unsatisfied-deps))] ['search-auto - (show-dependencies unsatisfied-deps #f #t install-conversation) - (raise (vector updating? infos unsatisfied-deps void 'always-yes update-conversation))] + (show-dependencies unsatisfied-deps #f #t) + (raise (vector updating? infos unsatisfied-deps void 'always-yes))] ['search-ask - (show-dependencies unsatisfied-deps #f #f install-conversation) - (case (if (eq? install-conversation 'always-yes) + (show-dependencies unsatisfied-deps #f #f) + (case (if (eq? conversation 'always-yes) 'always-yes (ask "Would you like to install these dependencies?")) [(yes) - (raise (vector updating? infos unsatisfied-deps void 'again update-conversation))] + (raise (vector updating? infos unsatisfied-deps void 'again))] [(always-yes) - (raise (vector updating? infos unsatisfied-deps void 'always-yes update-conversation))] + (raise (vector updating? infos unsatisfied-deps void 'always-yes))] [(no) (clean!) (pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))] [(and update-deps? + (member this-dep-behavior '(search-auto search-ask)) (let () (define deps (get-all-deps metadata-ns pkg-dir)) (define update-pkgs @@ -1368,12 +1368,29 @@ null)) deps)) (and (not (empty? update-pkgs)) - update-pkgs))) - => (lambda (update-pkgs) - (show-dependencies update-pkgs #t #f 'always-yes) - (raise (vector #t infos update-pkgs - (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs)) - install-conversation update-conversation)))] + update-pkgs + (let () + (define (continue conversation) + (raise (vector #t infos update-pkgs + (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs)) + 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 (not (eq? dep-behavior 'force)) (let () @@ -1443,25 +1460,22 @@ #:namespace metadata-ns) update-pkgs)]) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)))) - (match (or dep-behavior - (if name? - 'search-ask - 'fail)) + (match this-dep-behavior ['fail (clean!) (report-mismatch update-deps)] ['search-auto - (show-dependencies update-deps #t #t update-conversation) - (raise (vector #t infos update-pkgs (make-pre-succeed) install-conversation 'always-yes))] + (show-dependencies update-deps #t #t) + (raise (vector #t infos update-pkgs (make-pre-succeed) 'always-yes))] ['search-ask - (show-dependencies update-deps #t #f update-conversation) - (case (if (eq? update-conversation 'always-yes) + (show-dependencies update-deps #t #f) + (case (if (eq? conversation 'always-yes) 'always-yes (ask "Would you like to update these dependencies?")) [(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) - (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) (clean!) (report-mismatch update-deps)])]))] @@ -1643,8 +1657,7 @@ #:update-cache [update-cache (make-hash)] #:updating? [updating? #f] #:quiet? [quiet? #f] - #:install-conversation [install-conversation #f] - #:update-conversation [update-conversation #f] + #:conversation [conversation #f] #:strip [strip-mode #f] #:link-dirs? [link-dirs? #f]) (define new-descs @@ -1663,7 +1676,7 @@ pkg-desc=?)) (with-handlers* ([vector? (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 #:old-infos new-infos #:old-auto+pkgs (append old-descs new-descs) @@ -1674,8 +1687,7 @@ #:update-cache update-cache #:pre-succeed (lambda () (pre-succeed) (more-pre-succeed)) #:updating? updating? - #:install-conversation inst-conv - #:update-conversation updt-conv + #:conversation conv #:strip strip-mode (for/list ([dep (in-list deps)]) (if (pkg-desc? dep) @@ -1693,8 +1705,7 @@ #:pre-succeed pre-succeed #:updating? updating? #:quiet? quiet? - #:install-conversation install-conversation - #:update-conversation update-conversation + #:conversation conversation #:strip strip-mode #:link-dirs? link-dirs? new-descs))) @@ -1828,7 +1839,7 @@ #:dep-behavior [dep-behavior #f] #:force? [force? #f] #:ignore-checksums? [ignore-checksums? #f] - #:deps? [update-deps? #f] + #:update-deps? [update-deps? #f] #:quiet? [quiet? #f] #:strip [strip-mode #f] #:link-dirs? [link-dirs? #f]) @@ -2652,7 +2663,7 @@ (->* ((listof (or/c string? pkg-desc?))) (#:dep-behavior dep-behavior/c #:all? boolean? - #:deps? boolean? + #:update-deps? boolean? #:quiet? boolean? #:force? boolean? #:ignore-checksums? boolean? @@ -2674,6 +2685,7 @@ [pkg-install (->* ((listof pkg-desc?)) (#:dep-behavior dep-behavior/c + #:update-deps? boolean? #:force? boolean? #:ignore-checksums? boolean? #:skip-installed? boolean? diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 95598e20a2..4e251e44bf 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -96,6 +96,7 @@ #:install-dep-flags (install-dep-flags ...) #:install-dep-desc (install-dep-desc ...) #:install-force-flags (install-force-flags ...) + #:update-deps-flags (update-deps-flags ...) #:install-copy-flags (install-copy-flags ...) #:install-copy-defns (install-copy-defns ...)) (with-syntax ([([scope-flags ...] @@ -104,6 +105,7 @@ [install-type-flags ...] [(install-dep-flags ... (dep-desc ...))] [install-force-flags ...] + [update-deps-flags ...] [install-copy-flags ...] [install-copy-defns ...]) (syntax-local-introduce #'([scope-flags ...] @@ -112,6 +114,7 @@ [install-type-flags ...] [install-dep-flags ...] [install-force-flags ...] + [update-deps-flags ...] [install-copy-flags ...] [install-copy-defns ...]))]) #`(commands @@ -127,6 +130,8 @@ (dep-desc ... install-dep-desc ...)] [#:bool auto () "Shorthand for `--deps search-auto'"] + #:once-each + update-deps-flags ... #:once-any install-copy-flags ... #:once-any @@ -152,6 +157,7 @@ #:force? force #:ignore-checksums? ignore-checksums #:skip-installed? skip-installed + #:update-deps? update-deps #:strip (or (and source 'source) (and binary 'binary)) #:link-dirs? link-dirs? (for/list ([p (in-list pkg-source)]) @@ -162,7 +168,6 @@ "Update packages" #:once-each [#:bool all ("-a") ("Update all packages if no is given")] - [#:bool update-deps () "Also update all dependencies"] [#:bool lookup () "For each name , look up in catalog"] #:once-any install-type-flags ... @@ -171,6 +176,8 @@ (dep-desc ... install-dep-desc ...)] [#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"] + #:once-each + update-deps-flags ... #:once-any install-copy-flags ... #:once-any @@ -203,7 +210,7 @@ #:dep-behavior (if auto 'search-auto deps) #:force? force #:ignore-checksums? ignore-checksums - #:deps? (or update-deps auto) + #:update-deps? (or update-deps auto) #:strip (or (and source 'source) (and binary 'binary)) #:link-dirs? link-dirs?)))) (setup no-setup setup-collects jobs)))] @@ -432,6 +439,8 @@ #:install-force-flags ([#:bool force () "Ignores conflicts"] [#:bool ignore-checksums () "Ignores checksums"]) + #:update-deps-flags + ([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]) #:install-copy-flags ([#:bool link () ("Link a directory package source in place (default for a directory)")] [#:bool static-link () ("Link in place, promising collections do not change")]