Cope with trailing slashes in git: urls

This commit is contained in:
Tony Garnock-Jones 2015-09-23 10:31:15 -04:00
parent c6f0cd33e0
commit 1fc417b61d

View File

@ -1163,6 +1163,9 @@
'source_url (package-url->useful-url source))))) 'source_url (package-url->useful-url source)))))
;; Copied from meta/pkg-index/official/static.rkt ;; Copied from meta/pkg-index/official/static.rkt
;; Modified slightly to recognise additional ad-hockery
;; e.g. git://github.com/user/repo/ as well as
;; git://github.com/user/repo (note no trailing slash)
(define (package-url->useful-url pkg-url-str) (define (package-url->useful-url pkg-url-str)
(define pkg-url (define pkg-url
(string->url pkg-url-str)) (string->url pkg-url-str))
@ -1178,15 +1181,16 @@
[_ [_
pkg-url-str])] pkg-url-str])]
["git" ["git"
(match (url-path pkg-url) (match (map path/param-path (url-path pkg-url))
;; xxx make this more robust ;; xxx make this more robust
[(list user repo) [(or (list user repo)
(list user repo ""))
(url->string (url->string
(struct-copy (struct-copy
url pkg-url url pkg-url
[scheme "http"] [scheme "http"]
[path (list user repo (path/param "tree" '()) [path (map (lambda (x) (path/param x '()))
(path/param "master" '()))]))] (list user repo "tree" "master"))]))]
[_ [_
pkg-url-str])] pkg-url-str])]
[_ [_