suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add `raco pkg migrate'

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-26 13:18:06 -06:00
parent 7e6838b0af
commit e776821e31
8 changed files with 196 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -147,7 +147,7 @@ needed, and a list of module paths provided by the package.}
@defproc[(pkg-config [set? boolean?] [keys/vals list?])
void?]{
Implements the @racket[config] command.
Implements @racket[pkg-config-command].
The package lock must be held (allowing writes if @racket[set?] is true); see
@racket[with-pkg-lock].}
@ -158,7 +158,7 @@ The package lock must be held (allowing writes if @racket[set?] is true); see
[#:quiet? quiet? boolean? #f])
void?]{
Implements the @racket[create] command.
Implements @racket[pkg-create-command].
Unless @racket[quiet?] is true, information about the output is repotred to the current output port.}
@ -176,7 +176,7 @@ Unless @racket[quiet?] is true, information about the output is repotred to the
(listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements the @racket[install] command. The result indicates which
Implements @racket[pkg-install-command]. The result indicates which
collections should be setup via @exec{raco setup}: @racket['skip]
means that no setup is needed, @racket[#f] means all, and a list means
only the indicated collections.
@ -202,8 +202,8 @@ The package lock must be held; see @racket[with-pkg-lock].}
(listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements the @racket[update] command. The result is the same as for
@racket[install-pkgs].
Implements @racket[pkg-update-command]. The result is the same as for
@racket[pkg-install].
The package lock must be held; see @racket[with-pkg-lock].}
@ -217,8 +217,8 @@ The package lock must be held; see @racket[with-pkg-lock].}
(listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements the @racket[remove] command. The result is the same as for
@racket[install-pkgs], indicating collects that should be setup
Implements @racket[pkg-remove-command]. The result is the same as for
@racket[pkg-install], indicating collects that should be setup
via @exec{raco setup}.
The package lock must be held; see @racket[with-pkg-lock].}
@ -228,7 +228,7 @@ The package lock must be held; see @racket[with-pkg-lock].}
[#:directory show-dir? boolean? #f])
void?]{
Implements the @racket[show] command for a single package scope,
Implements @racket[pkg-show-command] for a single package scope,
printing to the current output port. See also
@racket[installed-pkg-names] and @racket[installed-pkg-table].
@ -236,13 +236,30 @@ The package lock must be held to allow reads; see
@racket[with-pkg-lock/read-only].}
@defproc[(pkg-migrate [from-version string?]
[#:dep-behavior dep-behavior
(or/c #f 'fail 'force 'search-ask 'search-auto)
#f]
[#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f]
[#:quiet? boolean? quiet? #f]
[#:strip strip (or/c #f 'source 'binary) #f])
(or/c 'skip
#f
(listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements @racket[pkg-migrate-command]. The result is the same as for
@racket[pkg-install].}
@defproc[(pkg-catalog-show [names (listof string?)]
[#:all? all? boolean? #f]
[#:only-names? only-names? boolean? #f]
[#:modules? modules? boolean? #f])
void?]{
Implements the @racket[catalog-show] command. If @racket[all?] is true,
Implements @racket[catalog-show-command]. If @racket[all?] is true,
then @racket[names] should be empty.}
@ -254,7 +271,7 @@ then @racket[names] should be empty.}
[#:override? override? boolean? #f])
void?]{
Implements the @racket[catalog-copy] command.}
Implements @racket[pkg-catalog-copy-command].}
@defproc[(pkg-catalog-update-local [#:catalog-file catalog-file path-string? (current-pkg-catalog-file)]

28
pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -300,8 +300,6 @@ sub-sub-commands:
@item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).}
@item{@DFlag{skip-installed} --- Ignore a @nonterm{pkg-source} if a corresponding package is already installed.}
@item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
and links the existing directory as an installed package. The package is identified
as a @tech{single-collection package} or a @tech{multi-collection package} at the
@ -417,6 +415,31 @@ removing any of the @nonterm{pkg}s.
]
}
@item{@command/toc{migrate} @nonterm{option} ... @nonterm{from-version}
--- Installs packages that were previously installed in @exec{user}
@tech{package scope} for @nonterm{from-version}, where
@nonterm{from-version} is an installation name/version.
The @exec{migrate} sub-command accepts
the following @nonterm{option}s:
@itemlist[
@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}.}
@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} --- Select @nonterm{dir} as the @tech{package scope}.}
@item{@DFlag{catalog} @nonterm{catalog} --- 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}.}
]
}
@item{@command/toc{create} @nonterm{option} ... @nonterm{directory-or-package}
--- Bundles a package into an archive. Bundling
is not needed for a package that is provided directly from a
@ -536,6 +559,7 @@ to the command sub-sub-commands.
@defthing[pkg-update-command procedure?]
@defthing[pkg-remove-command procedure?]
@defthing[pkg-show-command procedure?]
@defthing[pkg-migrate-command procedure?]
@defthing[pkg-config-command procedure?]
@defthing[pkg-create-command procedure?]
@defthing[pkg-catalog-show-command procedure?]

1
pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt
View File

@ -51,6 +51,7 @@
;; "main-server"
"update-deps"
"update-auto"
"migrate"
"versions"
"platform"
"raco"

36
pkgs/racket-pkgs/racket-test/tests/pkg/tests-migrate.rkt Normal file
View File

@ -0,0 +1,36 @@
#lang racket/base
(require racket/file
racket/format
"shelly.rkt"
"util.rkt")
(pkg-tests
(shelly-case
"migrate packages"
$ "raco pkg create --format plt test-pkgs/pkg-b-second"
$ "raco pkg create --format plt test-pkgs/pkg-a-first")
(with-fake-root
(shelly-case
"install package, copy to other, remove, then migrate"
$ "raco pkg config --set catalogs http://localhost:9990"
(hash-set! *index-ht-1* "pkg-b"
(hasheq 'checksum
(file->string "test-pkgs/pkg-b-second.plt.CHECKSUM")
'source
"http://localhost:9999/pkg-b-second.plt"))
(hash-set! *index-ht-1* "pkg-a"
(hasheq 'checksum
(file->string "test-pkgs/pkg-a-first.plt.CHECKSUM")
'source
"http://localhost:9999/pkg-a-first.plt"))
$ "raco pkg install -u --deps search-auto pkg-b" =exit> 0
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n"
$ (~a "racket"
" -e \"(require racket/file setup/dirs)\""
" -e \"(copy-directory/files (build-path (find-system-path 'addon-dir) (get-installation-name))"
" (build-path (find-system-path 'addon-dir) (symbol->string 'other)))\"")
$ "raco pkg remove -u --auto pkg-b"
$ "raco pkg show -u -a" =stdout> " [none]\n"
$ "raco pkg migrate -u other"
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n")))

2
pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-auto.rkt
View File

@ -50,7 +50,7 @@
$ "racket -e '(require pkg-b)'" =exit> 43
$ "racket -e '(require pkg-a)'" =exit> 0
;; remove auto doesn't do anything because everything is needed
$ "raco pkg remove --auto"
$ "raco pkg remove -u --auto"
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n"
$ "racket -e '(require pkg-b)'" =exit> 43
$ "racket -e '(require pkg-a)'" =exit> 0

59
racket/collects/pkg/lib.rkt
View File

@ -395,7 +395,7 @@
(define (read-pkg-db)
(if (current-no-pkg-db)
#hash()
(read-pkgs-db (current-pkg-scope))))
(read-pkgs-db (current-pkg-scope) (current-pkg-scope-version))))
;; read all packages in this scope or wider
(define (merge-pkg-dbs [scope (current-pkg-scope)])
@ -410,7 +410,7 @@
[(k v) (read-pkgs-db dir)])
(values k v))]
[(user)
(define db (read-pkgs-db 'user))
(define db (read-pkgs-db 'user (current-pkg-scope-version)))
(for/fold ([ht (merge-next-pkg-dbs 'installation)]) ([(k v) (in-hash db)])
(hash-set ht k v))])))
@ -1617,6 +1617,53 @@
(sort (hash-keys (installed-pkg-table #:scope given-scope))
string-ci<=?))
(define (pkg-migrate from-version
#:force? [force? #f]
#:quiet? [quiet? #f]
#:ignore-checksums? [ignore-checksums? #f]
#:dep-behavior [dep-behavior #f]
#:strip [strip-mode #f])
(define from-db
(parameterize ([current-pkg-scope-version from-version])
(installed-pkg-table #:scope 'user)))
(define to-install
(sort
(for/list ([(name info) (in-hash from-db)]
#:unless (pkg-info-auto? info))
(define-values (source type)
(match (pkg-info-orig-pkg info)
[(list 'catalog name) (values name 'name)]
[(list 'url url) (values url #f)]
[(list 'link path) (values path 'link)]
[(list 'static-link path) (values path 'static-link)]))
(pkg-desc source type name #f))
string<?
#:key pkg-desc-name))
(unless quiet?
(cond
[(null? to-install)
(printf "No packages from ~s to install\n" from-version)]
[else
(printf "Packages to install:\n")
(for ([d (in-list to-install)])
(define t (pkg-desc-type d))
(define n (pkg-desc-name d))
(case t
[(name) (printf " ~a\n" n)]
[(link static-link)
(printf " ~a ~aed from ~a\n" n t (pkg-desc-source d))]
[else
(printf " ~a from ~a\n" n (pkg-desc-source d))]))]))
(if (null? to-install)
'skip
(pkg-install to-install
#:force? force?
#:ignore-checksums? ignore-checksums?
#:skip-installed? #t
#:dep-behavior (or dep-behavior 'search-auto)
#:quiet? quiet?
#:strip strip-mode)))
(define (pkg-config config:set key+vals)
(cond
[config:set
@ -2312,6 +2359,14 @@
#:quiet? boolean?
#:strip (or/c #f 'source 'binary))
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-migrate
(->* (string?)
(#:dep-behavior dep-behavior/c
#:force? boolean?
#:ignore-checksums? boolean?
#:quiet? boolean?
#:strip (or/c #f 'source 'binary))
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-catalog-show
(->* ((listof string?))
(#:all? boolean?

45
racket/collects/pkg/main.rkt
View File

@ -232,6 +232,51 @@
(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
(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 a package from a directory or installed package"
#:once-any

6
racket/collects/pkg/path.rkt
View File

@ -23,7 +23,7 @@
"(or/c 'user 'installation (and/c path? complete-path?))"
scope)))
(define (get-pkgs-dir scope [user-version (version)])
(define (get-pkgs-dir scope [user-version (get-installation-name)])
(check-scope 'get-pkgs-dir scope)
(unless (string? user-version)
(raise-argument-error 'get-pkgs-dir "string?" user-version))
@ -52,10 +52,10 @@
ht))))
(hash))))
(define (read-pkgs-db scope)
(define (read-pkgs-db scope [user-version (get-installation-name)])
(check-scope 'read-pkgs-db scope)
(let ([db (read-pkg-file-hash
(build-path (get-pkgs-dir scope) "pkgs.rktd"))])
(build-path (get-pkgs-dir scope user-version) "pkgs.rktd"))])
;; compatibility: map 'pnr to 'catalog:
(for/hash ([(k v) (in-hash db)])
(values k