removed unstable/path (moved code back to single use in web-server)

collects/unstable/path.rkt

@@ -1,79 +0,0 @@
-#lang racket/base
-(require racket/contract/base
-         unstable/list
-         unstable/contract)
-
-; explode-path* : path? -> (listof path?)
-(define (explode-path* p)
-  (let loop ([p p] [r null])
-    (cond 
-      [(eq? 'relative p) r]
-      [(not p) r]
-      [else
-       (let-values ([(base name dir?) (split-path p)])
-         (loop base (list* name r)))])))
-;; Eli: We already have `explode-path', this looks like it's doing the
-;;   same thing, except a little less useful.
-
-; strip-prefix-ups : (listof path-piece?) -> (listof path-piece?)
-(define (strip-prefix-ups l)
-  (define prefix? (box #t))
-  (filter (lambda (p)
-            (if (unbox prefix?)
-                (if (eq? 'up p)
-                    #f
-                    (begin #t
-                           (set-box! prefix? #f)))
-                #t))
-          l))
-;; Eli: This is bad.  If I understand it correctly, this is what this
-;;   *should* have been:
-;;     (define (strip-prefix-ups l)
-;;       (if (and (pair? l) (eq? 'up (car l))) (strip-prefix-ups (cdr l)) l))
-;;   or even:
-;;     (define (strip-prefix-ups l)
-;;       (match l [(cons 'up l) (strip-prefix-ups l)] [_ l]))
-;;   except that the above version manages to combine ugly and
-;;   obfuscated code, redundant mutation, redundant code (why is it a
-;;   box? why is there a (begin #t ...)?), and being extra slow.  Oh,
-;;   and if this wasn't enough, there's exactly one place in the web
-;;   server that uses it.
-
-; path-without-base : path? path? -> (listof path-piece?)
-(define (path-without-base base path)
-  (define b (explode-path* base))
-  (define p (explode-path* path))
-  (if (list-prefix? b p)
-      (list-tail p (length b))
-      (error 'path-without-base "~a is not a prefix of ~a" base path)))
-;; Eli: see my comment on `list-prefix?' -- it would make this trivial.
-;;   Also, if you want to look for a useful utility to add, search the code for
-;;   `relativize', which is a popular thing that gets written multiple times
-;;   and would be nice to have as a library.  (But there are some differences
-;;   between them, I think.)
-
-;; build-path-unless-absolute : path-string? path-string? -> path?
-(define (build-path-unless-absolute base path)
-  (if (absolute-path? path)
-      (build-path path)
-      (build-path base path)))
-;; Eli: This looks completely unnecessary.  I find the code much easier to
-;;   understand than the long name.
-
-(define (directory-part path)
-  (let-values ([(base name must-be-dir) (split-path path)])
-    (cond
-      [(eq? 'relative base) (current-directory)]
-      [(not base) (error 'directory-part "~a is a top-level directory" path)]
-      [(path? base) base])))
-;; Eli: There is now a `file-name-from-path', which suggests that the name for
-;;   this should be `directory-name-from-path', but perhaps a new name is
-;;   better for both.  Also, I find it questionable to return the current
-;;   directory in the first case.
-
-(provide/contract
- [explode-path* (path-string? . -> . (listof path-piece?))]
- [path-without-base (path-string? path-string? . -> . (listof path-piece?))]
- [strip-prefix-ups ((listof path-piece?) . -> . (listof path-piece?))] 
- [directory-part (path-string? . -> . path?)]
- [build-path-unless-absolute (path-string? path-string? . -> . path?)])

collects/unstable/scribblings/path.scrbl

@@ -1,43 +0,0 @@
-#lang scribble/doc
-@(require scribble/base
-          scribble/manual
-          "utils.rkt"
-          (for-label unstable/path
-                     unstable/contract
-                     racket/contract
-                     racket/base))
-
-@title[#:tag "path"]{Path}
-
-@defmodule[unstable/path]
-
-@unstable-header[]
-
-@defproc[(explode-path* [p path-string?])
-         (listof path-piece?)]{
- Like @racket[normalize-path], but does not resolve symlinks.
-}
-
-@defproc[(path-without-base [base path-string?]
-                            [p path-string?])
-         (listof path-piece?)]{
- Returns, as a list, the portion of @racket[p] after @racket[base],
- assuming @racket[base] is a prefix of @racket[p].
-}
-
-@defproc[(directory-part [p path-string?])
-         path?]{
- Returns the directory part of @racket[p], returning @racket[(current-directory)]
- if it is relative.
-}
-
-@defproc[(build-path-unless-absolute [base path-string?]
-                                     [p path-string?])
-         path?]{
- Prepends @racket[base] to @racket[p], unless @racket[p] is absolute.
-}
-
-@defproc[(strip-prefix-ups [p (listof path-piece?)])
-         (listof path-piece?)]{
- Removes all the prefix @racket[".."]s from @racket[p].
-}

collects/unstable/scribblings/unstable.scrbl

@@ -93,7 +93,6 @@ Keep documentation and tests up to date.
 @include-section["parameter-group.scrbl"]
 @include-section["match.scrbl"]
 @include-section["net.scrbl"]
-@include-section["path.scrbl"]
 @include-section["port.scrbl"]
 @include-section["pretty.scrbl"]
 @include-section["require.scrbl"]

collects/unstable/tests/test-docs-complete.rkt

@@ -9,7 +9,6 @@
 (check-docs (quote unstable/prop-contract))
 (check-docs (quote unstable/pretty))
 (check-docs (quote unstable/port))
-(check-docs (quote unstable/path))
 (check-docs (quote unstable/mutated-vars))
 (check-docs (quote unstable/match))
 (check-docs (quote unstable/markparam) #:skip #rx"^deserialize-info:")

collects/web-server/private/util.rkt

@@ -1,8 +1,10 @@
 #lang racket/base
+(require racket/contract/base
+         unstable/list
+         unstable/contract)
 (require unstable/bytes
          unstable/contract
          unstable/list
-         unstable/path
          unstable/string
          unstable/net/url)
 (provide
@@ -10,12 +12,10 @@
   unstable/bytes
   unstable/contract
   unstable/list
-  unstable/path
   unstable/string
   unstable/net/url))
 
-(require racket/contract/base
-         (for-syntax racket/base))
+;; --
 
 ;; network-error: symbol string . values -> void
 ;; throws a formatted exn:fail:network
@@ -34,3 +34,80 @@
 (provide/contract
  [network-error (->* [symbol? string?] [] #:rest list? void?)]
  [exn->string (-> any/c string?)])
+
+;; --
+
+; explode-path* : path? -> (listof path?)
+(define (explode-path* p)
+  (let loop ([p p] [r null])
+    (cond 
+      [(eq? 'relative p) r]
+      [(not p) r]
+      [else
+       (let-values ([(base name dir?) (split-path p)])
+         (loop base (list* name r)))])))
+;; Eli: We already have `explode-path', this looks like it's doing the
+;;   same thing, except a little less useful.
+
+; strip-prefix-ups : (listof path-piece?) -> (listof path-piece?)
+(define (strip-prefix-ups l)
+  (define prefix? (box #t))
+  (filter (lambda (p)
+            (if (unbox prefix?)
+                (if (eq? 'up p)
+                    #f
+                    (begin #t
+                           (set-box! prefix? #f)))
+                #t))
+          l))
+;; Eli: This is bad.  If I understand it correctly, this is what this
+;;   *should* have been:
+;;     (define (strip-prefix-ups l)
+;;       (if (and (pair? l) (eq? 'up (car l))) (strip-prefix-ups (cdr l)) l))
+;;   or even:
+;;     (define (strip-prefix-ups l)
+;;       (match l [(cons 'up l) (strip-prefix-ups l)] [_ l]))
+;;   except that the above version manages to combine ugly and
+;;   obfuscated code, redundant mutation, redundant code (why is it a
+;;   box? why is there a (begin #t ...)?), and being extra slow.  Oh,
+;;   and if this wasn't enough, there's exactly one place in the web
+;;   server that uses it.
+
+; path-without-base : path? path? -> (listof path-piece?)
+(define (path-without-base base path)
+  (define b (explode-path* base))
+  (define p (explode-path* path))
+  (if (list-prefix? b p)
+      (list-tail p (length b))
+      (error 'path-without-base "~a is not a prefix of ~a" base path)))
+;; Eli: see my comment on `list-prefix?' -- it would make this trivial.
+;;   Also, if you want to look for a useful utility to add, search the code for
+;;   `relativize', which is a popular thing that gets written multiple times
+;;   and would be nice to have as a library.  (But there are some differences
+;;   between them, I think.)
+
+;; build-path-unless-absolute : path-string? path-string? -> path?
+(define (build-path-unless-absolute base path)
+  (if (absolute-path? path)
+      (build-path path)
+      (build-path base path)))
+;; Eli: This looks completely unnecessary.  I find the code much easier to
+;;   understand than the long name.
+
+(define (directory-part path)
+  (let-values ([(base name must-be-dir) (split-path path)])
+    (cond
+      [(eq? 'relative base) (current-directory)]
+      [(not base) (error 'directory-part "~a is a top-level directory" path)]
+      [(path? base) base])))
+;; Eli: There is now a `file-name-from-path', which suggests that the name for
+;;   this should be `directory-name-from-path', but perhaps a new name is
+;;   better for both.  Also, I find it questionable to return the current
+;;   directory in the first case.
+
+(provide/contract
+ [explode-path* (path-string? . -> . (listof path-piece?))]
+ [path-without-base (path-string? path-string? . -> . (listof path-piece?))]
+ [strip-prefix-ups ((listof path-piece?) . -> . (listof path-piece?))] 
+ [directory-part (path-string? . -> . path?)]
+ [build-path-unless-absolute (path-string? path-string? . -> . path?)])