58 lines
2.0 KiB
Racket
58 lines
2.0 KiB
Racket
#lang racket/base
|
|
(require racket/list
|
|
racket/contract
|
|
net/url)
|
|
|
|
(provide/contract
|
|
[url-replace-path (((listof path/param?) . -> . (listof path/param?)) url? . -> . url?)]
|
|
[url-path->string ((listof path/param?) . -> . string?)])
|
|
|
|
;; replace-path: (url-path -> url-path) url -> url
|
|
;; make a new url by replacing the path part of a url with a function
|
|
;; of the url's old path
|
|
;; also remove the query
|
|
(define (url-replace-path proc in-url)
|
|
(let ([new-path (proc (url-path in-url))])
|
|
(make-url
|
|
(url-scheme in-url)
|
|
(url-user in-url)
|
|
(url-host in-url)
|
|
(url-port in-url)
|
|
(url-path-absolute? in-url)
|
|
new-path
|
|
empty
|
|
(url-fragment in-url))))
|
|
;; Eli: if it also removes the query, this it's a bad name, and it's
|
|
;; questionable whether it is general enough. Why not make it into a
|
|
;; keyworded function that can change any part, which sounds like a much more
|
|
;; useful utility? Some `foo' that would allow:
|
|
;; (define (url-replace-path proc in-url)
|
|
;; (foo in-url #:path (proc (url-path in-url)) #:query '()))
|
|
;; or even accept a changing function for all keywords:
|
|
;; (define (url-replace-path proc in-url)
|
|
;; (foo in-url #:path proc #:query '()))
|
|
|
|
;; ripped this off from url-unit.rkt
|
|
(define (url-path->string strs)
|
|
(apply string-append
|
|
(apply append
|
|
(map (lambda (s) (list "/" (maybe-join-params s)))
|
|
strs))))
|
|
|
|
;; needs to unquote things!
|
|
(define (maybe-join-params s)
|
|
(if (string? s)
|
|
s
|
|
(let ([s (path/param-path s)])
|
|
(if (string? s)
|
|
s
|
|
(case s
|
|
[(same) "."]
|
|
[(up) ".."]
|
|
[else (error 'maybe-join-params
|
|
"bad value from path/param-path: ~e" s)])))))
|
|
;; Eli: I don't know what this is supposed to be doing -- I don't see any
|
|
;; "maybe"ness), it throws away the `path/param-param's, and it accepts
|
|
;; strings too (which makes me wonder how is this related to the url
|
|
;; library).
|