raco pkg install: change inference of package sources

A file package source is inferred only if suitable file suffix is
present, etc.

collects/planet2/lib.rkt

@@ -259,14 +259,26 @@
          #:updating? [updating? #f]
          #:ignore-checksums? [ignore-checksums? #f]
          #:link? [link? #f]
+         #:type [type #f]
          #:force? [force? #f]
          auto+pkgs)
+  (define (path-match? path-ok? rx path)
+    (define str (if (path? path)
+                    (and path-ok? (path->bytes path))
+                    path))
+    (and str (regexp-match? rx str)))
   (define check-sums? (not ignore-checksums?))
   (define (install-package pkg
+                           #:type [type type]
                            #:pkg-name [given-pkg-name #f])
-    (define pkg-url (and (string? pkg) (string->url pkg)))
     (cond
-      [(file-exists? pkg)
+      [(if type
+           (eq? type 'file)
+           (or
+            (path-match? #t #rx"[.](plt|zip|tar|tgz|tar[.]gz)$" pkg)
+            (and (path? pkg) (not (directory-exists? pkg)))))
+       (unless (file-exists? pkg)
+         (error 'pkg "no such file\n  path: ~e" pkg))
        (define checksum-pth (format "~a.CHECKSUM" pkg))
        (define expected-checksum
          (and (file-exists? checksum-pth)
@@ -301,6 +313,10 @@
              (match pkg-format
                [#"tgz"
                 (untar pkg pkg-dir)]
+               [#"tar"
+                (untar pkg pkg-dir)]
+               [#"gz" ; assuming .tar.gz
+                (untar pkg pkg-dir)]
                [#"zip"
                 (unzip pkg (make-filesystem-entry-reader #:dest pkg-dir))]
                [#"plt"
@@ -311,12 +327,19 @@
              (update-install-info-checksum
               (update-install-info-orig-pkg
                (install-package pkg-dir
+                                #:type 'dir
                                 #:pkg-name pkg-name)
                `(file ,(simple-form-path* pkg)))
               checksum))
            (λ ()
              (delete-directory/files pkg-dir)))]
-      [(directory-exists? pkg)
+      [(if type
+           (eq? type 'dir)
+           (or
+            (path-match? #t #rx"/$" pkg)
+            (and (path? pkg) (directory-exists? pkg))))
+       (unless (directory-exists? pkg)
+         (error 'pkg "no such directory\n  path: ~e" pkg))
        (let ([pkg (directory-path-no-slash pkg)])
          (define pkg-name
            (or given-pkg-name (path->string (file-name-from-path pkg))))
@@ -336,9 +359,17 @@
                           `(dir ,(simple-form-path* pkg))
                           pkg-dir
                           #t #f)]))]
-      [(url-scheme pkg-url)
+      [(and (eq? type 'github)
-       =>
+            (not (path-match? #f #rx"^github://" pkg)))
-       (lambda (scheme)
+       ;; Add "github://github.com/"
+       (install-package (string-append "github://github.com/" pkg))]
+      [(if type
+           (eq? type 'url)
+           (path-match? #f #rx"^(https?|file|github)://" pkg))
+       (let ()
+         (define pkg-url (string->url pkg))
+         (define scheme (url-scheme pkg-url))
+
          (define orig-pkg `(url ,pkg))
          (define checksum (remote-package-checksum orig-pkg))
          (define info
@@ -378,6 +409,7 @@
                          (λ ()
                            (untar tmp.tgz tmp-dir #:strip-components 1)
                            (install-package (path->string package-path)
+                                            #:type 'dir
                                             #:pkg-name given-pkg-name))
                          (λ ()
                            (delete-directory/files tmp-dir))))
@@ -465,7 +497,9 @@
          (update-install-info-checksum
           info
           checksum))]
-      [else
+      [(if type
+           (eq? type 'name)
+           (path-match? #f #rx"^[-+_a-zA-Z0-9]*$" pkg))
        (define index-info (package-index-lookup pkg))
        (define source (hash-ref index-info 'source))
        (define checksum (hash-ref index-info 'checksum))
@@ -479,7 +513,9 @@
         (update-install-info-checksum
          info
          checksum)
-        `(pns ,pkg))]))
+        `(pns ,pkg))]
+      [else
+       (error 'pkg "cannot infer package-name type\n  name: ~e\n" pkg)]))
   (define db (read-pkg-db))
   (define (install-package/outer infos auto+pkg info)
     (match-define (cons auto? pkg)
@@ -604,6 +640,7 @@
                      #:old-auto+pkgs [old-auto+pkgs empty]
                      #:force? [force #f]
                      #:link? [link #f]
+                     #:type [type #f]
                      #:ignore-checksums? [ignore-checksums #f]
                      #:pre-succeed [pre-succeed void]
                      #:dep-behavior [dep-behavior #f]
@@ -619,6 +656,7 @@
                       #:old-auto+pkgs (append old-auto+pkgs pkgs)
                       #:force? force
                       #:link? link
+                      #:type type
                       #:ignore-checksums? ignore-checksums
                       #:dep-behavior dep-behavior
                       #:pre-succeed pre-succeed
@@ -629,6 +667,7 @@
      #:old-auto+pkgs old-auto+pkgs
      #:force? force
      #:link? link
+     #:type type
      #:ignore-checksums? ignore-checksums
      #:dep-behavior dep-behavior
      #:pre-succeed pre-succeed
@@ -816,9 +855,10 @@
   [show-cmd
    (-> void)]
   [install-cmd
-   (->* ((listof (cons/c boolean? string?)))
+   (->* ((listof (cons/c boolean? path-string?)))
         (#:dep-behavior dep-behavior/c
                         #:force? boolean?
                         #:link? boolean?
+                        #:type (or/c #f 'file 'dir 'url 'github 'name)
                         #:ignore-checksums? boolean?)
         void)]))

collects/planet2/main.rkt

@@ -13,6 +13,8 @@
  "This tool is used for managing installed packages."
  [install
   "Install packages"
+  [(#:sym #f) type ("-t") ("type of <pkg-source>: file, dir, url, github, or name"
+                           "If not specified, the type is inferred syntactically")]
   [#:bool dont-setup () "Don't run 'raco setup' after changing packages (generally not a good idea)"]
   [#:bool installation ("-i") "Operate on the installation-wide package database"]
   [(#:sym #f) deps ()
@@ -25,14 +27,16 @@
   [#:bool force () "Ignores conflicts"]
   [#:bool ignore-checksums () "Ignores checksums"]
   [#:bool link () "When used with a directory package, leave the directory in place, but add a link to it in the package directory. This is a global setting for all installs for this command, which means it affects dependencies... so make sure the dependencies exist first."]
-  #:args pkgs
+  #:args pkg-source
   (parameterize ([current-install-system-wide? installation])
     (with-package-lock
      (install-cmd #:dep-behavior deps
                   #:force? force
                   #:link? link
                   #:ignore-checksums? ignore-checksums
-                  (map (curry cons #f) pkgs))
+                  #:type (or type 
+                             (and link 'dir))
+                  (map (curry cons #f) pkg-source))
      (setup dont-setup)))]
  [update
   "Update packages"

collects/planet2/scribblings/planet2.scrbl

@@ -1,4 +1,5 @@
 #lang scribble/manual
+@(require scribble/bnf)
 
 @(define pkgname onscreen)
 @(define reponame litchar)
@@ -6,6 +7,11 @@
 @title{Planet 2: Package Distribution (Beta)}
 @author[@author+email["Jay McCarthy" "jay@racket-lang.org"]]
 
+@(define package-name-chars
+   @list{@litchar{a} through @litchar{z}, 
+         @litchar{A} through @litchar{Z}, 
+         @litchar{_}, @litchar{-}, and @litchar{+}})
+
 Planet 2 is a system for managing the use of external code packages in
 your Racket installation.
 
@@ -19,7 +25,7 @@ metadata}.
 
 @deftech{Package metadata} is:
 @itemlist[
- @item{a name -- a string made of the characters: @litchar{a-zA-Z0-9_-}.}
+ @item{a name -- a string made of the characters @|package-name-chars|.}
  @item{a list of dependencies -- a list of strings that name other packages that must be installed simultaneously.}
  @item{a checksum -- a string that identifies different releases of a package.} 
 ]
@@ -40,21 +46,26 @@ storing the checksum. The valid package source types are:
 
 @item{a local file path naming an archive -- The name of the package
 is the basename of the archive file. The checksum for archive
-@filepath{f.ext} is given by the file @filepath{f.ext.CHECKSUM}. For
+@filepath{f.@nonterm{ext}} is given by the file @filepath{f.@nonterm{ext}.CHECKSUM}. For
 example, @filepath{~/tic-tac-toe.zip}'s checksum would be inside
 @filepath{~/tic-tac-toe.zip.CHECKSUM}. The valid archive formats
-are (currently): @filepath{.zip}, @filepath{.tgz}, and
+are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz}, 
-@filepath{.plt}. }
+@filepath{.tar.gz}, and
+@filepath{.plt}; a package source is inferred to refer to a file
+only when it has one of those suffixes. }
 
 @item{a local directory -- The name of the package is the name of the
 directory. The checksum is not present. For example,
-@filepath{~/tic-tac-toe}.}
+@filepath{~/tic-tac-toe/}. A package source is inferred to refer
+to a directory on when it ends with a directory separator.}
 
 @item{a remote URL naming an archive -- This type follows the same
 rules as a local file path, but the archive and checksum files are
 accessed via HTTP(S). For example,
 @filepath{http://game.com/tic-tac-toe.zip} and
-@filepath{http://game.com/tic-tac-toe.zip.CHECKSUM}.}
+@filepath{http://game.com/tic-tac-toe.zip.CHECKSUM}.
+A package source is inferred to be a URL only when it
+starts with @litchar{http://}, @litchar{https://}, or @litchar{file://}.}
 
 @item{a remote URL naming a directory -- The remote directory must
 contain a file named @filepath{MANIFEST} that lists all the contingent
@@ -63,7 +74,9 @@ for local directory paths are followed. However, if the remote
 directory contains a file named @filepath{.CHECKSUM}, then it is used
 to determine the checksum. For example,
 @filepath{http://game.com/tic-tac-toe/} and
-@filepath{http://game.com/tic-tac-toe/.CHECKSUM}}
+@filepath{http://game.com/tic-tac-toe/.CHECKSUM}. A package name
+is inferred to be a URL the same for a directory or file; the
+interpretation is determined by the URL's resolution.}
 
 @item{a remote URL naming a GitHub repository -- The format for such
 URLs is:
@@ -71,15 +84,21 @@ URLs is:
 Zip formatted archive for the repository (generated by GitHub for
 every branch) is used as a remote URL archive path, except the
 checksum is the hash identifying the branch. For example,
-@filepath{github://github.com/game/tic-tac-toe/master/}.}
+@filepath{github://github.com/game/tic-tac-toe/master/}.
+A package source is inferred to be a GitHub reference when it
+starts with @litchar{github://}; a package source that is otherwise
+specified as a GitHub reference is automatically prefixed with
+@filepath{github://github.com/}.}
 
 @item{a bare package name -- The local list of @tech{package name
 services} is consulted to determine the source and checksum for the
-package. For example, @pkgname{tic-tac-toe}.}
+package. For example, @pkgname{tic-tac-toe}. A package source is inferred
+to be a package name when it fits the grammar of package names, which
+emans that it has only the characters @|package-name-chars|.}
 
 ]
 
-A @deftech{package name service} (PNS) is a string representing a URL,
+A @deftech{package name service} (@deftech{PNS}) is a string representing a URL,
 such that appending @filepath{/pkg/<package-name>} to it will respond
 with a @racket[read]-able hash table with the keys: @racket['source]
 bound to the source and @racket['checksum] bound to the
@@ -130,15 +149,15 @@ sub-sub-commands:
 @itemlist[
 
 @item{@exec{install pkg ...} -- Installs the list of @tech{package
-sources}. The first feasible interpretation of each string as a
+sources}. It
-package source is used. For example, local files are preferred to
-local directories which are preferred to remote URLs, etc. (This is
-only relevant when you have a directory with the same name as a
-package you intend to install from a @tech{package name service}.)  It
 accepts the following options:
 
  @itemlist[
 
+ @item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} -- specifies an interpretation of the package source,
+       where @nonterm{type} is either @litchar{file}, @litchar{dir}, @litchar{url}, @litchar{github}, 
+       or @litchar{name} (to be resolve through a @tech{PNS}).}
+
  @item{@DFlag{dont-setup} -- Does not run @exec{raco setup} after installation. This behavior is also the case if the environment variable @envvar{PLT_PLANET2_DONTSETUP} is set to @litchar{1}.}
 
  @item{@DFlag{installation} -- Install system-wide rather than user-local.}