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."))
(body (p "This servlet has ended, please return to the interaction window."))))))]
[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)
; Wait for final call
(semaphore-wait sema)

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

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