From 9e7877d5381946b83345952801649f672240935a Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 29 May 2007 21:19:06 +0000 Subject: [PATCH] Refactoring configuation svn: r6390 --- collects/web-server/configuration.ss | 33 ++++++++++++++------------ collects/web-server/private/launch.ss | 3 --- collects/web-server/sig.ss | 18 ++++++-------- collects/web-server/web-server-unit.ss | 7 +----- 4 files changed, 26 insertions(+), 35 deletions(-) diff --git a/collects/web-server/configuration.ss b/collects/web-server/configuration.ss index c8b74d3aa1..62a01e9298 100644 --- a/collects/web-server/configuration.ss +++ b/collects/web-server/configuration.ss @@ -1,7 +1,6 @@ (module configuration mzscheme (require (lib "unit.ss") (lib "kw.ss") - (lib "list.ss") (lib "contract.ss")) (require "private/configuration.ss" "private/configuration-structures.ss" @@ -46,36 +45,40 @@ (directory-part default-configuration-table-path) (parse-configuration-table s-expr))) - + ; : (listof (cons sym TST)) -> configuration ; more here - this is ugly. It also does not catch "unbound identifiers" since I use symbols. ; I considered several other solutions: ; - write the compound unit multiple times (no abstraction) ; - use opt-lambda and pass in 'please-use-the-default for unchanged flags ; - write three different functional updaters and re-compound the unit 1--3 times - (define (update-configuration configuration flags) - + (define (update-configuration configuration flags) (define-unit new-local-config@ - (import (prefix raw: web-config/local^)) - (export web-config/local^) - (init-depend web-config/local^) + (import (prefix raw: web-config^)) + (export web-config^) + (init-depend web-config^) + + (define max-waiting raw:max-waiting) + (define virtual-hosts raw:virtual-hosts) + (define access raw:access) + (define scripts raw:scripts) + (define initial-connection-timeout raw:initial-connection-timeout) (define port (extract-flag 'port flags raw:port)) (define listen-ip (extract-flag 'ip-address flags raw:listen-ip)) (define instances (extract-flag 'instances flags raw:instances)) (define make-servlet-namespace (extract-flag 'namespace flags raw:make-servlet-namespace))) - - (define-unit/new-import-export config@ (import) (export web-config/local^ web-config/pervasive^) + + (define-unit/new-import-export config@ (import) (export web-config^) ((web-config^) configuration)) (define-compound-unit/infer new-config@ (import) - (export NL web-config/pervasive^) - (link (((L : web-config/local^)) config@) - (((NL : web-config/local^)) new-local-config@ L))) - - (unit/new-import-export (import) (export web-config^) - ((web-config/local^ web-config/pervasive^) new-config@))) + (export NL) + (link (((L : web-config^)) config@) + (((NL : web-config^)) new-local-config@ L))) + + new-config@) (provide ; XXX contract make-make-servlet-namespace diff --git a/collects/web-server/private/launch.ss b/collects/web-server/private/launch.ss index 009def720d..e523fad4b9 100644 --- a/collects/web-server/private/launch.ss +++ b/collects/web-server/private/launch.ss @@ -1,12 +1,9 @@ -; The main program of the "web-server" launcher. (module launch mzscheme (require (lib "cmdline.ss") (lib "pregexp.ss") - (lib "contract.ss") (lib "unit.ss") (lib "tcp-sig.ss" "net")) (require "util.ss" - "configuration-structures.ss" "../web-server-unit.ss" "../sig.ss" "../configuration.ss") diff --git a/collects/web-server/sig.ss b/collects/web-server/sig.ss index 136bb5a55f..88276348ce 100644 --- a/collects/web-server/sig.ss +++ b/collects/web-server/sig.ss @@ -3,19 +3,15 @@ (require "private/dispatch-server-sig.ss") (provide ; XXX contract signature (rename dispatch-server^ web-server^) - web-config^ web-config/pervasive^ web-config/local^) + web-config^) - ; more here - rename - (define-signature web-config/pervasive^ + (define-signature web-config^ (max-waiting virtual-hosts access scripts - initial-connection-timeout)) - - ; more here - rename - (define-signature web-config/local^ - (port listen-ip instances make-servlet-namespace)) - - (define-signature web-config^ - ((open web-config/pervasive^) (open web-config/local^)))) \ No newline at end of file + initial-connection-timeout + port + listen-ip + instances + make-servlet-namespace))) \ No newline at end of file diff --git a/collects/web-server/web-server-unit.ss b/collects/web-server/web-server-unit.ss index 8c63c41002..a120cda86e 100644 --- a/collects/web-server/web-server-unit.ss +++ b/collects/web-server/web-server-unit.ss @@ -1,6 +1,5 @@ (module web-server-unit mzscheme (require (lib "tcp-sig.ss" "net") - (lib "contract.ss") (lib "unit.ss")) (require "sig.ss" "private/dispatch-server-unit.ss" @@ -19,11 +18,7 @@ (prefix host: "dispatchers/dispatch-host.ss")) (provide web-server@) - - #;(provide/contract - ; XXX contract - [web-server@ unit?]) - + (define-unit web-config@->dispatch-server-config@ (import (prefix config: web-config^)) (export dispatch-server-config^)