suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Abstracting serve

Browse Source 
svn: r6389
This commit is contained in:
Jay McCarthy 2007-05-29 20:47:58 +00:00
parent 861a1c1ef5
commit bfe4e940b0
3 changed files with 13 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/web-server/tools/servlet-env.ss
View File

@ -44,7 +44,7 @@
`(html (head (title "Servlet has ended.")) `(html (head (title "Servlet has ended."))
(body (p "This servlet has ended, please return to the interaction window."))))))] (body (p "This servlet has ended, please return to the interaction window."))))))]
[shutdown-server [shutdown-server
(serve (build-standalone-servlet-configuration the-port the-path new-servlet))]) (serve/web-config@ (build-standalone-servlet-configuration the-port the-path new-servlet))])
(send-url standalone-url #t) (send-url standalone-url #t)
; Wait for final call ; Wait for final call
(semaphore-wait sema) (semaphore-wait sema)

1
collects/web-server/web-server-unit.ss
View File

@ -77,4 +77,3 @@
(import tcp^ web-config^) (import tcp^ web-config^)
(export web-server^) (export web-server^)
(link web-config@->dispatch-server-config@ dispatch-server@))) (link web-config@->dispatch-server-config@ dispatch-server@)))

36
collects/web-server/web-server.ss
View File

@ -7,31 +7,17 @@
"configuration.ss" "configuration.ss"
"private/configuration-structures.ss") "private/configuration-structures.ss")
(provide/contract (provide/contract
[serve (case-> [configuration? . -> . (-> void?)] [serve/web-config@ (configuration? . -> . (-> void?))])
[configuration? natural-number/c . -> . (-> void?)]
[configuration? natural-number/c string? . -> . (-> void?)])])
; : configuration [nat] [(U str #f)] -> -> void ; serve/config@ : configuration -> (-> void)
(define serve (define (serve/web-config@ config@)
(case-lambda (define-unit-from-context tcp@ tcp^)
[(config) (define-unit m@ (import web-server^) (export)
(run-the-server config)] (init-depend web-server^)
[(config port) (serve))
(run-the-server (update-configuration config `((port . ,port))))] (define-unit-binding c@ config@ (import) (export web-config^))
[(config port listen-ip)
(run-the-server (update-configuration config `((port . ,port) (ip-address . ,listen-ip))))]))
(define-unit-from-context tcp@ tcp^)
(define-unit m@ (import web-server^) (export)
(init-depend web-server^)
(serve))
; : configuration -> -> void
(define (run-the-server config)
(define-unit-binding c@ config (import) (export web-config^))
(invoke-unit (invoke-unit
(compound-unit/infer (compound-unit/infer
(import) (import)
(link tcp@ c@ web-server@ m@) (link tcp@ c@ web-server@ m@)
(export))))) (export)))))