Initial import of unstable with libraries from web-server

svn: r16609

collects/unstable/bytes.ss

@@ -0,0 +1,19 @@
+#lang scheme
+(require scheme/serialize)
+
+(provide/contract
+ [read/bytes (bytes? . -> . serializable?)]
+ [write/bytes (serializable? . -> . bytes?)]
+ [bytes-ci=? (bytes? bytes? . -> . boolean?)])
+
+(define (bytes-ci=? b0 b1)
+  (string-ci=? (bytes->string/utf-8 b0)
+               (bytes->string/utf-8 b1)))
+
+(define (read/bytes bs)
+  (read (open-input-bytes bs)))
+
+(define (write/bytes v)
+  (define by (open-output-bytes))
+  (write v by)
+  (get-output-bytes by))

collects/unstable/contract.ss

@@ -0,0 +1,15 @@
+#lang scheme
+
+(define path-element?
+  (or/c path-string? (symbols 'up 'same)))
+
+(define port-number? (between/c 1 65535))
+
+(define non-empty-string/c
+  (and/c string?
+         (lambda (s) (not (zero? (string-length s))))))
+
+(provide/contract
+ [non-empty-string/c contract?]
+ [path-element? contract?]
+ [port-number? contract?])

collects/unstable/exn.ss

@@ -0,0 +1,20 @@
+#lang scheme/base
+(require mzlib/contract)
+
+;; network-error: symbol string . values -> void
+;; throws a formatted exn:fail:network
+(define (network-error src fmt . args)
+  (raise (make-exn:fail:network (format "~a: ~a" src (apply format fmt args))
+                                (current-continuation-marks))))
+
+;; exn->string : (or/c exn any) -> string
+(define (exn->string exn)
+  (if (exn? exn)
+      (parameterize ([current-error-port (open-output-string)])
+        ((error-display-handler) (exn-message exn) exn)
+        (get-output-string (current-error-port)))
+      (format "~s\n" exn)))
+
+(provide/contract
+ [network-error ((symbol? string?) (listof any/c) . ->* . (void))]
+ [exn->string ((or/c exn? any/c) . -> . string?)])

collects/unstable/info.ss

@@ -0,0 +1,3 @@
+#lang setup/infotab
+(define scribblings
+  '(("scribblings/unstable.scrbl" (multi-page) (experimental))))

collects/unstable/list.ss

@@ -0,0 +1,19 @@
+#lang scheme
+
+; list-prefix : list? list? -> (or/c list? false/c)
+; Is l a prefix or r?, and what is that prefix?
+(define (list-prefix? ls rs)
+  (match ls
+    [(list)
+     #t]
+    [(list-rest l0 ls)
+     (match rs
+       [(list)
+        #f]
+       [(list-rest r0 rs)
+        (if (equal? l0 r0)
+            (list-prefix? ls rs)
+            #f)])]))
+
+(provide/contract
+ [list-prefix? (list? list? . -> . boolean?)])

collects/unstable/net/url.ss

@@ -0,0 +1,44 @@
+#lang scheme/base
+(require scheme/list
+         scheme/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))))
+
+;; ripped this off from url-unit.ss
+(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)])))))

collects/unstable/path.ss

@@ -0,0 +1,53 @@
+#lang scheme
+(require unstable/list
+         unstable/contract)
+
+; explode-path* : path? -> (listof path?)
+(define (explode-path* p)
+  (let loop ([p p] [r empty])
+    (cond 
+      [(eq? 'relative p) r]
+      [(not p) r]
+      [else
+       (let-values ([(base name dir?) (split-path p)])
+         (loop base (list* name r)))])))
+
+; strip-prefix-ups : (listof path-element?) -> (listof path-element?)
+(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))
+
+; path-without-base : path? path? -> (listof path-element?)
+(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)))
+
+;; 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)))
+
+(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])))
+
+(provide/contract
+ [explode-path* (path-string? . -> . (listof path-element?))]
+ [path-without-base (path-string? path-string? . -> . (listof path-element?))]
+ [strip-prefix-ups ((listof path-element?) . -> . (listof path-element?))] 
+ [directory-part (path-string? . -> . path?)]
+ [build-path-unless-absolute (path-string? path-string? . -> . path?)])

collects/unstable/scribblings/bytes.scrbl

@@ -0,0 +1,25 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          (for-label unstable/bytes
+                     scheme/serialize
+                     scheme/contract
+                     scheme/base))
+
+@title[#:tag "bytes"]{Bytes}
+
+@defmodule[unstable/bytes]
+
+@defproc[(bytes-ci=? [b1 bytes?] [b2 bytes?]) boolean?]{
+ Compares two bytes case insensitively.
+}
+                                                        
+@defproc[(read/bytes [b bytes?])
+         serializable?]{
+ @scheme[read]s a value from @scheme[b] and returns it.
+}
+
+@defproc[(write/bytes [v serializable?])
+         bytes?]{
+ @scheme[write]s @scheme[v] to a bytes and returns it.
+}

collects/unstable/scribblings/contract.scrbl

@@ -0,0 +1,16 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          (for-label unstable/contract
+                     scheme/contract
+                     scheme/base))
+
+@title[#:tag "contract"]{Contracts}
+
+@defmodule[unstable/contract]
+
+@defthing[non-empty-string/c contract?]{Contract for non-empty strings.}
+
+@defthing[port-number? contract?]{Equivalent to @scheme[(between/c 1 65535)].}
+
+@defthing[path-element? contract?]{Equivalent to @scheme[(or/c path-string? (symbols 'up 'same))].}

collects/unstable/scribblings/exn.scrbl

@@ -0,0 +1,22 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          (for-label unstable/exn
+                     scheme/contract
+                     scheme/base))
+
+@title[#:tag "exn"]{Exceptions}
+
+@defmodule[unstable/exn]
+
+@defproc[(network-error [s symbol?]
+                        [fmt string?]
+                        [v any/c] ...)
+         void]{
+ Like @scheme[error], but throws a @scheme[exn:fail:network].
+}
+
+@defproc[(exn->string [exn (or/c exn? any/c)])
+         string?]{
+ Formats @scheme[exn] with @scheme[(error-display-handler)] as a string.
+}

collects/unstable/scribblings/list.scrbl

@@ -0,0 +1,16 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          (for-label unstable/list
+                     scheme/contract
+                     scheme/base))
+
+@title[#:tag "list"]{Lists}
+
+@defmodule[unstable/list]
+
+@defproc[(list-prefix? [l list?]
+                       [r list?])
+         boolean?]{
+ True if @scheme[l] is a prefix of @scheme[r].
+}

collects/unstable/scribblings/net.scrbl

@@ -0,0 +1,11 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual)
+
+@title[#:tag "net" #:style 'toc]{Net}
+
+@defmodule[unstable/net]
+
+@local-table-of-contents[]
+
+@include-section["net/url.scrbl"]

collects/unstable/scribblings/net/url.scrbl

@@ -0,0 +1,23 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          (for-label unstable/net/url
+                     net/url
+                     scheme/contract
+                     scheme/base))
+
+@title[#:tag "url"]{URLs}
+
+@defmodule[unstable/net/url]
+
+@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.
+}
+
+@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.
+}

collects/unstable/scribblings/path.scrbl

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

collects/unstable/scribblings/string.scrbl

@@ -0,0 +1,26 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          (for-label unstable/string
+                     scheme/serialize
+                     scheme/contract
+                     scheme/base))
+
+@title[#:tag "string"]{Strings}
+
+@defmodule[unstable/string]
+
+@defproc[(lowercase-symbol! [sb (or/c string? bytes?)])
+         symbol?]{
+ Returns @scheme[sb] as a lowercase symbol.
+}
+
+@defproc[(read/string [s string?])
+         serializable?]{
+ @scheme[read]s a value from @scheme[s] and returns it.
+}
+
+@defproc[(write/string [v serializable?])
+         string?]{
+ @scheme[write]s @scheme[v] to a string and returns it.
+}

collects/unstable/scribblings/unstable.scrbl

@@ -0,0 +1,21 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual)
+
+@title[#:tag "unstable"]{Unstable}
+
+@defmodule[unstable]
+
+This manual documents some of the libraries available in the @schememodname[unstable] collection. 
+
+The name @schememodname[unstable] is intended as a warning that the @bold{interfaces} in particular are unstable. Developers of planet packages and external projects should avoid using modules in the unstable collection. Contracts may change, names may change or disappear, even entire modules may move or disappear without warning to the outside world.
+
+@local-table-of-contents[]
+
+@include-section["bytes.scrbl"]
+@include-section["contract.scrbl"]
+@include-section["exn.scrbl"]
+@include-section["list.scrbl"]
+@include-section["net.scrbl"]
+@include-section["path.scrbl"]
+@include-section["string.scrbl"]

collects/unstable/string.ss

@@ -0,0 +1,22 @@
+#lang scheme
+(require scheme/serialize)
+
+(define (read/string str)
+  (read (open-input-string str)))
+(define (write/string v)
+  (define str (open-output-string))
+  (write v str)
+  (get-output-string str))
+
+; lowercase-symbol! : (or/c string bytes) -> symbol
+(define (lowercase-symbol! s)
+  (string->symbol
+   (string-downcase
+    (if (bytes? s)
+        (bytes->string/utf-8 s)
+        s))))
+
+(provide/contract
+ [lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)]
+ [read/string (string? . -> . serializable?)]
+ [write/string (serializable? . -> . string?)])

collects/web-server/private/util.ss

@@ -1,169 +1,17 @@
 #lang scheme/base
-(require mzlib/list
-         mzlib/plt-match
-         mzlib/contract
-         mzlib/serialize
-         net/url)
-(define path-element?
-  (or/c path-string? (symbols 'up 'same)))
-
-(define port-number? (between/c 1 65535))
-
-(define non-empty-string/c
-  (and/c string?
-         (lambda (s) (not (zero? (string-length s))))))
-
-(provide/contract
- [non-empty-string/c contract?]
- [path-element? contract?]
- [port-number? contract?]
- [url-replace-path (((listof path/param?) . -> . (listof path/param?)) url? . -> . url?)]
- [explode-path* (path-string? . -> . (listof path-element?))]
- [path-without-base (path-string? path-string? . -> . (listof path-element?))]
- [list-prefix? (list? list? . -> . boolean?)]
- [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-string? . -> . path?)]
- [lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)]
- [exn->string ((or/c exn? any/c) . -> . string?)]
- [build-path-unless-absolute (path-string? path-string? . -> . path?)]
- [read/string (string? . -> . serializable?)]
- [write/string (serializable? . -> . string?)]
- [read/bytes (bytes? . -> . serializable?)]
- [write/bytes (serializable? . -> . bytes?)]
- [bytes-ci=? (bytes? bytes? . -> . boolean?)])
-
-(define (bytes-ci=? b0 b1)
-  (string-ci=? (bytes->string/utf-8 b0)
-               (bytes->string/utf-8 b1)))
-
-(define (read/string str)
-  (read (open-input-string str)))
-(define (write/string v)
-  (define str (open-output-string))
-  (write v str)
-  (get-output-string str))
-
-(define (read/bytes bs)
-  (read (open-input-bytes bs)))
-(define (write/bytes v)
-  (define by (open-output-bytes))
-  (write v by)
-  (get-output-bytes by))
-
-; explode-path* : path? -> (listof path?)
-(define (explode-path* p)
-  (let loop ([p p] [r empty])
-    (cond 
-      [(eq? 'relative p) r]
-      [(not p) r]
-      [else
-       (let-values ([(base name dir?) (split-path p)])
-         (loop base (list* name r)))])))
-
-; strip-prefix-ups : (listof path-element?) -> (listof path-element?)
-(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))
-
-; list-prefix : list? list? -> (or/c list? false/c)
-; Is l a prefix or r?, and what is that prefix?
-(define (list-prefix? ls rs)
-  (match ls
-    [(list)
-     #t]
-    [(list-rest l0 ls)
-     (match rs
-       [(list)
-        #f]
-       [(list-rest r0 rs)
-        (if (equal? l0 r0)
-            (list-prefix? ls rs)
-            #f)])]))
-
-; path-without-base : path? path? -> (listof path-element?)
-(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)))
-
-;; 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))))
-
-;; ripped this off from url-unit.ss
-(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)])))))
-
-;; network-error: symbol string . values -> void
-;; throws a formatted exn:fail:network
-(define (network-error src fmt . args)
-  (raise (make-exn:fail:network (format "~a: ~a" src (apply format fmt args))
-                                (current-continuation-marks))))
-
-;; 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)))
-
-;; exn->string : (or/c exn any) -> string
-(define (exn->string exn)
-  (if (exn? exn)
-      (parameterize ([current-error-port (open-output-string)])
-        ((error-display-handler) (exn-message exn) exn)
-        (get-output-string (current-error-port)))
-      (format "~s\n" exn)))
-
-; lowercase-symbol! : (or/c string bytes) -> symbol
-(define (lowercase-symbol! s)
-  (string->symbol
-   (string-downcase
-    (if (bytes? s)
-        (bytes->string/utf-8 s)
-        s))))
-
-(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])))
+(require unstable/bytes
+         unstable/contract
+         unstable/exn
+         unstable/list
+         unstable/path
+         unstable/string
+         unstable/net/url)
+(provide
+ (all-from-out
+  unstable/bytes
+  unstable/contract
+  unstable/exn
+  unstable/list
+  unstable/path
+  unstable/string
+  unstable/net/url))

collects/web-server/scribblings/private.scrbl

@@ -17,4 +17,3 @@ Some of these are documented here.
 @include-section["mod-map.scrbl"]
 @include-section["url-param.scrbl"]
 @include-section["gzip.scrbl"]
-@include-section["util.scrbl"]

collects/web-server/scribblings/util.scrbl

@@ -1,116 +0,0 @@
-#lang scribble/doc
-@(require "web-server.ss")
-
-@title[#:tag "util.ss"]{Miscellaneous Utilities}
-@(require (for-label web-server/private/util
-                     net/url
-                     scheme/serialize
-                     scheme/path))
-
-@defmodule[web-server/private/util]
-
-There are a number of other miscellaneous utilities the @web-server
-needs. They are provided by this module.
-
-@section{Contracts}
-@defthing[non-empty-string/c contract?]{Contract for non-empty strings.}
-@defthing[port-number? contract?]{Equivalent to @scheme[(between/c 1 65535)].}
-@defthing[path-element? contract?]{Equivalent to @scheme[(or/c path-string? (symbols 'up 'same))].}
-
-@section{Lists}
-@defproc[(list-prefix? [l list?]
-                       [r list?])
-         boolean?]{
- True if @scheme[l] is a prefix of @scheme[r].
-}
-
-@section{URLs}
-
-@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.
-}
-
-@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.
-}
-
-@section{Paths}
-@defproc[(explode-path* [p path-string?])
-         (listof path-element?)]{
- Like @scheme[normalize-path], but does not resolve symlinks.
-}
-
-@defproc[(path-without-base [base path-string?]
-                            [p path-string?])
-         (listof path-element?)]{
- Returns, as a list, the portion of @scheme[p] after @scheme[base],
- assuming @scheme[base] is a prefix of @scheme[p].
-}
-
-@defproc[(directory-part [p path-string?])
-         path?]{
- Returns the directory part of @scheme[p], returning @scheme[(current-directory)]
- if it is relative.
-}
-
-@defproc[(build-path-unless-absolute [base path-string?]
-                                     [p path-string?])
-         path?]{
- Prepends @scheme[base] to @scheme[p], unless @scheme[p] is absolute.
-}
-
-@defproc[(strip-prefix-ups [p (listof path-element?)])
-         (listof path-element?)]{
- Removes all the prefix @scheme[".."]s from @scheme[p].
-}
-
-@section{Exceptions}
-
-@defproc[(network-error [s symbol?]
-                        [fmt string?]
-                        [v any/c] ...)
-         void]{
- Like @scheme[error], but throws a @scheme[exn:fail:network].
-}
-
-@defproc[(exn->string [exn (or/c exn? any/c)])
-         string?]{
- Formats @scheme[exn] with @scheme[(error-display-handler)] as a string.
-}
-
-@section{Strings}
-
-@defproc[(lowercase-symbol! [sb (or/c string? bytes?)])
-         symbol?]{
- Returns @scheme[sb] as a lowercase symbol.
-}
-
-@defproc[(read/string [s string?])
-         serializable?]{
- @scheme[read]s a value from @scheme[s] and returns it.
-}
-
-@defproc[(write/string [v serializable?])
-         string?]{
- @scheme[write]s @scheme[v] to a string and returns it.
-}
-
-@section{Bytes}
-
-@defproc[(bytes-ci=? [b1 bytes?] [b2 bytes?]) boolean?]{
- Compares two bytes case insensitively.
-}
-                                                        
-@defproc[(read/bytes [b bytes?])
-         serializable?]{
- @scheme[read]s a value from @scheme[b] and returns it.
-}
-
-@defproc[(write/bytes [v serializable?])
-         bytes?]{
- @scheme[write]s @scheme[v] to a bytes and returns it.
-}