raco pkg install: use `--link' by default for directory sources

The new `--copy' flag provides the old behavior.

pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl

@@ -170,7 +170,8 @@ Unless @racket[quiet?] is true, information about the output is repotred to the
                            [#:force? force? boolean? #f]
                            [#:ignore-checksums? ignore-checksums? boolean? #f]
                            [#:quiet? boolean? quiet? #f]
-                           [#:strip strip (or/c #f 'source 'binary) #f])
+                           [#:strip strip (or/c #f 'source 'binary) #f]
+                           [#:link-dirs? link-dirs? boolean? #f])
          (or/c 'skip
                #f
                (listof (or/c path-string?
@@ -181,6 +182,11 @@ collections should be setup via @exec{raco setup}: @racket['skip]
 means that no setup is needed, @racket[#f] means all, and a list means
 only the indicated collections.
 
+The @racket[link-dirs?] argument determines whether package sources
+inferred to be directory paths should be treated as links or copied
+(like other package sources). Note that the default is @racket[#f],
+unlike the default built into @racket[pkg-install-command].
+
 Status information and debugging details are mostly reported to a logger
 named @racket['pkg], but information that is especially relevant to a
 user (such as a download action) is reported to the current output

pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -301,7 +301,11 @@ sub-sub-commands:
   @item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).}
 
   @item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
-        and links the existing directory as an installed package. The package is identified
+        and links the existing directory as an installed package, instead of copying the
+        directory's content to install. Directory @tech{package sources} are treated as links
+        by default, unless @DFlag{copy} is specified.
+
+        The package is identified
         as a @tech{single-collection package} or a @tech{multi-collection package} at the
         time that it is installed, and that categorization does not change even if the @schemeidfont{collection}
         definition in @filepath{info.rkt} is changed (i.e., he package must be removed and re-installed
@@ -311,9 +315,12 @@ sub-sub-commands:
         of the given directory will not change for each given directory that implements a
         @tech{multi-collection package}.}
 
-  @item{@DFlag{binary} --- Strips source elements of a package before installing.}
+  @item{@DFlag{copy} --- Disables default handling of directory @tech{package sources} as links,
+        and instead treats them like other sources: package content is copied to install.}
 
-  @item{@DFlag{source} --- Strips built elements of a package before installing.}
+  @item{@DFlag{binary} --- Strips source elements of a package before installing, and implies @DFlag{copy}.}
+
+  @item{@DFlag{source} --- Strips built elements of a package before installing, and implies @DFlag{copy}.}
 
   @item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source}
         whose name corresponds to an already-installed package.}

pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt

@@ -13,10 +13,10 @@
  $ "raco pkg install --deps fail test-pkgs/pkg-x/ test-pkgs/pkg-y/" =exit> 1
  $ "raco pkg install --deps fail test-pkgs/pkg-y/ test-pkgs/pkg-x/" =exit> 1
 
- $ "raco pkg install --deps fail test-pkgs/pkg-z/" =exit> 0
+ $ "raco pkg install --deps fail --copy test-pkgs/pkg-z/" =exit> 0
 
  (putenv "PLT_PKG_NOSETUP" "")
- $ "raco pkg install test-pkgs/pkg-x/ test-pkgs/pkg-y/"
+ $ "raco pkg install --copy test-pkgs/pkg-x/ test-pkgs/pkg-y/"
  (putenv "PLT_PKG_NOSETUP" "1")
 
  $ "racket -l racket/base -l x -e '(x)'" =stdout> "'x\n"

pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt

@@ -38,6 +38,10 @@
   (check-equal-values? (package-source->name+type "fish" 'dir) (values "fish" 'dir))
   (check-equal-values? (package-source->name+type "fish!/" 'dir) (values #f 'dir))
 
+  (check-equal-values? (package-source->name+type "fish/" #f #:link-dirs? #t) (values "fish" 'link))
+  (check-equal-values? (package-source->name+type "fish/" 'dir #:link-dirs? #t) (values "fish" 'dir))
+  (check-equal-values? (package-source->name+type "fish.plt" #f #:link-dirs? #t) (values "fish" 'file))
+
   (check-equal? (package-source->name "http://") #f)
 
   (check-equal-values? (package-source->name+type "http://racket-lang.org/fish.plt" #f) (values "fish" 'file-url))

pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt

@@ -32,7 +32,7 @@
  (with-fake-root
   (shelly-case
    "raco install uses raco setup with single collect"
-   $ "raco pkg install test-pkgs/pkg-test3-v3" =exit> 0))
+   $ "raco pkg install --copy test-pkgs/pkg-test3-v3" =exit> 0))
 
  (shelly-begin
   (initialize-catalogs)
@@ -46,7 +46,7 @@
     (shelly-install* "remote packages can be updated"
                      "http://localhost:9999/update-test/pkg-test1.zip"
                      "pkg-test1 pkg-test3"
-                     $ "raco pkg install test-pkgs/pkg-test3"
+                     $ "raco pkg install --copy test-pkgs/pkg-test3"
                      $ "racket -l pkg-test3/number" =exit> 1
                      $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
                      $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"

racket/collects/pkg/lib.rkt

@@ -695,15 +695,18 @@
                             metadata-ns
                             #:strip [strip-mode #f]
                             #:in-place? [in-place? #f]
-                            #:in-place-clean? [in-place-clean? #f])
+                            #:in-place-clean? [in-place-clean? #f]
+                            #:link-dirs? [link-dirs? #f])
   (define-values (inferred-pkg-name type) 
     (if (path? pkg)
         (package-source->name+type (path->string pkg)
                                    (or given-type
                                        (if (directory-exists? pkg)
-                                           'dir
+                                           (if link-dirs?
+                                               'link
+                                               'dir)
                                            'file)))
-        (package-source->name+type pkg given-type)))
+        (package-source->name+type pkg given-type #:link-dirs? link-dirs?)))
   (define pkg-name (or given-pkg-name inferred-pkg-name))
   (when (and type (not pkg-name))
     (pkg-error (~a "could not infer package name from source\n"
@@ -1066,6 +1069,7 @@
          #:install-conversation [install-conversation #f]
          #:update-conversation [update-conversation #f]
          #:strip [strip-mode #f]
+         #:link-dirs? [link-dirs? #f]
          descs)
   (define download-printf (if quiet? void printf/flush))
   (define check-sums? (not ignore-checksums?))
@@ -1323,7 +1327,8 @@
       (stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) 
                           check-sums? download-printf
                           metadata-ns
-                          #:strip strip-mode)))
+                          #:strip strip-mode
+                          #:link-dirs? link-dirs?)))
   ;; For the top-level call, we need to double-check that all provided packages
   ;; were distinct:
   (for/fold ([ht (hash)]) ([i (in-list infos)]
@@ -1447,7 +1452,8 @@
                      #:quiet? [quiet? #f]
                      #:install-conversation [install-conversation #f]
                      #:update-conversation [update-conversation #f]
-                     #:strip [strip-mode #f])
+                     #:strip [strip-mode #f]
+                     #:link-dirs? [link-dirs? #f])
   (define new-descs
     (remove-duplicates
      (if (not skip-installed?)
@@ -1456,10 +1462,8 @@
            (filter (lambda (d)
                      (define pkg-name
                        (or (pkg-desc-name d)
-                           (let-values ([(name type)
+                           (package-source->name (pkg-desc-source d) 
-                                         (package-source->name+type (pkg-desc-source d) 
+                                                 (pkg-desc-type d))))
-                                                                    (pkg-desc-type d))])
-                             name)))
                      (not (hash-ref db pkg-name #f)))
                    descs)))
      pkg-desc=?))
@@ -1492,6 +1496,7 @@
      #:install-conversation install-conversation
      #:update-conversation update-conversation
      #:strip strip-mode
+     #:link-dirs? link-dirs?
      new-descs)))
 
 (define ((update-is-possible? db) pkg-name)
@@ -2360,7 +2365,8 @@
                         #:ignore-checksums? boolean?
                         #:skip-installed? boolean?
                         #:quiet? boolean?
-                        #:strip (or/c #f 'source 'binary))
+                        #:strip (or/c #f 'source 'binary)
+                        #:link-dirs? boolean?)
         (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
   [pkg-migrate
    (->* (string?)

racket/collects/pkg/main.rkt

@@ -74,10 +74,11 @@
   [#:bool force () "Ignores conflicts"]
   [#:bool ignore-checksums () "Ignores checksums"]
   #:once-any
-  [#:bool link () ("Link a directory package source in place")]
+  [#:bool link () ("Link a directory package source in place (default for a directory)")]
   [#:bool static-link () ("Link in place, promising collections do not change")]
-  [#:bool source () ("Strip built elements of the package before installing")]
+  [#:bool copy () ("Treat directory sources the same as other sources")]
-  [#:bool binary () ("Strip source elements of the package before installing")]
+  [#:bool source () ("Strip package's built elements before installing; implies --copy")]
+  [#:bool binary () ("Strip packages' source elements before installing; implies --copy")]
   #:once-each
   [#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
   #:once-any
@@ -104,14 +105,17 @@
        (with-pkg-lock
         (parameterize ([current-pkg-catalogs (and catalog
                                                   (list (catalog->url catalog)))])
+          (define link-dirs? (not (or copy source binary)))
           (pkg-install #:dep-behavior deps
                        #:force? force
                        #:ignore-checksums? ignore-checksums
                        #:skip-installed? skip-installed
                        #:strip (or (and source 'source) (and binary 'binary))
+                       #:link-dirs? link-dirs?
                        (for/list ([p (in-list pkg-source)])
                          (define a-type (or (and link 'link) 
                                             (and static-link 'static-link)
+                                            (and (eq? type 'dir) link-dirs? 'link)
                                             type))
                          (pkg-desc p a-type name #f))))))
      (setup no-setup setup-collects jobs)))]

racket/collects/pkg/name.rkt

@@ -5,7 +5,8 @@
 
 (provide
  (contract-out
-  [package-source->name+type (-> string? (or/c #f symbol?) 
+  [package-source->name+type (->* (string? (or/c #f symbol?))
+                                  (#:link-dirs? boolean?)
                                   (values (or/c #f string?) (or/c #f symbol?)))]
   [package-source->name (-> string? (or/c #f string?))]))
 
@@ -33,7 +34,7 @@
              (and (not (equal? "" (path/param-path (car p))))
                   (path/param-path (car p))))]))
 
-(define (package-source->name+type s type)
+(define (package-source->name+type s type #:link-dirs? [link-dirs? #f])
   ;; returns (values inferred-name inferred-type);
   ;; if `type' is given it should be returned, but name can be #f;
   ;; type should not be #f for a non-#f name
@@ -101,7 +102,7 @@
         (path-string? s))
     (define-values (base name dir?) (split-path s))
     (define dir-name (and (path? name) (path->string name)))
-    (values (validate-name dir-name) (or type (and dir-name 'dir)))]
+    (values (validate-name dir-name) (or type (and dir-name (if link-dirs? 'link 'dir))))]
    [else
     (values #f #f)]))
 

racket/collects/racket/HISTORY.txt

@@ -2,6 +2,8 @@ Version 5.90.0.3
 Base user directoy paths on an installation name instead
  of the Racket version string
 Remove "shared" links and package scope
+raco pkg install: --link is default for directory source; added
+ --copy
 
 Version 5.90.0.2
 Added #%declare