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

raco pkg update: add --skip-uninstalled flag

Browse Source
This commit is contained in:
Matthew Flatt 2015-02-17 15:43:15 -07:00
parent cc621124c1
commit b37eab0621
7 changed files with 108 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -299,7 +299,8 @@ The package lock must be held; see @racket[with-pkg-lock].
[#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f]
[#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f]
[#:use-cache? use-cache? quiet? #t]
[#:use-cache? use-cache? boolean? #t]
[#:skip-uninstalled? skip-uninstalled? boolean? #t]
[#:quiet? quiet? boolean? #f]
[#:use-trash? boolean? use-trash? #f]
[#:from-command-line? from-command-line? boolean? #f]
@ -344,7 +345,7 @@ The package lock must be held; see @racket[with-pkg-lock].
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
and @racket[#:infer-clone-from-dir?] arguments.}
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
#:changed "6.1.1.8" @elem{Added the @racket[#:pull-mode] argument.}]}
#:changed "6.1.1.8" @elem{Added the @racket[#:skip-uninstalled?] and @racket[#:pull-mode] arguments.}]}
@defproc[(pkg-remove [names (listof string?)]

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

@ -701,6 +701,7 @@ the given @nonterm{pkg-source}s.
@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{skip-uninstalled} --- Ignores any @nonterm{pkg-source} that does not correspond to an installed package.}
@item{@DFlag{all-platforms} --- 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}.}
@ -726,7 +727,7 @@ the given @nonterm{pkg-source}s.
when no arguments are provided.}
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
the @DFlag{deps} default to depend only on interactive mode.}
#:changed "6.1.1.8" @elem{Added the @DFlag{pull} flag.}]}
#:changed "6.1.1.8" @elem{Added the @DFlag{skip-uninstalled} and @DFlag{pull} flags.}]}
@subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ...
--- Attempts to remove the given packages. By default, if a package is the dependency

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

@ -26,6 +26,8 @@
(shelly-install "local packages can't be updated (file)"
"test-pkgs/pkg-test1.zip"
$ "raco pkg update pkg-test1" =exit> 1)
(shelly-case "update of uninstalled with --skip-uninstalled"
$ "raco pkg update --skip-uninstalled nosuchpackage")
(define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory)))
(shelly-wind

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

@ -109,6 +109,7 @@
#:force? boolean?
#:ignore-checksums? boolean?
#:strict-doc-conflicts? boolean?
#:skip-uninstalled? boolean?
#:use-cache? boolean?
#:strip (or/c #f 'source 'binary 'binary-lib)
#:force-strip? boolean?

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

@ -86,10 +86,11 @@
msg s)))]))
(define scope (find-pkg-installation-scope pkg-name))
(cond
[(not prev-pkg) (values pkg scope)]
[(or (not prev-pkg) (not prev-scope)) (values pkg scope)]
[(not scope) (values prev-pkg prev-scope)]
[(equal? scope prev-scope) (values prev-pkg prev-scope)]
[else
((current-pkg-error)
((current-pkg-error)
(~a "given packages are installed in different scopes\n"
" package: ~a\n"
" scope: ~a\n"
@ -292,6 +293,7 @@
scope-flags ...
#:once-each
catalog-flags ...
[#:bool skip-uninstalled () ("Skip a given <pkg-source> if not installed")]
install-force-flags ...
install-clone-flags ...
job-flags ...
@ -350,6 +352,7 @@
#:ignore-checksums? ignore-checksums
#:strict-doc-conflicts? strict-doc-conflicts
#:use-cache? (not no-cache)
#:skip-uninstalled? skip-uninstalled
#:update-deps? (or update-deps auto)
#:update-implies? (not ignore-implies)
#:strip (or (and source 'source)

74
racket/collects/pkg/private/clone-path.rkt
View File

@ -264,7 +264,10 @@
;; If `pkg-name` is a description with the type 'clone, but its syntax
;; matches a package name, then infer a repo from the current package
;; installation and return an alternate description.
(define ((convert-clone-name-to-clone-repo/update db from-command-line?) pkg-name)
(define ((convert-clone-name-to-clone-repo/update db
skip-uninstalled?
from-command-line?)
pkg-name)
(cond
[(and (pkg-desc? pkg-name)
(eq? 'clone (pkg-desc-type pkg-name))
@ -272,39 +275,40 @@
name))
=> (lambda (name)
;; Infer or complain
(define info (package-info name #:db db))
(unless info
(pkg-error (~a "package is not currently installed\n"
" package: ~a")
name))
(define new-pkg-name
(pkg-info->clone-desc name info
#:checksum (pkg-desc-checksum pkg-name)
#:auto? (pkg-desc-auto? pkg-name)
#:extra-path (pkg-desc-extra-path pkg-name)
#:reject-existing-clone? #t))
(define current-orig-pkg (pkg-info-orig-pkg info))
(unless new-pkg-name
(pkg-error (~a "package is not currently installed from a repository\n"
" package: ~a\n"
" current installation: ~a"
(cond
[from-command-line?
(case (car current-orig-pkg)
[(link static-link)
(~a "\n extra advice:\n"
" Your current installation is a directory link, and the directory might\n"
" be a Git repostory checkout, but the package system doesn't know that.\n"
" If so, try\n"
" cd " (simplify-path
(path->complete-path (cadr current-orig-pkg) (pkg-installed-dir)))
"\n"
" raco pkg update --clone . <repository-URL>")]
[else ""])]
[else ""]))
name
current-orig-pkg))
new-pkg-name)]
(define info (package-info name #:db db (not skip-uninstalled?)))
(cond
[(not info)
;; Skipping uninstalled packages
#f]
[else
(define new-pkg-name
(pkg-info->clone-desc name info
#:checksum (pkg-desc-checksum pkg-name)
#:auto? (pkg-desc-auto? pkg-name)
#:extra-path (pkg-desc-extra-path pkg-name)
#:reject-existing-clone? #t))
(define current-orig-pkg (pkg-info-orig-pkg info))
(unless new-pkg-name
(pkg-error (~a "package is not currently installed from a repository\n"
" package: ~a\n"
" current installation: ~a"
(cond
[from-command-line?
(case (car current-orig-pkg)
[(link static-link)
(~a "\n extra advice:\n"
" Your current installation is a directory link, and the directory might\n"
" be a Git repostory checkout, but the package system doesn't know that.\n"
" If so, try\n"
" cd " (simplify-path
(path->complete-path (cadr current-orig-pkg) (pkg-installed-dir)))
"\n"
" raco pkg update --clone . <repository-URL>")]
[else ""])]
[else ""]))
name
current-orig-pkg))
new-pkg-name]))]
[else pkg-name]))
(define ((convert-directory-to-installed-clone db) d)
@ -317,7 +321,7 @@
(case type
[(dir)
(define pkg-name (or (pkg-desc-name d) name))
(define info (package-info pkg-name #:db db))
(define info (package-info pkg-name #:db db #f))
(case (and info
(car (pkg-info-orig-pkg info)))
[(clone)

102
racket/collects/pkg/private/install.rkt
View File

@ -966,6 +966,7 @@
#:use-cache? use-cache?
#:from-command-line? from-command-line?
#:link-dirs? link-dirs?
#:skip-uninstalled? [skip-uninstalled? #f]
#:all-mode? [all-mode? #f]
#:force-update? [force-update? #f])
pkg-name)
@ -985,58 +986,64 @@
(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))
(define new-checksum (checksum-for-pkg-source (pkg-desc-source pkg-name)
type
name
(pkg-desc-checksum pkg-name)
download-printf
#:catalog-lookup-cache catalog-lookup-cache
#:remote-checksum-cache remote-checksum-cache))
(hash-set! update-cache name new-checksum) ; record downloaded checksum
(unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name)))
(unless (equal? (pkg-desc-checksum pkg-name) new-checksum)
(pkg-error (~a "incorrect checksum on package\n"
" package source: ~a\n"
" expected: ~e\n"
" got: ~e")
(pkg-desc-source pkg-name)
(pkg-desc-checksum pkg-name)
new-checksum)))
(if (or force-update?
(not (equal? (pkg-info-checksum info)
new-checksum))
;; No checksum available => always update
(not new-checksum)
;; Different source => always update
(not (same-orig-pkg? (pkg-info-orig-pkg info)
(desc->orig-pkg type
(pkg-desc-source pkg-name)
(pkg-desc-extra-path pkg-name)))))
;; Update:
(begin
(hash-set! update-cache (box name) #t)
(list (pkg-desc (pkg-desc-source pkg-name)
(pkg-desc-type pkg-name)
name
(pkg-desc-checksum pkg-name)
(pkg-desc-auto? pkg-name)
(or (pkg-desc-extra-path pkg-name)
(and (eq? type 'clone)
(current-directory))))))
;; No update needed, but maybe check dependencies:
(if (or deps?
implies?)
(update-loop name #f #f #f)
null))]
(define info (package-info name #:db db (not skip-uninstalled?)))
(cond
[(not info)
;; Not installed, and we're skipping uninstalled
null]
[else
(define new-checksum (checksum-for-pkg-source (pkg-desc-source pkg-name)
type
name
(pkg-desc-checksum pkg-name)
download-printf
#:catalog-lookup-cache catalog-lookup-cache
#:remote-checksum-cache remote-checksum-cache))
(hash-set! update-cache name new-checksum) ; record downloaded checksum
(unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name)))
(unless (equal? (pkg-desc-checksum pkg-name) new-checksum)
(pkg-error (~a "incorrect checksum on package\n"
" package source: ~a\n"
" expected: ~e\n"
" got: ~e")
(pkg-desc-source pkg-name)
(pkg-desc-checksum pkg-name)
new-checksum)))
(if (or force-update?
(not (equal? (pkg-info-checksum info)
new-checksum))
;; No checksum available => always update
(not new-checksum)
;; Different source => always update
(not (same-orig-pkg? (pkg-info-orig-pkg info)
(desc->orig-pkg type
(pkg-desc-source pkg-name)
(pkg-desc-extra-path pkg-name)))))
;; Update:
(begin
(hash-set! update-cache (box name) #t)
(list (pkg-desc (pkg-desc-source pkg-name)
(pkg-desc-type pkg-name)
name
(pkg-desc-checksum pkg-name)
(pkg-desc-auto? pkg-name)
(or (pkg-desc-extra-path pkg-name)
(and (eq? type 'clone)
(current-directory))))))
;; No update needed, but maybe check dependencies:
(if (or deps?
implies?)
(update-loop name #f #f #f)
null))])]
[(hash-ref update-cache (box 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?)
[(package-info pkg-name #:db db (and must-update?
(not skip-uninstalled?)))
=>
(lambda (info)
(match-define (pkg-info orig-pkg checksum auto?) info)
@ -1150,6 +1157,7 @@
#:force? [force? #f]
#:ignore-checksums? [ignore-checksums? #f]
#:strict-doc-conflicts? [strict-doc-conflicts? #f]
#:skip-uninstalled? [skip-uninstalled? #f]
#:use-cache? [use-cache? #t]
#:update-deps? [update-deps? #f]
#:update-implies? [update-implies? #t]
@ -1187,6 +1195,7 @@
#:ignore-checksums? ignore-checksums?
#:use-cache? use-cache?
#:from-command-line? from-command-line?
#:skip-uninstalled? skip-uninstalled?
#:link-dirs? link-dirs?
#:all-mode? all-mode?)
(map (compose
@ -1197,6 +1206,7 @@
(convert-clone-name-to-clone-repo/install catalog-lookup-cache
download-printf)
(convert-clone-name-to-clone-repo/update db
skip-uninstalled?
from-command-line?)))
pkgs)))
(cond