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

Add raco show -d and showing package deps on failed remove

Browse Source
This commit is contained in:
Jay McCarthy 2013-02-13 07:47:42 -07:00
parent 4494788017
commit 6ae2c71ed5
5 changed files with 44 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/planet2/lib.rkt
View File

@ -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

7
collects/planet2/main.rkt
View File

@ -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 <scope>, 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

2
collects/planet2/scribblings/planet2.scrbl
View File

@ -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.}

2
collects/tests/planet2/test-pkgs/planet2-test2/info.rkt
View File

@ -1,3 +1,3 @@
#lang setup/infotab
(define deps '("planet2-test1"))
(define deps (list "planet2-test1"))

4
collects/tests/planet2/tests-remove.rkt
View File

@ -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"