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

raco pkg: work with git tags as well as branches

Browse Source
This commit is contained in:
Matthew Flatt 2013-09-01 08:47:40 -06:00
parent 6530062120
commit 61e6279c49
2 changed files with 38 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,6 +26,10 @@
"remote/github with auto prefix and with branch"
"--type github mflatt/pkg-test?path=pkg-test1/#alt"
$ "racket -l racket/base -l pkg-test1/number -e '(number)'" =stdout> "10\n")
(shelly-install
"remote/github with tag"
"git://github.com/mflatt/pkg-test?path=pkg-test1/#hundred"
$ "racket -l racket/base -l pkg-test1/number -e '(number)'" =stdout> "100\n")
(shelly-install
"remote/github with checksum"
"--checksum f9b4eef22cdd9ab88b254cb027fc1ebe7fb596fd git://github.com/mflatt/pkg-test?path=pkg-test1"

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

@ -76,39 +76,40 @@
[(or "github" "git")
(match-define (list* user repo branch path)
(split-github-url pkg-url))
(define api-u
(url "https" #f "api.github.com" #f #t
(map (λ (x) (path/param x empty))
(list "repos" user repo "branches"))
(append query
(if (and (github-client_id)
(github-client_secret))
(list (cons 'client_id (github-client_id))
(cons 'client_secret (github-client_secret)))
empty))
#f))
(download-printf "Querying GitHub\n")
(log-pkg-debug "Querying GitHub at ~a" (url->string api-u))
(define api-bs
(call/input-url+200
api-u port->bytes
#:headers (list (format "User-Agent: raco-pkg/~a" (version)))))
(unless api-bs
(error 'package-url->checksum
"could not connect to GitHub\n URL: ~a"
(url->string api-u)))
(define branches
(read-json (open-input-bytes api-bs)))
(unless (and (list? branches)
(andmap hash? branches)
(andmap (λ (b) (hash-has-key? b 'name)) branches)
(andmap (λ (b) (hash-has-key? b 'commit)) branches))
(error 'package-url->checksum
"Invalid response from Github: ~e"
api-bs))
(for/or ([b (in-list branches)])
(and (equal? (hash-ref b 'name) branch)
(hash-ref (hash-ref b 'commit) 'sha)))]
(for/or ([kind '("branches" "tags")])
(define api-u
(url "https" #f "api.github.com" #f #t
(map (λ (x) (path/param x empty))
(list "repos" user repo kind))
(append query
(if (and (github-client_id)
(github-client_secret))
(list (cons 'client_id (github-client_id))
(cons 'client_secret (github-client_secret)))
empty))
#f))
(download-printf "Querying GitHub ~a\n" kind)
(log-pkg-debug "Querying GitHub at ~a" (url->string api-u))
(define api-bs
(call/input-url+200
api-u port->bytes
#:headers (list (format "User-Agent: raco-pkg/~a" (version)))))
(unless api-bs
(error 'package-url->checksum
"could not connect to GitHub\n URL: ~a"
(url->string api-u)))
(define branches
(read-json (open-input-bytes api-bs)))
(unless (and (list? branches)
(andmap hash? branches)
(andmap (λ (b) (hash-has-key? b 'name)) branches)
(andmap (λ (b) (hash-has-key? b 'commit)) branches))
(error 'package-url->checksum
"Invalid response from Github: ~e"
api-bs))
(for/or ([b (in-list branches)])
(and (equal? (hash-ref b 'name) branch)
(hash-ref (hash-ref b 'commit) 'sha))))]
[_
(define u (string-append pkg-url-str ".CHECKSUM"))
(download-printf "Downloading checksum for ~a\n" pkg-name)