net/url: add relative-path->relative-url-string

pkgs/net-pkgs/net-doc/net/scribblings/url.scrbl

@@ -194,6 +194,17 @@ Converts @racket[URL], which is assumed to be a @racket["file"] URL,
 to a path.}
 
 
+@defproc[(relative-path->relative-url-string [path (and/c (or/c path-string? path-for-some-system?)
+                                                          relative-path?)])
+         string?]{
+
+Converts @racket[path] to a string that parses as a relative URL (with
+forward slashes). Each element of @racket[path] is an element of the
+resulting URL path, and the string form of each element is encoded as
+needed. If @racket[path] is syntactically a directory, then the resulting
+URL ends with @litchar{/}.}
+
+
 @defparam[file-url-path-convention-type kind (or/c 'unix 'windows)]{
 
 Determines the default conversion to and from strings for

pkgs/net-pkgs/net-test/tests/net/url.rkt

@@ -377,6 +377,21 @@
 
      ))
 
+  (test (relative-path->relative-url-string "a")
+        => "a")
+  (test (relative-path->relative-url-string "a/")
+        => "a/")
+  (test (relative-path->relative-url-string "a/b")
+        => "a/b")
+  (test (relative-path->relative-url-string (build-path "a" 'up "b"))
+        => "a/../b")
+  (test (relative-path->relative-url-string (build-path "a" 'same "b" 'up))
+        => "a/./b/../")
+  (test (relative-path->relative-url-string (build-path "a&c;" 'same "b"))
+        => "a%26c%3B/./b")
+  (test (relative-path->relative-url-string (bytes->path '#"\\\\?\\REL\\a\\b/c\\d" 'windows))
+        => "a/b%2Fc/d")
+
   )
 
 (module+ test (require (submod ".." main))) ; for raco test & drdr

racket/collects/net/url.rkt

@@ -593,6 +593,19 @@
               (if (null? url-tail) url-path (append url-path url-tail))
               '() #f)))
 
+(define (relative-path->relative-url-string path)
+  (define s (string-join (for/list ([e (in-list (explode-path path))])
+                           (cond
+                            [(eq? e 'same) "."]
+                            [(eq? e 'up) ".."]
+                            [else
+                             (uri-encode* (path-element->string e))]))
+                         "/"))
+  ;; Add "/" to reflect directory-ness:
+  (let-values ([(base name dir?) (split-path path)])
+    (if dir?
+        (string-append s "/")
+        s)))
 
 (define (url->path url [kind (system-path-convention-type)])
   (file://->path url kind))
@@ -688,6 +701,9 @@
                                (not/c #rx"^[^:/?#]*:")))
                   url?))
  (path->url ((or/c path-string? path-for-some-system?) . -> . url?))
+ (relative-path->relative-url-string ((and/c (or/c path-string? path-for-some-system?)
+                                             relative-path?)
+                                      . -> . string?))
  (url->string (url? . -> . string?))
  (url->path (->* (url?) ((one-of/c 'unix 'windows)) path-for-some-system?))