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

package system: change syntax of a GitHub package source to "git://..."

Browse Source 
Besides changing the URL scheme, the tag or branch is optional and
specified as a fragment (inspired by npm). Also, any subpath is expressed
as a "path=..." query (which similarly avoids giving a different meaning
to URLs than `git' itself would). The repository name can have a ".git"
suffix.

The "github://..." format is still supported for compatibility, but
`--type github' adds "git://..." instead of "github://..." if
neither is already present (which is incompatible, since branches
and tags are handled differently for the two forms).

Closes PR 13656

(See the PR for a discussion and my rationale for this choice.)
This commit is contained in:
Matthew Flatt 2013-08-22 08:41:02 -06:00
parent 33c1a7349d
commit e1efd2d98f
8 changed files with 92 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl
View File

@ -370,10 +370,10 @@ on GitHub, then
repository for your package}. After that, your @tech{package source}
is:
@inset{@exec{github://github.com/@nonterm{user}/@nonterm{package}/@nonterm{branch}}}
@inset{@exec{git://github.com/@nonterm{user}/@nonterm{package}}}
Typically, @nonterm{branch} will be @exec{master}, but you may wish to use
different branches for releases and development.
If you want the package to be @nonterm{branch} instead of @exec{master},
then add @filepath{#@nonterm{branch}} to the end of the package source.
Whenever you

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

@ -187,25 +187,33 @@ is the directory name.}
@item{a remote URL naming a GitHub repository -- The format for such
URLs is:
@inset{@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@;
@exec{/}@nonterm{branch-or-tag}@exec{/}@nonterm{subpath}}
@inset{@exec{git://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@;
@optional{@exec{.git}}@optional{@exec{/}}@optional{@exec{?path=}@nonterm{path}}@;
@optional{@exec{#}@nonterm{tag}}}
where @nonterm{subpath} is optional and can contain multiple
@litchar{/}-separated elements.
where @nonterm{path} can contain multiple @litchar{/}-separated
elements to form a path within the repository, and defaults to the
empty path. The @nonterm{tag} can be a branch or tag, and it
defaults to @exec{master}.
For example, @filepath{github://github.com/game/tic-tac-toe/master/}
For example, @filepath{git://github.com/game/tic-tac-toe#master}
is a GitHub package source.
For backward compatibility, an older format is also supported:
@inset{@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@;
@exec{/}@nonterm{tag}@optional{@exec{/}@nonterm{path}}}
The @exec{zip}-formatted archive for the repository (generated by
GitHub for every branch and tag) is used as a remote URL archive path,
except the @tech{checksum} is the hash identifying the branch (or
tag).
A package source is inferred to be a GitHub reference when it
starts with @litchar{github://}; a package source that is otherwise
starts with @litchar{git://} or @litchar{github://}; a package source that is otherwise
specified as a GitHub reference is automatically prefixed with
@filepath{github://github.com/}. The inferred package name
is the last element of @nonterm{subpath} if it is
@filepath{git://github.com/}. The inferred package name
is the last element of @nonterm{path} if it is
non-empty, otherwise the inferred name is @nonterm{repo}.}
@item{a @tech{package name} -- A @tech{package catalog} is

8
pkgs/racket-pkgs/racket-test/tests/pkg/tests-db.rkt
View File

@ -37,10 +37,10 @@
(list
(pkg "p1" "http://a" "" "" "" "")))
(set-pkg! "p1" "http://a" "github:a" "adam" "123" "the first package")
(set-pkg! "p1" "http://a" "adam" "git:a" "123" "the first package")
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "github:a" "adam" "123" "the first package")
(pkg "p1" "http://a" "adam" "git:a" "123" "the first package")
(pkg "p2" "http://b" "" "" "" "")))
;; reverse order of catalogs:
@ -50,7 +50,7 @@
(check-equal? (get-pkgs)
(list
(pkg "p2" "http://b" "" "" "" "")
(pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))
(pkg "p1" "http://a" "adam" "git:a" "123" "the first package")))
(check-equal? (get-pkg-tags "p2" "http://b")
'())
@ -97,6 +97,6 @@
(check-equal? (get-pkgs)
(list
(pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))
(pkg "p1" "http://a" "adam" "git:a" "123" "the first package")))
(delete-file (current-pkg-catalog-file)))

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

@ -91,10 +91,24 @@
(check-equal-values? (parse "github://github.com/fish/master" 'github #rx"three") (values #f 'github #f))
(check-equal-values? (parse "github://github.com/racket/fish.more/release" 'github) (values #f 'github #t))
(check-equal-values? (parse "racket/fish/master" 'github) (values "fish" 'github #t))
(check-equal-values? (parse "racket/fish/master/" 'github) (values "fish" 'github #t))
(check-equal-values? (parse "racket/fish" 'github #rx"three") (values #f 'github #f))
(check-equal-values? (parse "fish" 'github #rx"three") (values #f 'github #f))
(check-equal-values? (parse "git://not-github.com/racket/fish" #f #rx"github.com") (values #f 'github #f))
(check-equal-values? (parse "git://github.com/racket/fish" #f) (values "fish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish/" #f) (values "fish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish.git" #f) (values "fish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish.git/" #f) (values "fish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish.rkt" #f) (values #f 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish#release" #f) (values "fish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish?path=catfish#release" #f) (values "catfish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish?path=catfish/" #f) (values "catfish" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish?path=catfish/bill" #f) (values "bill" 'github #t))
(check-equal-values? (parse "git://github.com/racket/fish/master" 'github #rx"two") (values #f 'github #f))
(check-equal-values? (parse "git://github.com/racket/fish.more" 'github) (values #f 'github #t))
(check-equal-values? (parse "racket/fish" 'github) (values "fish" 'github #t))
(check-equal-values? (parse "racket/fish.git" 'github) (values "fish" 'github #t))
(check-equal-values? (parse "racket/fish/" 'github) (values "fish" 'github #t))
(check-equal-values? (parse "racket/fish/x" 'github #rx"two") (values #f 'github #f))
(check-equal-values? (parse "fish" 'github #rx"two") (values #f 'github #f))
(check-equal-values? (parse "file://fish.plt" #f) (values "fish" 'file #t))
(check-equal-values? (parse "file:///root/fish.plt" #f) (values "fish" 'file #t))

8
pkgs/racket-pkgs/racket-test/tests/pkg/tests-network.rkt
View File

@ -16,17 +16,17 @@
(pkg-tests
(shelly-begin
(shelly-install "remote/github"
"github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1")
"git://github.com/jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1")
(shelly-install "remote/github with slash"
"github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/")
"git://github.com/jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1/")
(shelly-install "remote/github with auto prefix"
"--type github jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/")
"--type github jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1/")
(hash-set! *index-ht-1* "planet2-test1-github-different-checksum"
(hasheq 'checksum
"23eeaee731e72a39bddbacdf1ed6cce3bcf423a5"
'source
"github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/"))
"git://github.com/jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1/"))
(with-fake-root
(shelly-case

6
racket/collects/pkg/lib.rkt
View File

@ -838,9 +838,9 @@
pkg))
(cond
[(and (eq? type 'github)
(not (regexp-match? #rx"^github://" pkg)))
;; Add "github://github.com/"
(stage-package/info (string-append "github://github.com/" pkg) type
(not (regexp-match? #rx"^git(?:hub)?://" pkg)))
;; Add "git://github.com/"
(stage-package/info (string-append "git://github.com/" pkg) type
pkg-name
#:given-checksum given-checksum
check-sums? download-printf

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

@ -107,15 +107,15 @@
(validate-name s complain #f)
(values (and (regexp-match? rx:package-name s) s) 'name)]
[(and (eq? type 'github)
(not (regexp-match? #rx"^github://" s)))
(not (regexp-match? #rx"^git(?:hub)?://" s)))
(package-source->name+type
(string-append "github://github.com/" s)
(string-append "git://github.com/" s)
'github)]
[(if type
(or (eq? type 'github)
(eq? type 'file-url)
(eq? type 'dir-url))
(regexp-match? #rx"^(https?|github)://" s))
(regexp-match? #rx"^(https?|github|git)://" s))
(define url (with-handlers ([exn:fail? (lambda (exn) #f)])
(string->url s)))
(define-values (name name-type)
@ -124,25 +124,40 @@
(cond
[(if type
(eq? type 'github)
(equal? (url-scheme url) "github"))
(unless (equal? (url-scheme url) "github")
(complain "URL scheme is not 'github'"))
(or (equal? (url-scheme url) "github")
(equal? (url-scheme url) "git")))
(unless (or (equal? (url-scheme url) "github")
(equal? (url-scheme url) "git"))
(complain "URL scheme is not 'git' or 'github'"))
(define name
(and (cor (pair? p)
(complain "URL path is empty"))
(cor (equal? "github.com" (url-host url))
(complain "URL host is not 'github.com'"))
(let ([p (if (equal? "" (path/param-path (last p)))
(reverse (cdr (reverse p)))
p)])
(and (cor ((length p) . >= . 3)
(complain "URL does not have at least three path elements"))
(validate-name
(if (= (length p) 3)
(path/param-path (second (reverse p)))
(last-non-empty p))
complain-name
#t)))))
(if (equal? (url-scheme url) "git")
;; git://
(and (cor (or (= (length p) 2)
(and (= (length p) 3)
(equal? "" (path/param-path (caddr p)))))
(complain "URL does not have two path elements (name and repo)"))
(let ([a (assoc 'path (url-query url))])
(define sub (and a (cdr a) (string-split (cdr a) "/")))
(if (pair? sub)
(validate-name (last sub) complain-name #t)
(let ([s (path/param-path (cadr p))])
(validate-name (regexp-replace #rx"[.]git$" s "") complain-name #t)))))
;; github://
(let ([p (if (equal? "" (path/param-path (last p)))
(reverse (cdr (reverse p)))
p)])
(and (cor ((length p) . >= . 3)
(complain "URL does not have at least three path elements"))
(validate-name
(if (= (length p) 3)
(path/param-path (second (reverse p)))
(last-non-empty p))
complain-name
#t))))))
(values name (or type 'github))]
[(if type
(eq? type 'file-url)

14
racket/collects/pkg/util.rkt
View File

@ -53,7 +53,17 @@
(define github-client_secret (make-parameter #f))
(define (split-github-url pkg-url)
(map path/param-path (url-path/no-slash pkg-url)))
(if (equal? (url-scheme pkg-url) "github")
;; github://
(map path/param-path (url-path/no-slash pkg-url))
;; git://
(let* ([paths (map path/param-path (url-path/no-slash pkg-url))])
(list* (car paths)
(regexp-replace* #rx"[.]git$" (cadr paths) "")
(or (url-fragment pkg-url) "master")
(let ([a (assoc 'path (url-query pkg-url))])
(or (and a (cdr a) (string-split (cdr a) "/"))
null))))))
(define (package-url->checksum pkg-url-str [query empty]
#:download-printf [download-printf void]
@ -61,7 +71,7 @@
(define pkg-url
(string->url pkg-url-str))
(match (url-scheme pkg-url)
["github"
[(or "github" "git")
(match-define (list* user repo branch path)
(split-github-url pkg-url))
(define api-u