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:
parent
74b86f9104
commit
2c3f13fe26
|
@ -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}.
|
||||
|
|
|
@ -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}.}
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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"])
|
||||
|
|
|
@ -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]))
|
||||
|
|
|
@ -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)]))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
Loading…
Reference in New Issue
Block a user