From d962bfa25e68c67494cc92f0c868fd62a0b41ff8 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Wed, 13 Jun 2007 21:01:27 +0000
Subject: [PATCH] path-element

svn: r6641
---
 .../web-server/docs/reference/private.scrbl   |  5 +++--
 collects/web-server/private/util.ss           | 22 +++++++++----------
 .../web-server/tests/private/util-test.ss     |  2 ++
 3 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/collects/web-server/docs/reference/private.scrbl b/collects/web-server/docs/reference/private.scrbl
index 991b4cb9e1..f71a9a8e5b 100644
--- a/collects/web-server/docs/reference/private.scrbl
+++ b/collects/web-server/docs/reference/private.scrbl
@@ -282,6 +282,7 @@ needs. They are provided by @file{private/util.ss}.
 
 @subsection{Contracts}
 @defthing[port-number? contract?]{Equivalent to @scheme[(between/c 1 65535)].}
+@defthing[path-element? contract?]{Equivalent to @scheme[(or/c path? (symbols 'up 'same))].}
 
 @subsection{Lists}
 @defproc[(list-prefix? [l list?]
@@ -292,14 +293,14 @@ needs. They are provided by @file{private/util.ss}.
 
 @subsection{URLs}
 
-@defproc[(url-replace-path [proc (list? . -> . list?)]
+@defproc[(url-replace-path [proc ((listof path/param?) . -> . (listof path/param?))]
                            [u url?])
          url?]{
  Replaces the URL path of @scheme[u] with @scheme[proc] of the former path.
 }
       
 @; XXX Remove use or take url?              
-@defproc[(url-path->string [url-path (listof (or/c string? path/param?))])
+@defproc[(url-path->string [url-path (listof path/param?)])
          string?]{
  Formats @scheme[url-path] as a string with @scheme["/"] as a delimiter
  and no params.
diff --git a/collects/web-server/private/util.ss b/collects/web-server/private/util.ss
index df1633c5f8..b1df33e1bc 100644
--- a/collects/web-server/private/util.ss
+++ b/collects/web-server/private/util.ss
@@ -7,19 +7,21 @@
            (lib "pretty.ss")
            (lib "xml.ss" "xml")
            (lib "url.ss" "net"))
+  (define path-element?
+    (or/c path? (symbols 'up 'same)))
+  
+  (define port-number? (between/c 1 65535))
+  
   (provide/contract
+   [path-element? contract?]
    [port-number? contract?]
    [pretty-print-invalid-xexpr (exn:invalid-xexpr? any/c . -> . void)]
-   [url-replace-path ((list? . -> . list?) url? . -> . url?)]
-   ; XXX need path-element?
-   [explode-path* (path? . -> . (listof (or/c symbol? path?)))]
-   ; XXX need path-element?
-   [path-without-base (path? path? . -> . list?)]
-   ; XXX need path-element?
+   [url-replace-path (((listof path/param?) . -> . (listof path/param?)) url? . -> . url?)]
+   [explode-path* (path? . -> . (listof path-element?))]
+   [path-without-base (path? path? . -> . (listof path-element?))]
    [list-prefix? (list? list? . -> . boolean?)]
-   ; XXX need path-element?
-   [strip-prefix-ups (list? . -> . list?)] 
-   [url-path->string ((listof (or/c string? path/param?)) . -> . string?)]
+   [strip-prefix-ups ((listof path-element?) . -> . (listof path-element?))] 
+   [url-path->string ((listof path/param?) . -> . string?)]
    [network-error ((symbol? string?) (listof any/c) . ->* . (void))]
    [directory-part (path? . -> . path?)]
    ; XXX Eliminate use of this
@@ -29,8 +31,6 @@
    [read/string (string? . -> . serializable?)]
    [write/string (serializable? . -> . string?)])
   
-  (define port-number? (between/c 1 65535))
-      
   (define (pretty-print-invalid-xexpr exn xexpr)
     (define code (exn:invalid-xexpr-code exn))
     (parameterize ([pretty-print-size-hook (lambda (v display? out)
diff --git a/collects/web-server/tests/private/util-test.ss b/collects/web-server/tests/private/util-test.ss
index 57dabcf528..d5ebf6dff1 100644
--- a/collects/web-server/tests/private/util-test.ss
+++ b/collects/web-server/tests/private/util-test.ss
@@ -10,6 +10,8 @@
     (test-suite
      "Utilities"
      
+     ; XXX path-element?
+     
      (test-suite
       "port-number?"
       (test-not-exn "80" (lambda () (contract port-number? 80 'pos 'neg)))