From f046f218b852d51b01b582a22de00d6488a76eb0 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 5 Nov 2008 22:39:39 +0000 Subject: [PATCH] Better contracts svn: r12318 --- collects/web-server/configuration/configuration-table.ss | 9 ++++++--- collects/web-server/scribblings/configuration.scrbl | 8 ++++++-- collects/web-server/servlet-env.ss | 1 - collects/web-server/web-config-unit.ss | 3 +-- 4 files changed, 13 insertions(+), 8 deletions(-) diff --git a/collects/web-server/configuration/configuration-table.ss b/collects/web-server/configuration/configuration-table.ss index 313dfeaaa5..4289e873bd 100644 --- a/collects/web-server/configuration/configuration-table.ss +++ b/collects/web-server/configuration/configuration-table.ss @@ -4,12 +4,15 @@ mzlib/pretty) (require "configuration-table-structs.ss" "../servlet/bindings.ss") +(define configuration-table-sexpr? list?) + (provide/contract + [configuration-table-sexpr? (any/c . -> . boolean?)] [read-configuration-table (path-string? . -> . configuration-table?)] [write-configuration-table (configuration-table? path-string? . -> . void)] - [configuration-table->sexpr (configuration-table? . -> . list?)] - [sexpr->configuration-table (list? . -> . configuration-table?)] - [default-configuration-table-path path?]) + [configuration-table->sexpr (configuration-table? . -> . configuration-table-sexpr?)] + [sexpr->configuration-table (configuration-table-sexpr? . -> . configuration-table?)] + [default-configuration-table-path path?]) (define default-configuration-table-path (build-path (collection-path "web-server") "default-web-root" "configuration-table.ss")) diff --git a/collects/web-server/scribblings/configuration.scrbl b/collects/web-server/scribblings/configuration.scrbl index aeb62d0161..2b78de0d17 100644 --- a/collects/web-server/scribblings/configuration.scrbl +++ b/collects/web-server/scribblings/configuration.scrbl @@ -91,13 +91,17 @@ structures. @defthing[default-configuration-table-path path?]{The default configuration table S-expression file.} -@defproc[(sexpr->configuration-table (sexpr list?)) +@defthing[configuration-table-sexpr? (any . -> . boolean?)]{ + Equivalent to @scheme[list?]. +} + +@defproc[(sexpr->configuration-table (sexpr configuration-table-sexpr?)) configuration-table?]{ This function converts a @scheme[configuration-table] from an S-expression. } @defproc[(configuration-table->sexpr (ctable configuration-table?)) - list?]{ + configuration-table-sexpr?]{ This function converts a @scheme[configuration-table] to an S-expression. } diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss index a3d77ad6b8..dc21ae91b4 100644 --- a/collects/web-server/servlet-env.ss +++ b/collects/web-server/servlet-env.ss @@ -80,7 +80,6 @@ [server-root-path (directory-part default-configuration-table-path)] #:extra-files-paths [extra-files-paths (list (build-path server-root-path "htdocs"))] - ; XXX Add support for other servlets #:servlets-root [servlets-root (build-path server-root-path ".")] #:file-not-found-path diff --git a/collects/web-server/web-config-unit.ss b/collects/web-server/web-config-unit.ss index 49cf8bfc7e..b1d5befcdb 100644 --- a/collects/web-server/web-config-unit.ss +++ b/collects/web-server/web-config-unit.ss @@ -8,7 +8,6 @@ "configuration/namespace.ss" "configuration/responders.ss" "web-config-sig.ss") -; XXX unit? should be particular unit sig (provide/contract [configuration-table->web-config@ (->* (path-string?) @@ -17,7 +16,7 @@ #:make-servlet-namespace make-servlet-namespace/c) unit?)] [configuration-table-sexpr->web-config@ - (->* (list?) ; XXX + (->* (configuration-table-sexpr?) (#:web-server-root path-string? #:port (or/c false/c number?) #:listen-ip (or/c false/c string?)