From 6ae2c71ed510c12e5879675cecda7986f75219d3 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 13 Feb 2013 07:47:42 -0700 Subject: [PATCH] Add raco show -d and showing package deps on failed remove --- collects/planet2/lib.rkt | 49 +++++++++++++------ collects/planet2/main.rkt | 7 ++- collects/planet2/scribblings/planet2.scrbl | 2 + .../planet2/test-pkgs/planet2-test2/info.rkt | 2 +- collects/tests/planet2/tests-remove.rkt | 4 +- 5 files changed, 44 insertions(+), 20 deletions(-) diff --git a/collects/planet2/lib.rkt b/collects/planet2/lib.rkt index 745c45c52b..61fe82e5e6 100644 --- a/collects/planet2/lib.rkt +++ b/collects/planet2/lib.rkt @@ -133,7 +133,7 @@ (with-handlers ([exn:fail? (λ (x) (log-exn x "getting info") #f)]) - (get-info/full pkg-dir #:namespace metadata-ns))) + (get-info/full pkg-dir #:namespace metadata-ns))) (define v (if get-info (get-info key get-default) @@ -330,6 +330,7 @@ (build-path (pkg-installed-dir) pkg-name)])) (define (remove-package pkg-name) + (printf "Removing ~a\n" pkg-name) (match-define (pkg-info orig-pkg checksum _) (package-info pkg-name)) (define pkg-dir (package-directory pkg-name)) @@ -381,11 +382,20 @@ (list->set (append-map (package-dependencies metadata-ns) (set->list - remaining-pkg-db-set))))) + remaining-pkg-db-set))))) (unless (set-empty? deps-to-be-removed) (pkg-error (~a "cannot remove packages that are dependencies of other packages\n" " dependencies:~a") - (format-list (set->list deps-to-be-removed))))) + (format-list + (map + (λ (p) + (define ds + (filter (λ (dp) + (member p ((package-dependencies metadata-ns) dp))) + (set->list + remaining-pkg-db-set))) + (~a p " (required by: " ds ")")) + (set->list deps-to-be-removed)))))) (for-each remove-package pkgs)) (define (install-packages @@ -1014,7 +1024,7 @@ ;; preseved from install time: (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 (package-directory pkg-name) 'deps (lambda () empty) #:checker check-dependencies)) @@ -1040,13 +1050,14 @@ (printf "No updates available\n") #f] [else + (printf "Updating: ~a\n" to-update) (install-cmd #:updating? #t #:pre-succeed (λ () (for-each (compose remove-package pkg-desc-name) to-update)) #:dep-behavior dep-behavior to-update)])) -(define (show-cmd indent) +(define (show-cmd indent #:directory? [dir? #f]) (let () (define db (read-pkg-db)) (define pkgs (sort (hash-keys db) string-ci<=?)) @@ -1054,17 +1065,23 @@ (printf " [none]\n") (table-display (list* - (list (format "~aPackage[*=auto]" indent) "Checksum" "Source") + (list* (format "~aPackage[*=auto]" indent) "Checksum" "Source" + (if dir? + (list "Directory") + empty)) (for/list ([pkg (in-list pkgs)]) (match-define (pkg-info orig-pkg checksum auto?) (hash-ref db pkg)) - (list (format "~a~a~a" - indent - pkg - (if auto? - "*" - "")) - (format "~a" checksum) - (format "~a" orig-pkg)))))))) + (list* (format "~a~a~a" + indent + pkg + (if auto? + "*" + "")) + (format "~a" checksum) + (format "~a" orig-pkg) + (if dir? + (list (~a (package-directory pkg))) + empty)))))))) (define (config-cmd config:set key+vals) (cond @@ -1212,7 +1229,9 @@ #:force? boolean?) void)] [show-cmd - (-> string? void)] + (->* (string?) + (#:directory? boolean?) + void)] [install-cmd (->* ((listof pkg-desc?)) (#:dep-behavior dep-behavior/c diff --git a/collects/planet2/main.rkt b/collects/planet2/main.rkt index 10539ec572..4ee588df4b 100644 --- a/collects/planet2/main.rkt +++ b/collects/planet2/main.rkt @@ -155,6 +155,8 @@ (setup no-setup installation #f))))] [show "Show information about installed packages" + #:once-each + [#:bool dir ("-d") "Show the directory where the package is installed"] #:once-any [(#:sym scope [installation user shared] #f) scope () ("Show only for package , one of" @@ -182,13 +184,14 @@ (printf "~a\n" (case mode [(i) "Installation-wide:"] [(s) "User-specific, all-version:"] - [(u) "User-specific, version-specific:"]))) + [(u) (format "User-specific, version-specific (~a):" + (or version (r:version)))]))) (parameterize ([current-install-system-wide? (eq? mode 'i)] [current-install-version-specific? (eq? mode 'u)] [current-pkg-error (pkg-error 'show)] [current-show-version (or version (r:version))]) (with-package-lock/read-only - (show-cmd (if only-mode "" " "))))))] + (show-cmd (if only-mode "" " ") #:directory? dir)))))] [config "View and modify the package configuration" #:once-each diff --git a/collects/planet2/scribblings/planet2.scrbl b/collects/planet2/scribblings/planet2.scrbl index 050d50e454..e97e110247 100644 --- a/collects/planet2/scribblings/planet2.scrbl +++ b/collects/planet2/scribblings/planet2.scrbl @@ -343,6 +343,8 @@ listed, this command fails atomically. It accepts the following @nonterm{option} @itemlist[ + @item{@Flag{d} --- Adds a column in the output for the directory the package is installed to.} + @item{@DFlag{scope} @nonterm{scope} --- Shows only packages in @nonterm{scope}, which is one of @itemlist[ @item{@exec{installation} --- Show only installation-wide packages.} diff --git a/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt b/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt index 62819cf0e9..67fb19df19 100644 --- a/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt +++ b/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt @@ -1,3 +1,3 @@ #lang setup/infotab -(define deps '("planet2-test1")) +(define deps (list "planet2-test1")) diff --git a/collects/tests/planet2/tests-remove.rkt b/collects/tests/planet2/tests-remove.rkt index 6d3a3d70b6..f6bf6e477f 100644 --- a/collects/tests/planet2/tests-remove.rkt +++ b/collects/tests/planet2/tests-remove.rkt @@ -16,7 +16,7 @@ (pkg-tests (shelly-begin (initialize-indexes) - + (shelly-case "remove and show" (shelly-case "remove of not installed package fails" @@ -29,7 +29,7 @@ $ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\nplanet2-test1 +[a-f0-9]+ +\\(file .+tests/planet2/test-pkgs/planet2-test1.zip\\)\n" $ "raco pkg install test-pkgs/planet2-test2.zip" $ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\nplanet2-test1 +[a-f0-9]+ +\\(file .+tests/planet2/test-pkgs/planet2-test1.zip\\)\nplanet2-test2 +[a-f0-9]+ +\\(file .+tests/planet2/test-pkgs/planet2-test2.zip\\)\n" - $ "raco pkg remove planet2-test1" =exit> 1 + $ "raco pkg remove planet2-test1" =exit> 1 =stderr> #rx"planet2-test1 \\(required by: \\(planet2-test2\\)\\)" $ "raco pkg remove planet2-test2" $ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\nplanet2-test1 +[a-f0-9]+ +\\(file .+tests/planet2/test-pkgs/planet2-test1.zip\\)\n") (shelly-install "remove of dep can be forced"