raco pkg update: make update to non-clone suggest more non-clone conversions

In other words, suggestion conversions in the non-clone direction the
same as conversions in the clone direction. As a way of disambiguation
the right direction, the non-clone direction is only suggested for
sharing that is immediately discovered from the command-line arguments
(as opposed to sharing that becomes apparent as other packages are
updated or installed via dependencies).
This commit is contained in:
Matthew Flatt 2014-12-07 06:54:24 -07:00
parent 74b86f9104
commit 2c3f13fe26
6 changed files with 95 additions and 44 deletions

View File

@ -285,6 +285,7 @@ The package lock must be held; see @racket[with-pkg-lock].}
[#:from-command-line? from-command-line? boolean? #f]
[#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
[#:force-strip? force-string? boolean? #f]
[#:lookup-for-clone? lookup-for-clone? boolean? #f]
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
[#:link-dirs? link-dirs? boolean? #f])
(or/c 'skip
@ -301,7 +302,9 @@ indicates a package source that should replace the current
installation; as an exception, if a @racket[package-desc] has the type
@racket['clone] and a source with the syntax of a package name, it
refers to an existing package installation that should be converted to
a Git repository clone.
a Git repository clone---unless @racket[lookup-for-clone?] is true,
in which case the package name is resolved through a catalog to
locate a Git repository clone.
If @racket[from-command-line?] is true, error messages may suggest
specific command-line flags for @command-ref{update}.

View File

@ -548,6 +548,11 @@ sub-commands.
The following modes are available:
@itemlist[
@item{@exec{convert} --- Converts non-clone-linked packages (either newly or previously installed)
to clone-linked packages, assuming that the packages that are clone-linked
all use the same clone directory. If clone-linked packages currently use
different clone directories, installation fails.}
@item{@exec{ask} --- In the case when packages can be converted, ask the user whether to convert
or allow the different clone-linking modes or clone directories. If converting
is not an option, the installation fails. This clone-handling mode is the default
@ -557,11 +562,6 @@ sub-commands.
@item{@exec{force} --- Allows packages to have different clone-linking modes or clone directories.}
@item{@exec{convert} --- Converts non-clone-linked packages (either newly or previously installed)
to clone-linked packages, assuming that the packages that are clone-linked
all use the same clone directory. If clone-linked packages currently use
different clone directories, installation fails.}
]}
@ -638,7 +638,12 @@ argument.
@item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.}
@item{@DFlag{strict-doc-conflicts} --- Same as for @command-ref{install}.}
@item{@DFlag{no-cache} --- Same as for @command-ref{install}.}
@item{@DFlag{multi-clone} @nonterm{mode} --- Same as for @command-ref{install}.}
@item{@DFlag{multi-clone} @nonterm{mode} --- Same as for @command-ref{install}, except that when
@DFlag{lookup} is specified and @DFlag{clone} is not specified, then conversion goes from
clone to non-clone linking---but only for sharing differences implied by the immediate
command-line arguments compared against existing package installations.}
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
@item{@DFlag{batch} --- Same as for @command-ref{install}.}

View File

@ -160,12 +160,12 @@
;; A wacky merge of repsitories will happen here, but the checkout should not
;; get mangled. The package manager should bail out at the point that it would
;; try to rebase the single "a" clone on different commits.
;; try to fast-forward the single "a" clone on different commits.
$ (~a "raco pkg install --clone " (build-path clone-dir "a")
" http://localhost:9998/a/.git?path=one"
" http://localhost:9998/another/a/.git?path=two")
=exit> 1
=stderr> #rx"different target commits"
=stdout> #rx"different target commits"
;; Check that the old repo checkout is not mangled:
$ (~a "racket " (build-path clone-dir "a" "two" "main.rkt")) =stdout> "2\n")))
@ -351,6 +351,15 @@
$ "racket -l three" =stdout> (if (eq? mode 'convert)
"'three\n"
"3\n")))
(when (eq? mode 'convert)
(shelly-case
"Converting back to non-clone"
$ "raco pkg update --multi-clone convert --lookup one"
$ "racket -l two" =stdout> "2\n"
(when three?
(shelly-begin
$ "racket -l three" =stdout> "3\n"))))
(delete-directory/files (build-path clone-dir "a"))
(delete-directory/files a-dir)

View File

@ -642,7 +642,7 @@
#:install-clone-flags
([(#:sym mode [fail force convert ask] #f) multi-clone ()
("Specify treatment of multiple clones of a repository;"
"<mode>s: ask (interactive default), fail (other default), force, or convert")])
"<mode>s: convert, ask (interactive default), fail (other default), or force")])
#:update-deps-flags
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]
[#:bool ignore-implies () "When updating, treat `implies' like other dependencies"])

View File

@ -49,7 +49,8 @@
updating? ; update vs. install mode
catalog-lookup-cache
download-printf
from-command-line?)
from-command-line?
convert-to-non-clone?)
;; A `repo-descs` is (hash repo (hash pkg-name desc) ...)
(define (add-repo repo-descs repo name desc)
(hash-set repo-descs repo
@ -141,7 +142,15 @@
(~a " non-clone packages:"
(format-list non-clones)))))))
(define (convert-to-clones new-clone-behavior)
;; Determine a direction of conversion; we consider converting from
;; clones only for `raco pkg update --lookup`:
(define convert-direction
(cond
[(not (= (hash-count clones) 1)) #f]
[convert-to-non-clone? 'non-clone]
[else 'clone]))
(define (convert-to/from-clones new-clone-behavior)
;; Change `descs` to include each currently non-clone item as a clone
(define clone (car (hash-keys clones)))
(define ht (hash-ref repo-descs repo))
@ -151,20 +160,30 @@
[clone-behavior new-clone-behavior]
[repo-descs repo-descs]
[extra-updates extra-updates])
([name (in-list non-clones)])
([name (in-list (case convert-direction
[(clone) non-clones]
[(non-clone) (car (hash-values clones))]))])
(define desc (hash-ref ht name))
(define converted-desc (convert-desc-to-clone desc clone
catalog-lookup-cache
download-printf))
(define converted-desc
(case convert-direction
[(clone)
(convert-desc-to-clone desc clone
catalog-lookup-cache
download-printf)]
[(non-clone)
(convert-desc-to-lookup desc name)]))
(values (cons converted-desc
(remove-desc-by-name name descs))
(remove-desc-by-name name done-descs)
(remove-info-by-name name done-infos)
clone-behavior
(hash-set repo-descs repo
(hash-set (hash-ref repo-descs repo)
name
converted-desc))
(let ([ht (hash-ref repo-descs repo)])
(case convert-direction
[(clone)
(hash-set ht name converted-desc)]
[(non-clone)
(hash-remove ht name)])))
(if (not (hash-ref (hash-ref new-repo-descs repo) name #f))
;; Count the conversion as an update, not an install,
;; and make sure it's removed before the re-install:
@ -176,22 +195,27 @@
(download-printf "~a\n" (msg #:would "will"))
(continue)]
[(or (eq? clone-behavior 'fail)
((hash-count clones) . > . 1))
(pkg-error "~a" (msg #:convert (if from-command-line?
(not convert-direction))
(pkg-error "~a" (msg #:convert (if (and from-command-line?
convert-direction)
";\n use `--multi-clone ask' for automated help"
"")))]
[(eq? clone-behavior 'convert)
(download-printf "~a\n" (msg #:convert ";\n CONVERTING the non-clone packages to clones"))
(convert-to-clones 'convert)]
(download-printf "~a\n" (msg #:convert (format ";\n CONVERTING the ~aclone packages to ~aclones"
(if (eq? convert-direction 'clone) "non-" "")
(if (eq? convert-direction 'clone) "" "NON-"))))
(convert-to/from-clones 'convert)]
[else
(displayln (msg))
(case (ask "Convert the non-clone packages to clones, too?"
(case (ask (format "Convert the ~aclone packages to ~aclones, too?"
(if (eq? convert-direction 'clone) "non-" "")
(if (eq? convert-direction 'clone) "" "NON-"))
#:default-yes? #f)
[(no) (continue)]
[(yes)
(convert-to-clones 'ask)]
(convert-to/from-clones 'ask)]
[(always-yes)
(convert-to-clones 'convert)]
(convert-to/from-clones 'convert)]
[(cancel)
(pkg-error "canceled")])])])))
@ -377,3 +401,9 @@
(pkg-desc-source d)))]
[type 'clone]
[extra-path clone]))
(define (convert-desc-to-lookup d name)
(struct-copy pkg-desc d
[source name]
[type 'name]
[checksum #f]))

View File

@ -633,7 +633,7 @@
all-descs
all-infos))
;; collapse planned repo actions, and make sure they don't conflict:
;; collapse planned repo actions:
(define repos
(for/fold ([ht (hash)]) ([repo+do-it (in-list repo+do-its)])
(define repo (car repo+do-it))
@ -641,29 +641,28 @@
[repo
(define git-dir (car repo))
(define checksum (cadr repo))
(define prev-checksum (hash-ref ht git-dir #f))
(when (and prev-checksum
(not (equal? prev-checksum checksum)))
(pkg-error (~a "multiple packages in the same clone have different target commits\n"
" clone: ~a\n"
" commit: ~a\n"
" other commit: ~a")
git-dir
prev-checksum
checksum))
(hash-set ht git-dir checksum)]
(define prev-checksums (hash-ref ht git-dir null))
(if (member checksum prev-checksums)
ht
(hash-set ht git-dir (cons checksum prev-checksums)))]
[else ht])))
;; relevant commits have been fecthed to the repos, and now we need
;; to check them out; If a checkout fails, then we've left the
;; to check them out; if a checkout fails, then we've left the
;; package installation in no worse shape than if a manual `git
;; pull` failed
(for ([(git-dir checksum) (in-hash repos)])
(for ([(git-dir checksums) (in-hash repos)])
(parameterize ([current-directory git-dir])
(download-printf "Merging commits at ~a\n"
git-dir)
(git #:status (lambda (s) (download-printf "~a\n" s))
"merge" "--ff-only" checksum)))
(when ((length checksums) . > . 1)
(download-printf (~a "Multiple packages in the of the clone\n"
" " git-dir "\n"
" have different target commits; will try each commit, which will work\n"
" as long as some commit is a fast-forward of all of them\n")))
(for ([checksum (in-list checksums)])
(git #:status (lambda (s) (download-printf "~a\n" s))
"merge" "--ff-only" checksum))))
;; pre-succeed removes packages that are being updated
(pre-succeed)
@ -786,7 +785,8 @@
#:multi-clone-behavior [old-clone-behavior 'fail]
#:repo-descs [old-repo-descs (initial-repo-descs
(read-pkg-db)
(if quiet? void printf))])
(if quiet? void printf))]
#:convert-to-non-clone? [convert-to-non-clone? #f])
(define download-printf (if quiet? void printf))
(define descs
@ -812,7 +812,8 @@
updating?
catalog-lookup-cache
download-printf
from-command-line?))
from-command-line?
convert-to-non-clone?))
(with-handlers* ([vector?
(match-lambda
[(vector updating? new-infos dep-pkg deps more-pre-succeed conv clone-info)
@ -1158,6 +1159,9 @@
#:use-cache? use-cache?
#:link-dirs? link-dirs?
#:multi-clone-behavior clone-behavior
#:convert-to-non-clone? (and lookup-for-clone?
(andmap pkg-desc? in-pkgs)
(not (ormap pkg-desc-extra-path in-pkgs)))
to-update)]))
;; ----------------------------------------