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

raco pkg install: check for installed before catalog, etc.

Browse Source 
Add an early check for whether a package is installed before
doing more time-consuming work, such as consulting a catalog.
This commit is contained in:
Matthew Flatt 2015-05-16 16:44:46 -06:00
parent 07b8007edb
commit 5aa7ba6f30
1 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -839,17 +839,24 @@
download-printf) download-printf)
given-descs)) given-descs))
(define db (read-pkg-db))
(define filtered-descs (define filtered-descs
(remove-duplicates (remove-duplicates
(if (not skip-installed?) (if (not skip-installed?)
descs descs
(let ([db (read-pkg-db)]) (filter (lambda (d)
(filter (lambda (d) (define pkg-name (desc->name d))
(define pkg-name (desc->name d)) (define i (hash-ref db pkg-name #f))
(define i (hash-ref db pkg-name #f)) (or (not i) (pkg-info-auto? i)))
(or (not i) (pkg-info-auto? i))) descs))
descs)))
pkg-desc=?)) pkg-desc=?))
(unless (or updating?
skip-installed?
force)
(early-check-for-installed filtered-descs db #:wanted? #f))
(define-values (new-descs done-descs done-infos clone-behavior repo-descs (define-values (new-descs done-descs done-infos clone-behavior repo-descs
extra-updating) extra-updating)
(adjust-to-normalize-repos filtered-descs old-descs old-infos (adjust-to-normalize-repos filtered-descs old-descs old-infos
@ -1178,8 +1185,9 @@
(define pkgs (cond (define pkgs (cond
[all-mode? (hash-keys db)] [all-mode? (hash-keys db)]
[else [else
(unless skip-uninstalled? (unless (or skip-uninstalled?
(ensure-installed in-pkgs db)) force?)
(early-check-for-installed in-pkgs db #:wanted? #t))
in-pkgs])) in-pkgs]))
(define update-cache (make-hash)) (define update-cache (make-hash))
(define catalog-lookup-cache (make-hash)) (define catalog-lookup-cache (make-hash))
@ -1281,7 +1289,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(define (ensure-installed in-pkgs db) (define (early-check-for-installed in-pkgs db #:wanted? wanted?)
(for ([d (in-list in-pkgs)]) (for ([d (in-list in-pkgs)])
(define name (define name
(if (pkg-desc? d) (if (pkg-desc? d)
@ -1289,7 +1297,13 @@
(package-source->name (pkg-desc-source d) (package-source->name (pkg-desc-source d)
(pkg-desc-type d))) (pkg-desc-type d)))
(package-source->name d))) (package-source->name d)))
(void (package-info name #:db db)))) (define info (package-info name wanted? #:db db))
(when (and info
(not wanted?)
(not (pkg-info-auto? info)))
(pkg-error (~a "package is already installed\n"
" package: ~a")
name))))
;; ---------------------------------------- ;; ----------------------------------------