parent
d23b296627
commit
f75729ef41
|
@ -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:
|
||||||
|
|
Loading…
Reference in New Issue
Block a user