raco pkg: improve error reporting for bad URLs

Related to #1257
This commit is contained in:
Matthew Flatt 2016-04-17 09:10:06 -06:00
parent d23b296627
commit f75729ef41

View File

@ -154,7 +154,9 @@
(eq? type 'file-url) (eq? type 'file-url)
(eq? type 'dir-url)) (eq? type 'dir-url))
(regexp-match? #rx"^(https?|github|git)://" s)) (regexp-match? #rx"^(https?|github|git)://" s))
(define url (with-handlers ([exn:fail? (lambda (exn) #f)]) (define url (with-handlers ([exn:fail? (lambda (exn)
(complain "cannot parse URL")
#f)])
(string->url s))) (string->url s)))
(define-values (name name-type) (define-values (name name-type)
(if url (if url
@ -266,18 +268,23 @@
[(and (not type) [(and (not type)
(regexp-match #rx"^file://" s)) (regexp-match #rx"^file://" s))
=> (lambda (m) => (lambda (m)
(define u (string->url s)) (define u (with-handlers ([exn:fail? (lambda (exn)
(complain "cannot parse URL")
#f)])
(string->url s)))
(define query-type (define query-type
(for/or ([q (in-list (url-query u))]) (if u
(and (eq? (car q) 'type) (for/or ([q (in-list (url-query u))])
(cond (and (eq? (car q) 'type)
[(equal? (cdr q) "link") 'link] (cond
[(equal? (cdr q) "static-link") 'static-link] [(equal? (cdr q) "link") 'link]
[(equal? (cdr q) "file") 'file] [(equal? (cdr q) "static-link") 'static-link]
[(equal? (cdr q) "dir") 'dir] [(equal? (cdr q) "file") 'file]
[else [(equal? (cdr q) "dir") 'dir]
(complain "URL contains an unrecognized `type' query") [else
'error])))) (complain "URL contains an unrecognized `type' query")
'error])))
'error))
(if (eq? query-type 'error) (if (eq? query-type 'error)
(values #f 'dir) (values #f 'dir)
;; Note that we're ignoring other query & fragment parts, if any: ;; Note that we're ignoring other query & fragment parts, if any: