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

raco pkg remove: only setup needed collections

Browse Source 
That is, limit the ending `raco setup' to the same collections
as the corresponding `raco pkg install' (droppping collections
that no longer exist afterward, of course).
This commit is contained in:
Matthew Flatt 2013-04-16 13:17:05 -06:00
parent 6fe2861877
commit d2b1dc6c63
3 changed files with 64 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/pkg/lib.rkt
View File

@ -479,6 +479,9 @@
(for/or ([scope (in-list '(user shared installation))]) (for/or ([scope (in-list '(user shared installation))])
(parameterize ([current-pkg-scope scope]) (parameterize ([current-pkg-scope scope])
(with-pkg-lock/read-only (with-pkg-lock/read-only
(pkg-directory* pkg-name)))))
(define (pkg-directory* pkg-name)
(define info (package-info pkg-name #f)) (define info (package-info pkg-name #f))
(and info (and info
(let () (let ()
@ -487,7 +490,7 @@
[`(link ,orig-pkg-dir) [`(link ,orig-pkg-dir)
orig-pkg-dir] orig-pkg-dir]
[_ [_
(build-path (pkg-installed-dir) pkg-name)]))))))) (build-path (pkg-installed-dir) pkg-name)]))))
(define (path->pkg given-p) (define (path->pkg given-p)
(define (explode p) (define (explode p)
@ -523,7 +526,7 @@
(printf "Removing ~a\n" pkg-name) (printf "Removing ~a\n" pkg-name)
(match-define (pkg-info orig-pkg checksum _) (match-define (pkg-info orig-pkg checksum _)
(package-info pkg-name)) (package-info pkg-name))
(define pkg-dir (pkg-directory pkg-name)) (define pkg-dir (pkg-directory* pkg-name))
(remove-from-pkg-db! pkg-name) (remove-from-pkg-db! pkg-name)
(match orig-pkg (match orig-pkg
[`(link ,_) [`(link ,_)
@ -561,6 +564,9 @@
(append-map (package-dependencies metadata-ns) (append-map (package-dependencies metadata-ns)
all-pkgs)))) all-pkgs))))
in-pkgs)) in-pkgs))
(define setup-collects
(get-setup-collects (filter-map pkg-directory* pkgs)
metadata-ns))
(unless force? (unless force?
(define pkgs-set (list->set pkgs)) (define pkgs-set (list->set pkgs))
(define remaining-pkg-db-set (define remaining-pkg-db-set
@ -586,7 +592,14 @@
remaining-pkg-db-set))) remaining-pkg-db-set)))
(~a p " (required by: " ds ")")) (~a p " (required by: " ds ")"))
(set->list deps-to-be-removed)))))) (set->list deps-to-be-removed))))))
(for-each remove-package pkgs)) (for-each remove-package pkgs)
;; setup only collections that still exist:
(and setup-collects
(for/list ([c (in-list setup-collects)]
#:when (apply collection-path
(if (path-string? c) (list c) c)
#:fail (lambda (s) #f)))
c)))
;; Downloads a package (if needed) and unpacks it (if needed) into a ;; Downloads a package (if needed) and unpacks it (if needed) into a
;; temporary directory. ;; temporary directory.
@ -948,7 +961,7 @@
[other-pkg (in-hash-keys (car db+with-db))] [other-pkg (in-hash-keys (car db+with-db))]
#:unless (and updating? (equal? other-pkg pkg-name))) #:unless (and updating? (equal? other-pkg pkg-name)))
(and ((cdr db+with-db) (and ((cdr db+with-db)
(lambda () (has-collection-file? (pkg-directory other-pkg)))) (lambda () (has-collection-file? (pkg-directory* other-pkg))))
(cons other-pkg (build-path c f)))) (cons other-pkg (build-path c f))))
;; Compare with simultaneous installs ;; Compare with simultaneous installs
(for/or ([other-pkg-info (in-list infos)] (for/or ([other-pkg-info (in-list infos)]
@ -1048,7 +1061,7 @@
'version (lambda () "0.0")) 'version (lambda () "0.0"))
#f))] #f))]
[else [else
(values (get-metadata metadata-ns (pkg-directory name) (values (get-metadata metadata-ns (pkg-directory* name)
'version (lambda () "0.0")) 'version (lambda () "0.0"))
#t)])) #t)]))
(define inst-vers (if (and this-platform? (define inst-vers (if (and this-platform?
@ -1149,10 +1162,20 @@
(define infos (define infos
(for/list ([v (in-list descs)]) (for/list ([v (in-list descs)])
(stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) check-sums?))) (stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) check-sums?)))
(define setup-collects (define setup-collects (get-setup-collects (map install-info-directory
(append old-infos infos))
metadata-ns))
(define do-its
(map (curry install-package/outer (append old-infos infos))
(append old-descs descs)
(append old-infos infos)))
(pre-succeed)
(for-each (λ (t) (t)) do-its)
setup-collects)
(define (get-setup-collects pkg-directories metadata-ns)
(maybe-append (maybe-append
(for/list ([info (in-list (append old-infos infos))]) (for/list ([pkg-dir (in-list pkg-directories)])
(define pkg-dir (install-info-directory info))
(get-metadata metadata-ns pkg-dir (get-metadata metadata-ns pkg-dir
'setup-collects (lambda () (package-collections 'setup-collects (lambda () (package-collections
pkg-dir pkg-dir
@ -1167,13 +1190,6 @@
(andmap path-string? c)))))) (andmap path-string? c))))))
(pkg-error "bad 'setup-collects value\n value: ~e" (pkg-error "bad 'setup-collects value\n value: ~e"
v))))))) v)))))))
(define do-its
(map (curry install-package/outer (append old-infos infos))
(append old-descs descs)
(append old-infos infos)))
(pre-succeed)
(for-each (λ (t) (t)) do-its)
setup-collects)
(define (pkg-install descs (define (pkg-install descs
#:old-infos [old-infos empty] #:old-infos [old-infos empty]
@ -1242,7 +1258,7 @@
(pkg-desc orig-pkg-source #f pkg-name auto?))])) (pkg-desc orig-pkg-source #f pkg-name auto?))]))
(define ((package-dependencies metadata-ns) pkg-name) (define ((package-dependencies metadata-ns) pkg-name)
(get-metadata metadata-ns (pkg-directory pkg-name) (get-metadata metadata-ns (pkg-directory* pkg-name)
'deps (lambda () empty) 'deps (lambda () empty)
#:checker check-dependencies)) #:checker check-dependencies))
@ -1297,7 +1313,7 @@
(format "~a" checksum) (format "~a" checksum)
(format "~a" orig-pkg) (format "~a" orig-pkg)
(if dir? (if dir?
(list (~a (pkg-directory pkg))) (list (~a (pkg-directory* pkg)))
empty)))))))) empty))))))))
(define (installed-pkg-table #:scope [given-scope #f]) (define (installed-pkg-table #:scope [given-scope #f])
@ -1738,7 +1754,7 @@
(->* ((listof string?)) (->* ((listof string?))
(#:auto? boolean? (#:auto? boolean?
#:force? boolean?) #:force? boolean?)
void?)] (or/c #f (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-show [pkg-show
(->* (string?) (->* (string?)
(#:directory? boolean?) (#:directory? boolean?)

5
collects/pkg/main.rkt
View File

@ -149,10 +149,11 @@
scope installation shared user scope installation shared user
(lambda () (lambda ()
(with-pkg-lock (with-pkg-lock
(define setup-collects
(pkg-remove pkg (pkg-remove pkg
#:auto? auto #:auto? auto
#:force? force) #:force? force))
(setup no-setup #f))))] (setup no-setup setup-collects))))]
[show [show
"Show information about installed packages" "Show information about installed packages"
#:once-each #:once-each

13
collects/pkg/scribblings/lib.scrbl
View File

@ -157,7 +157,8 @@ Implements the @racket[create] command.}
#f] #f]
[#:force? force? boolean? #f] [#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f]) [#:ignore-checksums? ignore-checksums? boolean? #f])
(or/c #f (listof (or/c path-string? (non-empty-listof path-string?))))]{ (or/c #f (listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements the @racket[install] command. The result indicates which Implements the @racket[install] command. The result indicates which
collections should be setup via @exec{raco setup}: @racket[#f] means collections should be setup via @exec{raco setup}: @racket[#f] means
@ -172,7 +173,8 @@ The package lock must be held; see @racket[with-pkg-lock].}
#f] #f]
[#:all? all? boolean? #f] [#:all? all? boolean? #f]
[#:deps? deps? boolean? #f]) [#:deps? deps? boolean? #f])
(or/c #f (listof (or/c path-string? (non-empty-listof path-string?))))]{ (or/c #f (listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements the @racket[update] command. The result is the same as for Implements the @racket[update] command. The result is the same as for
@racket[install-pkgs]. @racket[install-pkgs].
@ -183,9 +185,12 @@ The package lock must be held; see @racket[with-pkg-lock].}
@defproc[(pkg-remove [names (listof string?)] @defproc[(pkg-remove [names (listof string?)]
[#:auto? auto? boolean? #f] [#:auto? auto? boolean? #f]
[#:force? force? boolean? #f]) [#:force? force? boolean? #f])
void?]{ (or/c #f (listof (or/c path-string?
(non-empty-listof path-string?))))]{
Implements the @racket[remove] command. Implements the @racket[remove] command. The result is the same as for
@racket[install-pkgs], indicating collects that should be setup
via @exec{raco setup}.
The package lock must be held; see @racket[with-pkg-lock].} The package lock must be held; see @racket[with-pkg-lock].}