raco pkg update: allow packages sources as replacements
When an argument to `raco pkg update` is a package source, use it to place the currently installed package. Also, make the set of available command-line arguments more consistent, especially for `raco pkg install` and `raco pkg update`. Finally, fix the `--update-deps` flag, including checking the dependencies of each updated packages based on then update, instead of the pre-updated package.
This commit is contained in:
Matthew Flatt
parent
6baf90e3be
commit
72a4191aa9
|
|
@ -86,7 +86,7 @@ package:
|
|||
The ``Checksum'' column reports the specific ``version'' of each
|
||||
package that is installed. A package can have a @tech{version} in a
|
||||
more traditional sense, but the @tech{checksum} is the ``version'' as
|
||||
far as the package system is concerned. When you request an upgrade,
|
||||
far as the package system is concerned. When you request an update,
|
||||
then a package installation is updated if the current implementation
|
||||
of the package has a different @tech{checksum} than the installed
|
||||
package, whether or not the package author adjusted the package's
|
||||
|
|
@ -194,7 +194,7 @@ actual package implementation, so each package installed from a
|
|||
@tech{package catalog} is actually installed from a @filepath{.zip}
|
||||
file, Github repository, etc. Registering with a @tech{package
|
||||
catalog} is just a way of making your package easier to find and
|
||||
upgrade.
|
||||
update.
|
||||
|
||||
@; ----------------------------------------
|
||||
|
||||
|
|
@ -226,6 +226,14 @@ those dependencies. The end result is that @command-ref{update} might
|
|||
report a version-mismatch error that forces you to request more
|
||||
package updates than you originally requested.
|
||||
|
||||
Normally, you provide @tech{package names} to
|
||||
@command-ref{update}. More generally, you can provide a @tech{package
|
||||
source} to @command-ref{update}. In that case, a package with the same
|
||||
name must be installed already, and the installed package is replaced
|
||||
with the specified one. Replacing a package with a new @tech{package
|
||||
source} is a generalization of fetching a replacement package that has
|
||||
a new @tech{checksum} at a previously specified source.
|
||||
|
||||
@; ----------------------------------------
|
||||
|
||||
@section[#:tag "how-to-create"]{Creating Packages}
|
||||
|
|
|
|||
|
|
@ -195,14 +195,17 @@ port, unless @racket[quiet?] is true.
|
|||
The package lock must be held; see @racket[with-pkg-lock].}
|
||||
|
||||
|
||||
@defproc[(pkg-update [names (listof string?)]
|
||||
@defproc[(pkg-update [names (listof (or/c string? pkg-desc?))]
|
||||
[#:dep-behavior dep-behavior
|
||||
(or/c #f 'fail 'force 'search-ask 'search-auto)
|
||||
#f]
|
||||
[#:all? all? boolean? #f]
|
||||
[#:deps? deps? boolean? #f]
|
||||
[#:force? force? boolean? #f]
|
||||
[#:ignore-checksums? ignore-checksums? boolean? #f]
|
||||
[#:quiet? boolean? quiet? #f]
|
||||
[#:strip strip (or/c #f 'source 'binary) #f])
|
||||
[#:strip strip (or/c #f 'source 'binary) #f]
|
||||
[#:link-dirs? link-dirs? boolean? #f])
|
||||
(or/c 'skip
|
||||
#f
|
||||
(listof (or/c path-string?
|
||||
|
|
@ -211,6 +214,10 @@ The package lock must be held; see @racket[with-pkg-lock].}
|
|||
Implements @racket[pkg-update-command]. The result is the same as for
|
||||
@racket[pkg-install].
|
||||
|
||||
A string in @racket[names] refers to an installed package that should
|
||||
be checked for updates. A @racket[pkg-desc] in @racket[names] indicates
|
||||
a package source that should replace the current installation.
|
||||
|
||||
The package lock must be held; see @racket[with-pkg-lock].}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -291,10 +291,6 @@ sub-commands.
|
|||
|
||||
@item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto}.}
|
||||
|
||||
@item{@DFlag{force} --- Ignores conflicts (unsafe).}
|
||||
|
||||
@item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).}
|
||||
|
||||
@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
|
||||
|
|
@ -317,10 +313,6 @@ sub-commands.
|
|||
|
||||
@item{@DFlag{source} --- Strips built elements of a package before installing, and implies @DFlag{copy}.}
|
||||
|
||||
@item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source}
|
||||
whose name corresponds to an already-installed package, except for promoting auto-installed
|
||||
packages to explicitly installed.}
|
||||
|
||||
@item{@DFlag{scope} @nonterm{scope} --- Selects the @tech{package scope} for installation, where @nonterm{scope} is one of
|
||||
@itemlist[
|
||||
@item{@exec{installation} --- Install packages for all users of a Racket installation, rather than user-specific.}
|
||||
|
|
@ -337,6 +329,14 @@ sub-commands.
|
|||
@item{@DFlag{catalog} @nonterm{catalog} --- Use @nonterm{catalog} instead of of the currently configured
|
||||
@tech{package catalogs}.}
|
||||
|
||||
@item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source}
|
||||
whose name corresponds to an already-installed package, except for promoting auto-installed
|
||||
packages to explicitly installed.}
|
||||
|
||||
@item{@DFlag{force} --- Ignores conflicts (unsafe).}
|
||||
|
||||
@item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).}
|
||||
|
||||
@item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the
|
||||
environment variable @envvar{PLT_PKG_NOSETUP} is set to any non-empty value.}
|
||||
|
||||
|
|
@ -345,31 +345,46 @@ sub-commands.
|
|||
|
||||
|
||||
|
||||
@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg} ...
|
||||
--- Checks the specified packages for
|
||||
@tech{package updates}. If an update is found, but it cannot be
|
||||
installed (e.g. it conflicts with another installed package), then
|
||||
this command fails without installing any of the @nonterm{pkg}s
|
||||
(or their dependencies).
|
||||
@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ...
|
||||
--- Checks the specified package names for @tech{package updates} or
|
||||
replaces existing package installations with the given sources. If an
|
||||
update or replacement cannot be installed (e.g. it conflicts with
|
||||
another installed package), then this command fails without installing
|
||||
any of the @nonterm{pkg-source}s (or their dependencies).
|
||||
|
||||
If a @tech{package scope} is not specified, the scope is inferred from
|
||||
the given @nonterm{pkg}s.
|
||||
the given @nonterm{pkg-source}s.
|
||||
|
||||
The @exec{update} sub-command accepts
|
||||
the following @nonterm{option}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 the named packages plus their dependencies (transitively) for updates.}
|
||||
|
||||
@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
|
||||
no difference.)}
|
||||
|
||||
@item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} --- 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{auto} --- Shorthand for @exec{@DFlag{deps} search-auto} plus @DFlag{update-deps}.}
|
||||
@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}.}
|
||||
@item{@DFlag{copy} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{source} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@DFlag{catalog} @nonterm{catalog} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{force} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{binary} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{source} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||
]
|
||||
}
|
||||
|
|
@ -390,7 +405,8 @@ the given @nonterm{pkg}s.
|
|||
(leaving auto-installed packages as such). Combined with @DFlag{auto}, removes
|
||||
packages for which there are no dependencies.}
|
||||
@item{@DFlag{force} --- Ignore dependencies when removing packages.}
|
||||
@item{@DFlag{auto} --- Remove auto-installed packages (i.e., installed by the @exec{search-auto} or @exec{search-ask}
|
||||
@item{@DFlag{auto} --- In addition to removing each @nonterm{pkg},
|
||||
remove auto-installed packages (i.e., installed by the @exec{search-auto} or @exec{search-ask}
|
||||
dependency behavior, or demoted via @DFlag{demote}) that are no longer required by any
|
||||
explicitly installed package.}
|
||||
@item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.}
|
||||
|
|
@ -440,8 +456,6 @@ the given @nonterm{pkg}s.
|
|||
|
||||
@item{@DFlag{deps} @nonterm{behavior} --- Same as for @command-ref{install}, except that @exec{search-auto} is
|
||||
the default.}
|
||||
@item{@DFlag{force} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{binary} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{source} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{scope} @nonterm{scope} --- Same as for @command-ref{install}.}
|
||||
|
|
@ -449,6 +463,8 @@ the given @nonterm{pkg}s.
|
|||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Select @nonterm{dir} as the @tech{package scope}.}
|
||||
@item{@DFlag{catalog} @nonterm{catalog} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{force} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||
]
|
||||
|
|
@ -497,9 +513,10 @@ View and modify configuration of the package manager itself, with the following
|
|||
as the default value at @exec{user} scope.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Same as for @command-ref{install}.}
|
||||
]
|
||||
|
||||
The valid keys are:
|
||||
The valid @nonterm{key}s are:
|
||||
@itemlist[
|
||||
@item{@exec{catalogs} --- A list of URLs for @tech{package catalogs}.}
|
||||
@item{@exec{default-scope} --- Either @exec{installation} or @exec{user}.
|
||||
|
|
@ -530,7 +547,8 @@ View and modify configuration of the package manager itself, with the following
|
|||
@item{@DFlag{modules} --- Show the modules that are implemented by a package.}
|
||||
@item{@DFlag{catalog} @nonterm{catalog} --- Query @nonterm{catalog} instead of the currently configured
|
||||
@tech{package catalogs}.}
|
||||
@item{@DFlag{version} @nonterm{version} --- Query catalogs for a result specific to @nonterm{version},
|
||||
@item{@DFlag{version} @nonterm{version} or @Flag{v} @nonterm{version} --- Query catalogs
|
||||
for a result specific to @nonterm{version},
|
||||
instead of the installation's Racket version.}
|
||||
]
|
||||
}
|
||||
|
|
@ -559,7 +577,8 @@ View and modify configuration of the package manager itself, with the following
|
|||
over new information.}
|
||||
@item{@DFlag{override} --- Changes merging so that new information takes precedence
|
||||
over information already in @nonterm{dest-catalog}.}
|
||||
@item{@DFlag{version} @nonterm{version} --- Copy catalog results specific to @nonterm{version}
|
||||
@item{@DFlag{version} @nonterm{version} or @Flag{v} @nonterm{version} --- Copy catalog
|
||||
results specific to @nonterm{version}
|
||||
(for catalogs that make a distinction), instead of the installation's Racket version.}
|
||||
]
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket/base
|
||||
|
||||
(printf "pkg-test3/main loaded\n")
|
||||
(printf "pkg-test3/main version 3 loaded\n")
|
||||
(exit 0)
|
||||
|
|
|
|||
|
|
@ -44,6 +44,7 @@
|
|||
(shelly-create "racket-conflict" "tgz")
|
||||
(shelly-create "pkg-test3" "zip")
|
||||
(shelly-create "pkg-test3-v2" "zip")
|
||||
(shelly-create "pkg-test3-v3" "zip")
|
||||
|
||||
$ "raco pkg create --format txt test-pkgs/pkg-test1" =exit> 1
|
||||
|
||||
|
|
|
|||
|
|
@ -25,6 +25,31 @@
|
|||
(shelly-install "local packages can't be updated (directory)"
|
||||
"test-pkgs/pkg-test1/"
|
||||
$ "raco pkg update pkg-test1" =exit> 1)
|
||||
(shelly-wind
|
||||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
(shelly-install* "packages can be replaced with local packages (file)"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(finally
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip"))
|
||||
(shelly-install "packages can be replaced with local packages (file + name)"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update --name pkg-test1 test-pkgs/pkg-test1-v2.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(shelly-install "packages can be replaced with local packages (directory)"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update --name pkg-test1 test-pkgs/pkg-test1-v2"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(shelly-install "replacement checksum can be checked"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "raco pkg update test-pkgs/pkg-test1.zip" =stdout> "No updates available\n")
|
||||
|
||||
(shelly-wind
|
||||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
|
|
@ -32,7 +57,7 @@
|
|||
(shelly-install* "remote packages can be updated"
|
||||
"http://localhost:9999/update-test/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "raco pkg update pkg-test1" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
|
||||
$ "raco pkg update pkg-test1" =exit> 0 =stdout> "Downloading checksum for pkg-test1\nNo updates available\n"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
|
|
@ -49,7 +74,7 @@
|
|||
(shelly-install* "remote packages can be updated, single-collection to multi-collection"
|
||||
"test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip"
|
||||
"pkg-test1 pkg-test3"
|
||||
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
|
||||
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum for pkg-test3\nNo updates available\n"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update pkg-test3" =exit> 0
|
||||
|
|
@ -65,7 +90,7 @@
|
|||
(shelly-install* "remote packages can be updated, multi-colelction to single-collection"
|
||||
"test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip"
|
||||
"pkg-test1 pkg-test3"
|
||||
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
|
||||
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum for pkg-test3\nNo updates available\n"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update pkg-test3" =exit> 0
|
||||
|
|
@ -78,11 +103,14 @@
|
|||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "cp -f test-pkgs/pkg-test2.zip test-pkgs/update-test/pkg-test2.zip"
|
||||
$ "cp -f test-pkgs/pkg-test2.zip.CHECKSUM test-pkgs/update-test/pkg-test2.zip.CHECKSUM"
|
||||
(shelly-install* "update deps"
|
||||
"http://localhost:9999/update-test/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip"
|
||||
$ "raco pkg update --update-deps pkg-test2" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
|
||||
$ "raco pkg install http://localhost:9999/update-test/pkg-test2.zip"
|
||||
$ "raco pkg update --update-deps pkg-test2" =exit> 0
|
||||
=stdout> "Downloading checksum for pkg-test2\nDownloading checksum for pkg-test1\nNo updates available\n"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
|
|
@ -97,11 +125,87 @@
|
|||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
(shelly-install* "update all is default"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
(shelly-install* "update original and deps"
|
||||
"http://localhost:9999/update-test/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip"
|
||||
$ "raco pkg update --update-deps pkg-test3" =exit> 0
|
||||
=stdout> "Downloading checksum for pkg-test3\nDownloading checksum for pkg-test1\nNo updates available\n"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update --update-deps pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> #rx"version 2 loaded"
|
||||
$ "raco pkg remove pkg-test3")
|
||||
(finally
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM"))
|
||||
|
||||
(shelly-wind
|
||||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
(shelly-install* "update original, where update has no deps"
|
||||
"http://localhost:9999/update-test/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip"
|
||||
$ "raco pkg update --update-deps pkg-test3" =exit> 0
|
||||
=stdout> "Downloading checksum for pkg-test3\nDownloading checksum for pkg-test1\nNo updates available\n"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "cp -f test-pkgs/pkg-test3-v3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3-v3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update --update-deps pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> #rx"version 3 loaded"
|
||||
$ "raco pkg remove pkg-test3")
|
||||
(finally
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM"))
|
||||
|
||||
(shelly-wind
|
||||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "cp -f test-pkgs/pkg-test3-v3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3-v3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
(shelly-install* "update and get updates for newly introduced deps"
|
||||
"http://localhost:9999/update-test/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip"
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> #rx"version 3 loaded"
|
||||
$ "raco pkg update --update-deps pkg-test3" =exit> 0
|
||||
=stdout> "Downloading checksum for pkg-test3\nNo updates available\n"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update --update-deps pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> #rx"main loaded"
|
||||
$ "raco pkg remove pkg-test3")
|
||||
(finally
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM"))
|
||||
|
||||
(shelly-wind
|
||||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
(shelly-install* "update all"
|
||||
"http://localhost:9999/update-test/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip"
|
||||
$ "raco pkg update -a" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
|
||||
$ "raco pkg update -a" =exit> 0 =stdout> "Downloading checksum for pkg-test1\nNo updates available\n"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
|
|
|
|||
|
|
@ -412,13 +412,26 @@
|
|||
(hash 'source (db:pkg-source pkg)
|
||||
'checksum (db:pkg-source pkg))))
|
||||
|
||||
(define (remote-package-checksum pkg download-printf)
|
||||
(define (remote-package-checksum pkg download-printf pkg-name)
|
||||
(match pkg
|
||||
[`(catalog ,pkg-name)
|
||||
(hash-ref (package-catalog-lookup pkg-name #f download-printf) 'checksum)]
|
||||
[`(url ,pkg-url-str)
|
||||
(package-url->checksum pkg-url-str
|
||||
#:download-printf download-printf)]))
|
||||
#:download-printf download-printf
|
||||
#:pkg-name pkg-name)]))
|
||||
|
||||
(define (checksum-for-pkg-source pkg-source type pkg-name download-printf)
|
||||
(cond
|
||||
[(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github))
|
||||
(remote-package-checksum `(url ,pkg-source) download-printf pkg-name)]
|
||||
[(eq? type 'file)
|
||||
(define checksum-pth (format "~a.CHECKSUM" pkg-source))
|
||||
(or (and (file-exists? checksum-pth)
|
||||
(file->string checksum-pth))
|
||||
(and (file-exists? pkg-source)
|
||||
(call-with-input-file* pkg-source sha1)))]
|
||||
[else #f]))
|
||||
|
||||
(define (write-file-hash! file new-db)
|
||||
(unless (eq? (pkg-lock-held) 'exclusive)
|
||||
|
|
@ -825,7 +838,7 @@
|
|||
|
||||
(define orig-pkg `(url ,pkg))
|
||||
(define checksum (or given-checksum
|
||||
(remote-package-checksum orig-pkg download-printf)))
|
||||
(remote-package-checksum orig-pkg download-printf pkg-name)))
|
||||
(define info
|
||||
(update-install-info-orig-pkg
|
||||
(match type
|
||||
|
|
@ -1158,6 +1171,8 @@
|
|||
#:old-descs [old-descs empty]
|
||||
#:pre-succeed [pre-succeed void]
|
||||
#:dep-behavior [dep-behavior #f]
|
||||
#:update-deps? [update-deps? #f]
|
||||
#:update-cache [update-cache #f]
|
||||
#:updating? [updating? #f]
|
||||
#:ignore-checksums? [ignore-checksums? #f]
|
||||
#:skip-installed? [skip-installed? #f]
|
||||
|
|
@ -1184,14 +1199,16 @@
|
|||
(delete-directory/files pkg-dir)))
|
||||
(define (format-deps update-deps)
|
||||
(format-list (for/list ([ud (in-list update-deps)])
|
||||
(format "~a (have ~a, need ~a)"
|
||||
(car ud)
|
||||
(caddr ud)
|
||||
(cadddr ud)))))
|
||||
(if (pkg-desc? ud)
|
||||
(pkg-desc-name ud)
|
||||
(format "~a (have ~a, need ~a)"
|
||||
(car ud)
|
||||
(caddr ud)
|
||||
(cadddr ud))))))
|
||||
(define (show-dependencies deps update? auto? conversation)
|
||||
(unless quiet?
|
||||
(printf/flush "The following ~a packages are listed as dependencies of ~a~a:~a\n"
|
||||
(if update? "out-of-date" "uninstalled")
|
||||
(printf/flush "The following~a packages are listed as dependencies of ~a~a:~a\n"
|
||||
(if update? " out-of-date" " uninstalled")
|
||||
pkg-name
|
||||
(if (or auto? (eq? conversation 'always-yes))
|
||||
(format "\nand they will be ~a~a"
|
||||
|
|
@ -1331,6 +1348,30 @@
|
|||
[(no)
|
||||
(clean!)
|
||||
(pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))]
|
||||
[(and
|
||||
update-deps?
|
||||
(let ()
|
||||
(define deps (get-all-deps metadata-ns pkg-dir))
|
||||
(define update-pkgs
|
||||
(append-map (λ (dep)
|
||||
(define name (dependency->name dep))
|
||||
(define this-platform? (dependency-this-platform? dep))
|
||||
(or (and this-platform?
|
||||
(not (hash-ref simultaneous-installs name #f))
|
||||
((packages-to-update download-printf current-scope-db
|
||||
#:must-update? #f #:deps? #t
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns)
|
||||
name))
|
||||
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)))]
|
||||
[(and
|
||||
(not (eq? dep-behavior 'force))
|
||||
(let ()
|
||||
|
|
@ -1393,8 +1434,12 @@
|
|||
;; Try updates:
|
||||
(define update-pkgs (map car update-deps))
|
||||
(define (make-pre-succeed)
|
||||
(define db (read-pkg-db))
|
||||
(let ([to-update (filter-map (update-package download-printf db) update-pkgs)])
|
||||
(define db current-scope-db)
|
||||
(let ([to-update (append-map (packages-to-update download-printf db
|
||||
#:deps? update-deps?
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns)
|
||||
update-pkgs)])
|
||||
(λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))))
|
||||
(match (or dep-behavior
|
||||
(if name?
|
||||
|
|
@ -1592,6 +1637,8 @@
|
|||
#:skip-installed? [skip-installed? #f]
|
||||
#:pre-succeed [pre-succeed void]
|
||||
#:dep-behavior [dep-behavior #f]
|
||||
#:update-deps? [update-deps? #f]
|
||||
#:update-cache [update-cache #f]
|
||||
#:updating? [updating? #f]
|
||||
#:quiet? [quiet? #f]
|
||||
#:install-conversation [install-conversation #f]
|
||||
|
|
@ -1621,13 +1668,17 @@
|
|||
#:force? force
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-cache update-cache
|
||||
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
|
||||
#:updating? updating?
|
||||
#:install-conversation inst-conv
|
||||
#:update-conversation updt-conv
|
||||
#:strip strip-mode
|
||||
(for/list ([dep (in-list deps)])
|
||||
(pkg-desc dep #f #f #t)))])])
|
||||
(if (pkg-desc? dep)
|
||||
dep
|
||||
(pkg-desc dep #f #f #t))))])])
|
||||
(install-packages
|
||||
#:old-infos old-infos
|
||||
#:old-descs old-descs
|
||||
|
|
@ -1635,6 +1686,8 @@
|
|||
#:ignore-checksums? ignore-checksums?
|
||||
#:skip-installed? skip-installed?
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-cache update-cache
|
||||
#:pre-succeed pre-succeed
|
||||
#:updating? updating?
|
||||
#:quiet? quiet?
|
||||
|
|
@ -1644,42 +1697,126 @@
|
|||
#:link-dirs? link-dirs?
|
||||
new-descs)))
|
||||
|
||||
(define ((update-is-possible? db) pkg-name)
|
||||
(match-define (pkg-info orig-pkg checksum _)
|
||||
(package-info pkg-name #:db db))
|
||||
(define ty (first orig-pkg))
|
||||
(not (member ty '(link static-link dir file))))
|
||||
;; Determine packages to update, starting with `pkg-name'. If `pkg-name'
|
||||
;; needs to be updated, return it in a list. Otherwise, if `deps?',
|
||||
;; then return a list of dependencies that need to be updated.
|
||||
;; (If a package needs to be updated, wait until the update
|
||||
;; has been inspected for further dependencies.)
|
||||
;; If `must-installed?', then complain if the package is not
|
||||
;; installed inthe current scope.
|
||||
;; If `must-update?', then complain if the package is not
|
||||
;; updatable.
|
||||
;; The `update-cache' argument is used to cache which packages
|
||||
;; are already being updated and downloaded checksums.
|
||||
(define ((packages-to-update download-printf db
|
||||
#:must-installed? [must-installed? #t]
|
||||
#:must-update? [must-update? #t]
|
||||
#:deps? [deps? #f]
|
||||
#:namespace metadata-ns
|
||||
#:update-cache update-cache)
|
||||
pkg-name)
|
||||
(cond
|
||||
[(pkg-desc? pkg-name)
|
||||
;; Infer the package-source type and name:
|
||||
(define-values (inferred-name type) (package-source->name+type
|
||||
(pkg-desc-source pkg-name)
|
||||
(pkg-desc-type pkg-name)))
|
||||
(define name (or (pkg-desc-name pkg-name)
|
||||
inferred-name))
|
||||
;; Check that the package is installed, and get current checksum:
|
||||
(define info (package-info name #:db db))
|
||||
(if (or (not (pkg-info-checksum info))
|
||||
(not (equal? (pkg-info-checksum info)
|
||||
(checksum-for-pkg-source (pkg-desc-source pkg-name)
|
||||
type
|
||||
name download-printf))))
|
||||
;; Update:
|
||||
(begin
|
||||
(hash-set! update-cache (pkg-desc-source pkg-name) #t)
|
||||
(list (pkg-desc (pkg-desc-source pkg-name)
|
||||
(pkg-desc-type pkg-name)
|
||||
name
|
||||
(pkg-desc-auto? pkg-name))))
|
||||
;; No update needed, but maybe check dependencies:
|
||||
(if deps?
|
||||
((packages-to-update download-printf db
|
||||
#:must-update? #f
|
||||
#:deps? #t
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns)
|
||||
pkg-name)
|
||||
null))]
|
||||
[(eq? #t (hash-ref update-cache pkg-name #f))
|
||||
;; package is already being updated
|
||||
null]
|
||||
;; A string indicates that package source that should be
|
||||
;; looked up in the installed packages to get the old source
|
||||
;; for getting the checksum:
|
||||
[(package-info pkg-name #:db db must-update?)
|
||||
=>
|
||||
(lambda (m)
|
||||
(match-define (pkg-info orig-pkg checksum auto?) m)
|
||||
(match orig-pkg
|
||||
[`(,(or 'link 'static-link) ,_)
|
||||
(if must-update?
|
||||
(pkg-error (~a "cannot update linked packages\n"
|
||||
" package name: ~a\n"
|
||||
" package source: ~a")
|
||||
pkg-name
|
||||
orig-pkg)
|
||||
null)]
|
||||
[`(dir ,_)
|
||||
(if must-update?
|
||||
(pkg-error (~a "cannot update packages installed locally;\n"
|
||||
" package was installed via a local directory\n"
|
||||
" package name: ~a")
|
||||
pkg-name)
|
||||
null)]
|
||||
[`(file ,_)
|
||||
(if must-update?
|
||||
(pkg-error (~a "cannot update packages installed locally;\n"
|
||||
" package was installed via a local file\n"
|
||||
" package name: ~a")
|
||||
pkg-name)
|
||||
null)]
|
||||
[`(,_ ,orig-pkg-source)
|
||||
(define new-checksum
|
||||
(or (hash-ref update-cache pkg-name #f)
|
||||
(remote-package-checksum orig-pkg download-printf pkg-name)))
|
||||
;; Record downloaded checksum:
|
||||
(hash-set! update-cache pkg-name new-checksum)
|
||||
(or (and new-checksum
|
||||
(not (equal? checksum new-checksum))
|
||||
(begin
|
||||
;; Update it:
|
||||
(hash-set! update-cache pkg-name #t)
|
||||
;; Flush cache of downloaded checksums, in case
|
||||
;; there was a race between our checkig and updates on
|
||||
;; the catalog server:
|
||||
(clear-checksums-in-cache! update-cache)
|
||||
;; FIXME: the type shouldn't be #f here; it should be
|
||||
;; preseved from install time:
|
||||
(list (pkg-desc orig-pkg-source #f pkg-name auto?))))
|
||||
(if deps?
|
||||
;; Check dependencies
|
||||
(append-map
|
||||
(packages-to-update download-printf db
|
||||
#:must-update? #f
|
||||
#:deps? #t
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns)
|
||||
((package-dependencies metadata-ns db) pkg-name))
|
||||
null))]))]
|
||||
[else null]))
|
||||
|
||||
(define ((update-package download-printf db) pkg-name)
|
||||
(match-define (pkg-info orig-pkg checksum auto?)
|
||||
(package-info pkg-name #:db db))
|
||||
(match orig-pkg
|
||||
[`(,(or 'link 'static-link) ,_)
|
||||
(pkg-error (~a "cannot update linked packages\n"
|
||||
" package name: ~a\n"
|
||||
" package source: ~a")
|
||||
pkg-name
|
||||
orig-pkg)]
|
||||
[`(dir ,_)
|
||||
(pkg-error (~a "cannot update packages installed locally;\n"
|
||||
" package was installed via a local directory\n"
|
||||
" package name: ~a")
|
||||
pkg-name)]
|
||||
[`(file ,_)
|
||||
(pkg-error (~a "cannot update packages installed locally;\n"
|
||||
" package was installed via a local file\n"
|
||||
" package name: ~a")
|
||||
pkg-name)]
|
||||
[`(,_ ,orig-pkg-source)
|
||||
(define new-checksum
|
||||
(remote-package-checksum orig-pkg download-printf))
|
||||
(and new-checksum
|
||||
(not (equal? checksum new-checksum))
|
||||
;; FIXME: the type shouldn't be #f here; it should be
|
||||
;; preseved from install time:
|
||||
(pkg-desc orig-pkg-source #f pkg-name auto?))]))
|
||||
(define (clear-checksums-in-cache! update-cache)
|
||||
(define l (for/list ([(k v) (in-hash update-cache)]
|
||||
#:when (string? v))
|
||||
k))
|
||||
(for ([k (in-list l)]) (hash-remove! update-cache k)))
|
||||
|
||||
|
||||
(define ((package-dependencies metadata-ns db) pkg-name)
|
||||
(define ((package-dependencies metadata-ns db) pkg-name)
|
||||
(map dependency->name
|
||||
(filter dependency-this-platform?
|
||||
(get-all-deps metadata-ns (pkg-directory* pkg-name #:db db)))))
|
||||
|
|
@ -1687,23 +1824,27 @@
|
|||
(define (pkg-update in-pkgs
|
||||
#:all? [all? #f]
|
||||
#:dep-behavior [dep-behavior #f]
|
||||
#:deps? [deps? #f]
|
||||
#:force? [force? #f]
|
||||
#:ignore-checksums? [ignore-checksums? #f]
|
||||
#:deps? [update-deps? #f]
|
||||
#:quiet? [quiet? #f]
|
||||
#:strip [strip-mode #f])
|
||||
#:strip [strip-mode #f]
|
||||
#:link-dirs? [link-dirs? #f])
|
||||
(define download-printf (if quiet? void printf))
|
||||
(define metadata-ns (make-metadata-namespace))
|
||||
(define db (read-pkg-db))
|
||||
(define pkgs
|
||||
(cond
|
||||
[(and all? (empty? in-pkgs))
|
||||
(filter (update-is-possible? db) (hash-keys db))]
|
||||
[deps?
|
||||
(append-map
|
||||
(package-dependencies metadata-ns db)
|
||||
in-pkgs)]
|
||||
[else
|
||||
in-pkgs]))
|
||||
(define to-update (filter-map (update-package download-printf db) pkgs))
|
||||
(define all-mode? (and all? (empty? in-pkgs)))
|
||||
(define pkgs (cond
|
||||
[all-mode? (hash-keys db)]
|
||||
[else in-pkgs]))
|
||||
(define update-cache (make-hash))
|
||||
(define to-update (append-map (packages-to-update download-printf db
|
||||
#:must-update? (not all-mode?)
|
||||
#:deps? (or update-deps?
|
||||
all-mode?) ; avoid races
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns)
|
||||
pkgs))
|
||||
(cond
|
||||
[(empty? to-update)
|
||||
(unless quiet?
|
||||
|
|
@ -1719,8 +1860,13 @@
|
|||
#:updating? #t
|
||||
#:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-cache update-cache
|
||||
#:quiet? quiet?
|
||||
#:strip strip-mode
|
||||
#:force? force?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:link-dirs? link-dirs?
|
||||
to-update)]))
|
||||
|
||||
(define (pkg-show indent
|
||||
|
|
@ -1868,7 +2014,7 @@
|
|||
[(list)
|
||||
(pkg-error "config key not provided")]
|
||||
[_
|
||||
(pkg-error "multiple config keys provided")])]))
|
||||
(pkg-error "multiple config keys provided (not in value-setting mode)")])]))
|
||||
|
||||
(define (create-as-is create:format pkg-name dir orig-dir
|
||||
#:quiet? [quiet? #f]
|
||||
|
|
@ -1963,7 +2109,9 @@
|
|||
(create-as-is create:format name dest-dir dir
|
||||
#:hide-src? #t
|
||||
#:quiet? quiet?
|
||||
#:dest archive-dest-dir))
|
||||
#:dest (if archive-dest-dir
|
||||
(path->complete-path archive-dest-dir)
|
||||
(current-directory))))
|
||||
(lambda ()
|
||||
(delete-directory/files tmp-dir))))
|
||||
|
||||
|
|
@ -2499,12 +2647,15 @@
|
|||
#:dest (or/c (and/c path-string? complete-path?) #f))
|
||||
void?)]
|
||||
[pkg-update
|
||||
(->* ((listof string?))
|
||||
(->* ((listof (or/c string? pkg-desc?)))
|
||||
(#:dep-behavior dep-behavior/c
|
||||
#:all? boolean?
|
||||
#:deps? boolean?
|
||||
#:quiet? boolean?
|
||||
#:strip (or/c #f 'source 'binary))
|
||||
#:force? boolean?
|
||||
#:ignore-checksums? boolean?
|
||||
#:strip (or/c #f 'source 'binary)
|
||||
#:link-dirs? boolean?)
|
||||
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
|
||||
[pkg-remove
|
||||
(->* ((listof string?))
|
||||
|
|
|
|||
|
|
@ -3,13 +3,15 @@
|
|||
racket/list
|
||||
racket/format
|
||||
racket/path
|
||||
racket/splicing
|
||||
raco/command-name
|
||||
setup/dirs
|
||||
net/url
|
||||
"name.rkt"
|
||||
"lib.rkt"
|
||||
"commands.rkt"
|
||||
(prefix-in setup: setup/setup))
|
||||
(prefix-in setup: setup/setup)
|
||||
(for-syntax racket/base))
|
||||
|
||||
(define (setup no-setup? setup-collects jobs)
|
||||
(unless (or (eq? setup-collects 'skip)
|
||||
|
|
@ -35,7 +37,7 @@
|
|||
|
||||
;; Selects scope from `given-scope' through `user' arguments, or infers
|
||||
;; a scope from `pkgs' if non-#f, and then calls `thunk'.
|
||||
(define (call-with-package-scope who given-scope scope-dir installation user pkgs thunk)
|
||||
(define (call-with-package-scope who given-scope scope-dir installation user pkgs pkgs-type thunk)
|
||||
(define scope
|
||||
(case given-scope
|
||||
[(installation user) given-scope]
|
||||
|
|
@ -53,7 +55,8 @@
|
|||
(with-pkg-lock/read-only
|
||||
(define-values (pkg scope)
|
||||
(for/fold ([prev-pkg #f] [prev-scope #f]) ([pkg (in-list pkgs)])
|
||||
(define scope (find-pkg-installation-scope pkg))
|
||||
(define pkg-name (package-source->name pkg pkgs-type))
|
||||
(define scope (find-pkg-installation-scope pkg-name))
|
||||
(cond
|
||||
[(not prev-pkg) (values pkg scope)]
|
||||
[(equal? scope prev-scope) (values prev-pkg prev-scope)]
|
||||
|
|
@ -83,336 +86,361 @@
|
|||
[(regexp-match? #rx"^[a-zA-Z]*://" s) (string->url s)]
|
||||
[else (path->url (path->complete-path s))]))
|
||||
|
||||
(commands
|
||||
"This tool is used for managing installed packages."
|
||||
"pkg-~a-command"
|
||||
[install
|
||||
"Install 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)")]
|
||||
#:once-any
|
||||
[(#:sym mode [fail force search-ask search-auto] #f) deps ()
|
||||
("Specify the behavior for dependencies, with <mode> as one of"
|
||||
" fail: cancels the installation if dependencies are unmet"
|
||||
" (default for most packages)"
|
||||
" force: installs the package despite missing dependencies"
|
||||
" search-ask: looks for the dependencies on your package naming services"
|
||||
" (default if package is a package name) and asks if you would"
|
||||
" like it installed"
|
||||
" search-auto: like 'search-ask' but does not ask for permission to install")]
|
||||
[#:bool auto () "Shorthand for `--deps search-auto'"]
|
||||
#:once-each
|
||||
[#:bool force () "Ignores conflicts"]
|
||||
[#:bool ignore-checksums () "Ignores checksums"]
|
||||
#:once-any
|
||||
[#: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 copy () ("Treat directory sources the same as other sources")]
|
||||
[#:bool source () ("Strip package's built elements before installing; implies --copy")]
|
||||
[#:bool binary () ("Strip packages' source elements before installing; implies --copy")]
|
||||
#:once-each
|
||||
[#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package <scope>, one of"
|
||||
" installation: Install for all users of the Racket installation"
|
||||
" user: Install as user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[(#:str dir #f) scope-dir () "Install for package scope <dir>"]
|
||||
#:once-each
|
||||
[(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"]
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
|
||||
"not a good idea)")]
|
||||
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
|
||||
#:args pkg-source
|
||||
(call-with-package-scope
|
||||
'install
|
||||
scope scope-dir installation user #f
|
||||
(lambda ()
|
||||
(unless (or (not name) (package-source->name name))
|
||||
((current-pkg-error) (format "~e is an invalid package name" name)))
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))])
|
||||
(define link-dirs? (not (or copy source binary)))
|
||||
(pkg-install #:dep-behavior (if auto 'search-auto deps)
|
||||
#:force? force
|
||||
#:ignore-checksums? ignore-checksums
|
||||
#:skip-installed? skip-installed
|
||||
#:strip (or (and source 'source) (and binary 'binary))
|
||||
#:link-dirs? link-dirs?
|
||||
(for/list ([p (in-list pkg-source)])
|
||||
(define a-type (or (and link 'link)
|
||||
(and static-link 'static-link)
|
||||
(and (eq? type 'dir) link-dirs? 'link)
|
||||
type))
|
||||
(pkg-desc p a-type name #f))))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
[update
|
||||
"Update packages"
|
||||
#:once-each
|
||||
[#:bool all ("-a") ("Update all packages;"
|
||||
"only if no packages are given on the command line")]
|
||||
[#:bool update-deps () "Check named packages' dependencies for updates"]
|
||||
#:once-any
|
||||
[(#:sym mode [fail force search-ask search-auto] #f) deps ()
|
||||
("Specify the behavior for dependencies, with <mode> as one of"
|
||||
" fail: cancels the installation if dependencies are unmet"
|
||||
" (default for most packages)"
|
||||
" force: installs the package despite missing dependencies"
|
||||
" search-ask: looks for the dependencies on your package naming services"
|
||||
" (default if package is an package name) and asks if you would"
|
||||
" like it installed"
|
||||
" search-auto: like 'search-ask' but does not ask for permission to install")]
|
||||
[#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package scope, one of"
|
||||
" installation: Update only for all users of the Racket installation"
|
||||
" user: Update only user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[(#:str dir #f) scope-dir () "Update for package scope <dir>"]
|
||||
#:once-any
|
||||
[#:bool source () ("Strip built elements of the package before installing")]
|
||||
[#:bool binary () ("Strip source elements of the package before installing")]
|
||||
#:once-each
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
|
||||
"not a good idea)")]
|
||||
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
|
||||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'update
|
||||
scope scope-dir installation user pkg
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(pkg-update pkg
|
||||
#:all? all
|
||||
#:dep-behavior (if auto 'search-auto deps)
|
||||
#:deps? (or update-deps auto)
|
||||
#:strip (or (and source 'source) (and binary 'binary)))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
[remove
|
||||
"Remove packages"
|
||||
#:once-each
|
||||
[#:bool demote () "Demote to automatically installed, instead of removing"]
|
||||
[#:bool force () "Force removal of packages"]
|
||||
[#:bool auto () "Remove automatically installed packages with no dependencies"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package <scope>, one of"
|
||||
" installation: Remove packages for all users of the Racket installation"
|
||||
" user: Remove user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[(#:str dir #f) scope-dir () "Remove for package scope <dir>"]
|
||||
#:once-each
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
|
||||
"not a good idea)")]
|
||||
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
|
||||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'remove
|
||||
scope scope-dir installation user pkg
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(pkg-remove pkg
|
||||
#:demote? demote
|
||||
#:auto? auto
|
||||
#:force? force)))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
[show
|
||||
"Show information about installed packages"
|
||||
#:once-each
|
||||
[#:bool all ("-a") "Show auto-installed packages, too"]
|
||||
[#:bool dir ("-d") "Show the directory where the package is installed"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Show only for package <scope>, one of"
|
||||
" installation: Show only for all users of the Racket installation"
|
||||
" user: Show only user-specific for an installation version/name")]
|
||||
[(#:str vers #f) version ("-v") "Show user-specific for installation <vers>"]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[(#:str dir #f) scope-dir () "Show only for package scope <dir>"]
|
||||
#:args ()
|
||||
(define only-mode (case scope
|
||||
[(installation user) scope]
|
||||
[else
|
||||
(cond
|
||||
[scope-dir (path->complete-path scope-dir)]
|
||||
[installation 'installation]
|
||||
[user 'user]
|
||||
[else (if version 'user #f)])]))
|
||||
(for ([mode (if only-mode
|
||||
(list only-mode)
|
||||
(append (let ([main (find-pkgs-dir)])
|
||||
(reverse
|
||||
(for/list ([d (get-pkgs-search-dirs)])
|
||||
(if (equal? d main)
|
||||
'installation
|
||||
(simple-form-path d)))))
|
||||
'(user)))])
|
||||
(when (or (equal? mode only-mode) (not only-mode))
|
||||
(unless only-mode
|
||||
(printf "~a\n" (case mode
|
||||
[(installation) "Installation-wide:"]
|
||||
[(user) (format "User-specific for installation ~s:"
|
||||
(or version (get-installation-name)))]
|
||||
[else (format "~a:" mode)])))
|
||||
(parameterize ([current-pkg-scope mode]
|
||||
[current-pkg-error (pkg-error 'show)]
|
||||
[current-pkg-scope-version (or version (get-installation-name))])
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-show (if only-mode "" " ")
|
||||
#:auto? all
|
||||
#:directory? dir)))))]
|
||||
|
||||
[migrate
|
||||
"Install packages installed for other version/name"
|
||||
#:once-each
|
||||
[(#:sym mode [fail force search-ask search-auto] #f) deps ()
|
||||
("Specify the behavior for dependencies, with <mode> as one of"
|
||||
" fail: cancels the installation if dependencies are unmet"
|
||||
" force: installs the package despite missing dependencies"
|
||||
" search-ask: looks for the dependencies on your package naming services"
|
||||
" and asks if you would like it installed"
|
||||
" search-auto: (the default) like 'search-ask' but does not ask for"
|
||||
" permission to install")]
|
||||
[#:bool force () "Ignores conflicts"]
|
||||
[#:bool ignore-checksums () "Ignores checksums"]
|
||||
#:once-any
|
||||
[#:bool source () ("Strip built elements of the package before installing")]
|
||||
[#:bool binary () ("Strip source elements of the package before installing")]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package <scope>, one of"
|
||||
" installation: Install for all users of the Racket installation"
|
||||
" user: Install as user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[(#:str dir #f) scope-dir () "Install for package scope <dir>"]
|
||||
#:once-each
|
||||
[(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"]
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
|
||||
"not a good idea)")]
|
||||
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
|
||||
#:args (from-version)
|
||||
(call-with-package-scope
|
||||
'migrate
|
||||
scope scope-dir installation user #f
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))])
|
||||
(pkg-migrate from-version
|
||||
#:dep-behavior deps
|
||||
#:force? force
|
||||
#:ignore-checksums? ignore-checksums
|
||||
#:strip (or (and source 'source) (and binary 'binary))))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
[create
|
||||
"Bundle package from a directory or installed package"
|
||||
#:once-any
|
||||
[#:bool from-dir () "Treat <directory-or-package> as a directory (the default)"]
|
||||
[#:bool from-install () "Treat <directory-or-package> as a package name"]
|
||||
#:once-any
|
||||
[(#:sym fmt [zip tgz plt] #f) format ()
|
||||
("Select the format of the package to be created;"
|
||||
"valid <fmt>s are: zip (the default), tgz, plt")]
|
||||
[#:bool manifest () "Creates a manifest file for a directory, rather than an archive"]
|
||||
#:once-any
|
||||
[#:bool as-is () "Bundle the directory/package as-is (the default)"]
|
||||
[#:bool source () "Bundle sources only"]
|
||||
[#:bool binary () "Bundle bytecode and rendered documentation without sources"]
|
||||
[#:bool built () "Bundle sources, bytecode and rendered documentation"]
|
||||
#:once-each
|
||||
[(#:str dest-dir #f) dest () "Create output files in <dest-dir>"]
|
||||
#:args (directory-or-package)
|
||||
(parameterize ([current-pkg-error (pkg-error 'create)])
|
||||
(pkg-create (if manifest 'MANIFEST (or format 'zip))
|
||||
directory-or-package
|
||||
#:dest (and dest
|
||||
(path->complete-path dest))
|
||||
#:source (cond
|
||||
[from-install 'name]
|
||||
[else 'dir])
|
||||
#:mode (cond
|
||||
[source 'source]
|
||||
[binary 'binary]
|
||||
[built 'built]
|
||||
[else 'as-is])))]
|
||||
[config
|
||||
"View and modify the package manager's configuration"
|
||||
#:once-each
|
||||
[#:bool set () "Completely replace the value"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select configuration <scope>, one of"
|
||||
" installation: Operate on the installation-wide package configuration"
|
||||
" user: Operate on the user-specific for an installation name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
#:args key/val
|
||||
(call-with-package-scope
|
||||
'config
|
||||
scope #f installation user #f
|
||||
(lambda ()
|
||||
(if set
|
||||
(with-pkg-lock
|
||||
(pkg-config #t key/val))
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-config #f key/val)))))]
|
||||
[catalog-show
|
||||
"Show package information as reported by a catalog"
|
||||
#:once-any
|
||||
[(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"]
|
||||
#:once-each
|
||||
[#:bool all () "Show all packages"]
|
||||
[#:bool only-names () "Show only package names"]
|
||||
[#:bool modules () "Show implemented modules"]
|
||||
[(#:str vers #f) version ("-v") "Show result for Racket <vers>"]
|
||||
#:args pkg-name
|
||||
(when (and all (pair? pkg-name))
|
||||
((pkg-error 'catalog-show) "both `--all' and package names provided"))
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))]
|
||||
[current-pkg-error (pkg-error 'catalog-show)]
|
||||
[current-pkg-scope-version (or version
|
||||
(current-pkg-scope-version))])
|
||||
(pkg-catalog-show pkg-name
|
||||
#:all? all
|
||||
#:only-names? only-names
|
||||
#:modules? modules))]
|
||||
[catalog-copy
|
||||
"Copy/merge package name catalogs"
|
||||
#:once-each
|
||||
[#:bool from-config () "Include currently configured catalogs last"]
|
||||
#:once-any
|
||||
[#:bool force () "Force replacement fo existing file/directory"]
|
||||
[#:bool merge () "Merge to existing database"]
|
||||
#:once-each
|
||||
[#:bool override () "While merging, override existing with new"]
|
||||
[(#:str vers #f) version ("-v") "Copy information suitable for Racket <vers>"]
|
||||
#:args catalog
|
||||
(parameterize ([current-pkg-error (pkg-error 'catalog-copy)])
|
||||
(when (null? catalog)
|
||||
((current-pkg-error) "need a destination catalog"))
|
||||
(parameterize ([current-pkg-scope-version (or version
|
||||
(current-pkg-scope-version))])
|
||||
(pkg-catalog-copy (drop-right catalog 1)
|
||||
(last catalog)
|
||||
#:from-config? from-config
|
||||
#:force? force
|
||||
#:merge? merge
|
||||
#:override? override)))])
|
||||
(splicing-let ()
|
||||
(define-syntax (make-commands stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:scope-flags (scope-flags ...)
|
||||
#:job-flags (job-flags ...)
|
||||
#:catalog-flags (catalog-flags ...)
|
||||
#:install-type-flags (install-type-flags ...)
|
||||
#:install-dep-flags (install-dep-flags ...)
|
||||
#:install-dep-desc (install-dep-desc ...)
|
||||
#:install-force-flags (install-force-flags ...)
|
||||
#:install-copy-flags (install-copy-flags ...)
|
||||
#:install-copy-defns (install-copy-defns ...))
|
||||
(with-syntax ([([scope-flags ...]
|
||||
[job-flags ...]
|
||||
[catalog-flags ...]
|
||||
[install-type-flags ...]
|
||||
[(install-dep-flags ... (dep-desc ...))]
|
||||
[install-force-flags ...]
|
||||
[install-copy-flags ...]
|
||||
[install-copy-defns ...])
|
||||
(syntax-local-introduce #'([scope-flags ...]
|
||||
[job-flags ...]
|
||||
[catalog-flags ...]
|
||||
[install-type-flags ...]
|
||||
[install-dep-flags ...]
|
||||
[install-force-flags ...]
|
||||
[install-copy-flags ...]
|
||||
[install-copy-defns ...]))])
|
||||
#`(commands
|
||||
"This tool is used for managing installed packages."
|
||||
"pkg-~a-command"
|
||||
;; ----------------------------------------
|
||||
[install
|
||||
"Install packages"
|
||||
#:once-any
|
||||
install-type-flags ...
|
||||
#:once-any
|
||||
[install-dep-flags ...
|
||||
(dep-desc ...
|
||||
install-dep-desc ...)]
|
||||
[#:bool auto () "Shorthand for `--deps search-auto'"]
|
||||
#:once-any
|
||||
install-copy-flags ...
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
#:once-each
|
||||
catalog-flags ...
|
||||
[#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
|
||||
install-force-flags ...
|
||||
job-flags ...
|
||||
#:args pkg-source
|
||||
install-copy-defns ...
|
||||
(call-with-package-scope
|
||||
'install
|
||||
scope scope-dir installation user #f a-type
|
||||
(lambda ()
|
||||
(unless (or (not name) (package-source->name name))
|
||||
((current-pkg-error) (format "~e is an invalid package name" name)))
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))])
|
||||
(pkg-install #:dep-behavior (if auto 'search-auto deps)
|
||||
#:force? force
|
||||
#:ignore-checksums? ignore-checksums
|
||||
#:skip-installed? skip-installed
|
||||
#:strip (or (and source 'source) (and binary 'binary))
|
||||
#:link-dirs? link-dirs?
|
||||
(for/list ([p (in-list pkg-source)])
|
||||
(pkg-desc p a-type name #f))))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
;; ----------------------------------------
|
||||
[update
|
||||
"Update packages"
|
||||
#:once-each
|
||||
[#: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"]
|
||||
#:once-any
|
||||
install-type-flags ...
|
||||
#:once-any
|
||||
[install-dep-flags ...
|
||||
(dep-desc ...
|
||||
install-dep-desc ...)]
|
||||
[#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"]
|
||||
#:once-any
|
||||
install-copy-flags ...
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
#:once-each
|
||||
catalog-flags ...
|
||||
install-force-flags ...
|
||||
job-flags ...
|
||||
#:args pkg-source
|
||||
install-copy-defns ...
|
||||
(call-with-package-scope
|
||||
'update
|
||||
scope scope-dir installation user pkg-source #f
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))])
|
||||
(pkg-update (for/list ([pkg-source (in-list pkg-source)])
|
||||
(cond
|
||||
[lookup
|
||||
(pkg-desc pkg-source a-type name #f)]
|
||||
[else
|
||||
(define-values (pkg-name pkg-type)
|
||||
(package-source->name+type pkg-source a-type))
|
||||
(if (eq? pkg-type 'name)
|
||||
pkg-name
|
||||
(pkg-desc pkg-source a-type name #f))]))
|
||||
#:all? all
|
||||
#:dep-behavior (if auto 'search-auto deps)
|
||||
#:force? force
|
||||
#:ignore-checksums? ignore-checksums
|
||||
#:deps? (or update-deps auto)
|
||||
#:strip (or (and source 'source) (and binary 'binary))
|
||||
#:link-dirs? link-dirs?))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
;; ----------------------------------------
|
||||
[remove
|
||||
"Remove packages"
|
||||
#:once-each
|
||||
[#:bool demote () "Demote to auto-installed, instead of removing"]
|
||||
[#:bool force () "Remove even if package has dependents"]
|
||||
[#:bool auto () "Also remove auto-installed packages that have no dependents"]
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
#:once-each
|
||||
job-flags ...
|
||||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'remove
|
||||
scope scope-dir installation user pkg 'name
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(pkg-remove pkg
|
||||
#:demote? demote
|
||||
#:auto? auto
|
||||
#:force? force)))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
;; ----------------------------------------
|
||||
[show
|
||||
"Show information about installed packages"
|
||||
#:once-each
|
||||
[#:bool all ("-a") "Show auto-installed packages, too"]
|
||||
[#:bool dir ("-d") "Show the directory where the package is installed"]
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
[(#:str vers #f) version ("-v") "Show user-specific for installation <vers>"]
|
||||
#:args ()
|
||||
(define only-mode (case scope
|
||||
[(installation user) scope]
|
||||
[else
|
||||
(cond
|
||||
[scope-dir (path->complete-path scope-dir)]
|
||||
[installation 'installation]
|
||||
[user 'user]
|
||||
[else (if version 'user #f)])]))
|
||||
(for ([mode (if only-mode
|
||||
(list only-mode)
|
||||
(append (let ([main (find-pkgs-dir)])
|
||||
(reverse
|
||||
(for/list ([d (get-pkgs-search-dirs)])
|
||||
(if (equal? d main)
|
||||
'installation
|
||||
(simple-form-path d)))))
|
||||
'(user)))])
|
||||
(when (or (equal? mode only-mode) (not only-mode))
|
||||
(unless only-mode
|
||||
(printf "~a\n" (case mode
|
||||
[(installation) "Installation-wide:"]
|
||||
[(user) (format "User-specific for installation ~s:"
|
||||
(or version (get-installation-name)))]
|
||||
[else (format "~a:" mode)])))
|
||||
(parameterize ([current-pkg-scope mode]
|
||||
[current-pkg-error (pkg-error 'show)]
|
||||
[current-pkg-scope-version (or version (get-installation-name))])
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-show (if only-mode "" " ")
|
||||
#:auto? all
|
||||
#:directory? dir)))))]
|
||||
;; ----------------------------------------
|
||||
[migrate
|
||||
"Install packages installed for other version/name"
|
||||
#:once-each
|
||||
[install-dep-flags ...
|
||||
(dep-desc ...
|
||||
"where the default is `search-auto'")]
|
||||
#:once-any
|
||||
[#:bool source () ("Strip built elements of the package before installing")]
|
||||
[#:bool binary () ("Strip source elements of the package before installing")]
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
#:once-each
|
||||
catalog-flags ...
|
||||
install-force-flags ...
|
||||
job-flags ...
|
||||
#:args (from-version)
|
||||
(call-with-package-scope
|
||||
'migrate
|
||||
scope scope-dir installation user #f #f
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))])
|
||||
(pkg-migrate from-version
|
||||
#:dep-behavior deps
|
||||
#:force? force
|
||||
#:ignore-checksums? ignore-checksums
|
||||
#:strip (or (and source 'source) (and binary 'binary))))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
;; ----------------------------------------
|
||||
[create
|
||||
"Bundle package from a directory or installed package"
|
||||
#:once-any
|
||||
[#:bool from-dir () "Treat <directory-or-package> as a directory (the default)"]
|
||||
[#:bool from-install () "Treat <directory-or-package> as a package name"]
|
||||
#:once-any
|
||||
[(#:sym fmt [zip tgz plt] #f) format ()
|
||||
("Select the format of the package to be created;"
|
||||
"valid <fmt>s are: zip (the default), tgz, plt")]
|
||||
[#:bool manifest () "Creates a manifest file for a directory, rather than an archive"]
|
||||
#:once-any
|
||||
[#:bool as-is () "Bundle the directory/package as-is (the default)"]
|
||||
[#:bool source () "Bundle sources only"]
|
||||
[#:bool binary () "Bundle bytecode and rendered documentation without sources"]
|
||||
[#:bool built () "Bundle sources, bytecode and rendered documentation"]
|
||||
#:once-each
|
||||
[(#:str dest-dir #f) dest () "Create output files in <dest-dir>"]
|
||||
#:args (directory-or-package)
|
||||
(parameterize ([current-pkg-error (pkg-error 'create)])
|
||||
(pkg-create (if manifest 'MANIFEST (or format 'zip))
|
||||
directory-or-package
|
||||
#:dest (and dest
|
||||
(path->complete-path dest))
|
||||
#:source (cond
|
||||
[from-install 'name]
|
||||
[else 'dir])
|
||||
#:mode (cond
|
||||
[source 'source]
|
||||
[binary 'binary]
|
||||
[built 'built]
|
||||
[else 'as-is])))]
|
||||
;; ----------------------------------------
|
||||
[config
|
||||
"View and modify the package manager's configuration"
|
||||
#:once-each
|
||||
[#:bool set () "Set <key> to <val> ..."]
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
#:args (key . val)
|
||||
(call-with-package-scope
|
||||
'config
|
||||
scope scope-dir installation user #f #f
|
||||
(lambda ()
|
||||
(if set
|
||||
(with-pkg-lock
|
||||
(pkg-config #t (cons key val)))
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-config #f (cons key val))))))]
|
||||
;; ----------------------------------------
|
||||
[catalog-show
|
||||
"Show package information as reported by a catalog"
|
||||
#:once-each
|
||||
[#:bool all () "Show all packages"]
|
||||
[#:bool only-names () "Show only package names"]
|
||||
[#:bool modules () "Show implemented modules"]
|
||||
catalog-flags ...
|
||||
[(#:str vers #f) version ("-v") "Show result for Racket <vers>"]
|
||||
#:args pkg-name
|
||||
(when (and all (pair? pkg-name))
|
||||
((pkg-error 'catalog-show) "both `--all' and package names provided"))
|
||||
(parameterize ([current-pkg-catalogs (and catalog
|
||||
(list (catalog->url catalog)))]
|
||||
[current-pkg-error (pkg-error 'catalog-show)]
|
||||
[current-pkg-scope-version (or version
|
||||
(current-pkg-scope-version))])
|
||||
(pkg-catalog-show pkg-name
|
||||
#:all? all
|
||||
#:only-names? only-names
|
||||
#:modules? modules))]
|
||||
;; ----------------------------------------
|
||||
[catalog-copy
|
||||
"Copy/merge package name catalogs"
|
||||
#:once-each
|
||||
[#:bool from-config () "Include currently configured catalogs last"]
|
||||
#:once-any
|
||||
[#:bool force () "Force replacement fo existing file/directory"]
|
||||
[#:bool merge () "Merge to existing database"]
|
||||
#:once-each
|
||||
[#:bool override () "While merging, override existing with new"]
|
||||
[(#:str vers #f) version ("-v") "Copy information suitable for Racket <vers>"]
|
||||
#:args catalog
|
||||
(parameterize ([current-pkg-error (pkg-error 'catalog-copy)])
|
||||
(when (null? catalog)
|
||||
((current-pkg-error) "need a destination catalog"))
|
||||
(parameterize ([current-pkg-scope-version (or version
|
||||
(current-pkg-scope-version))])
|
||||
(pkg-catalog-copy (drop-right catalog 1)
|
||||
(last catalog)
|
||||
#:from-config? from-config
|
||||
#:force? force
|
||||
#:merge? merge
|
||||
#:override? override)))]))]))
|
||||
(make-commands
|
||||
#:scope-flags
|
||||
([(#:sym scope [installation user] #f) scope ()
|
||||
("Select package <scope>, one of"
|
||||
" installation: for all users of the Racket installation"
|
||||
" user: as user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[(#:str dir #f) scope-dir () "Select package scope <dir>"])
|
||||
#:job-flags
|
||||
([#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
|
||||
"not a good idea)")]
|
||||
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"])
|
||||
#:catalog-flags
|
||||
([(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"])
|
||||
#:install-type-flags
|
||||
([(#: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)")])
|
||||
#:install-dep-flags
|
||||
([(#:sym mode [fail force search-ask search-auto] #f) deps ()
|
||||
("Specify the behavior for uninstalled dependencies, with"
|
||||
"<mode> as one of"
|
||||
" fail: cancels if dependencies are not installed"
|
||||
" force: continues despite missing dependencies"
|
||||
" search-ask: looks for dependencies in the package catalogs"
|
||||
" and asks for permission to auto-install"
|
||||
" search-auto: like `search-ask', but does not ask for permission")])
|
||||
#:install-dep-desc
|
||||
("where the default is `search-ask' if <pkg-source> is a package name"
|
||||
"or `fail' otherwise")
|
||||
#:install-force-flags
|
||||
([#:bool force () "Ignores conflicts"]
|
||||
[#:bool ignore-checksums () "Ignores checksums"])
|
||||
#: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")]
|
||||
[#:bool copy () ("Treat directory sources the same as other sources")]
|
||||
[#:bool source () ("Strip package's built elements before installing; implies --copy")]
|
||||
[#:bool binary () ("Strip packages' source elements before installing; implies --copy")])
|
||||
#:install-copy-defns
|
||||
[(define link-dirs? (not (or copy source binary)))
|
||||
(define a-type (or (and link 'link)
|
||||
(and static-link 'static-link)
|
||||
(and (eq? type 'dir) link-dirs? 'link)
|
||||
type))]))
|
||||
|
|
|
|||
|
|
@ -52,7 +52,8 @@
|
|||
(define github-client_secret (make-parameter #f))
|
||||
|
||||
(define (package-url->checksum pkg-url-str [query empty]
|
||||
#:download-printf [download-printf void])
|
||||
#:download-printf [download-printf void]
|
||||
#:pkg-name [pkg-name "package"])
|
||||
(define pkg-url
|
||||
(string->url pkg-url-str))
|
||||
(match (url-scheme pkg-url)
|
||||
|
|
@ -94,7 +95,7 @@
|
|||
(hash-ref (hash-ref b 'commit) 'sha)))]
|
||||
[_
|
||||
(define u (string-append pkg-url-str ".CHECKSUM"))
|
||||
(download-printf "Downloading checksum\n")
|
||||
(download-printf "Downloading checksum for ~a\n" pkg-name)
|
||||
(log-pkg-debug "Downloading checksum as ~a" u)
|
||||
(call/input-url+200 (string->url u)
|
||||
port->string)]))
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@
|
|||
body ...
|
||||
#:handlers
|
||||
(λ (_ . formals) final-expr)
|
||||
(ensure-list (pimap symbol->string 'formals))
|
||||
(pimap symbol->string 'formals)
|
||||
(λ (help-string)
|
||||
(for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80))
|
||||
(newline)
|
||||
|
|
@ -102,18 +102,13 @@
|
|||
[extra (build-string (- n l) (λ (n) #\space))])
|
||||
(string-append str extra)))
|
||||
|
||||
(define (ensure-list x)
|
||||
(if (or (null? x) (pair? x))
|
||||
x
|
||||
(list x)))
|
||||
|
||||
;; pimap : (A -> B) improper-listof A -> improper-listof B
|
||||
;; pimap : (A -> B) improper-listof A -> listof B
|
||||
(define (pimap f pil)
|
||||
(cond
|
||||
[(null? pil) '()]
|
||||
[(pair? pil) (cons (pimap f (car pil))
|
||||
[(pair? pil) (cons (f (car pil))
|
||||
(pimap f (cdr pil)))]
|
||||
[else (f pil)]))
|
||||
[else (list (f pil))]))
|
||||
|
||||
;; wrap-to-count : string nat -> (listof string)
|
||||
;; breaks str into substrings such that no substring
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user