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

support file:// URLs as package sources

Browse Source
This commit is contained in:
Matthew Flatt 2013-08-20 09:24:03 -06:00
parent ffd4ea5b6c
commit 21d3c168a0
3 changed files with 31 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -125,7 +125,7 @@ but the @filepath{.plt} format does not accommodate a
A package source is inferred to refer to a file
only when it has a suffix matching a valid archive format
and when it does not start
and when it starts with @litchar{file://} or does not start
with alphabetic characters followed by @litchar{://}. The inferred
package name is the filename without its suffix.}
@ -135,7 +135,8 @@ directory. The @tech{checksum} is not present. For example,
A package source is inferred to refer
to a directory only when it does not have a file-archive suffix, does
not match the grammar of a package name, and does not start
not match the grammar of a package name, and either starts with starts
with @litchar{file://} or does not start
with alphabetic characters followed by @litchar{://}. The inferred
package name is the directory name.}

5
pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt
View File

@ -72,6 +72,11 @@
(check-equal-values? (package-source->name+type "fish/master" 'github) (values #f 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish.more/release" 'github) (values #f 'github))
(check-equal-values? (package-source->name+type "file://fish.plt" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "file:///root/fish.plt" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "file://fish" #f) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "file:///root/fish" #f) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "random://racket-lang.org/fish.plt" #f) (values #f #f))
(void))

39
racket/collects/pkg/name.rkt
View File

@ -40,6 +40,25 @@
;; 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
(define (parse-path s)
(cond
[(if type
(eq? type 'file)
(and (path-string? s)
(regexp-match rx:archive s)))
(define-values (base name+ext dir?) (split-path s))
(define name (extract-archive-name name+ext))
(values name 'file)]
[(if type
(or (eq? type 'dir)
(eq? type 'link)
(eq? type 'static-link))
(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 (if link-dirs? 'link 'dir))))]
[else
(values #f #f)]))
(cond
[(if type
(eq? type 'name)
@ -87,26 +106,14 @@
(values (validate-name (last-non-empty p)) 'dir-url)]))
(values #f #f)))
(values (validate-name name) (or type (and name-type)))]
[(and (not type)
(regexp-match #rx"^file://(.*)$" s))
=> (lambda (m) (parse-path (cadr m)))]
[(and (not type)
(regexp-match? #rx"^[a-zA-Z]*://" s))
(values #f #f)]
[(if type
(eq? type 'file)
(and (path-string? s)
(regexp-match rx:archive s)))
(define-values (base name+ext dir?) (split-path s))
(define name (extract-archive-name name+ext))
(values name 'file)]
[(if type
(or (eq? type 'dir)
(eq? type 'link)
(eq? type 'static-link))
(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 (if link-dirs? 'link 'dir))))]
[else
(values #f #f)]))
(parse-path s)]))
(define (package-source->name s [given-type #f])
(define-values (name type) (package-source->name+type s given-type))