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

New response/c

Browse Source
This commit is contained in:
Jay McCarthy 2010-12-04 22:35:00 -07:00
parent d6d9f3ef8c
commit a246ddebde
11 changed files with 62 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/web-server/dispatch/serve.rkt
View File

@ -1,5 +1,6 @@
#lang racket
(require web-server/servlet-env
web-server/servlet/servlet-structs
web-server/http)
(define (serve/dispatch dispatch)
@ -8,4 +9,4 @@
#:servlet-regexp #rx""))
(provide/contract
[serve/dispatch ((request? . -> . response?) . -> . void)])
[serve/dispatch ((request? . -> . response/c) . -> . void)])

5
collects/web-server/dispatchers/dispatch-servlets.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/contract)
(require web-server/servlet/setup
web-server/servlet/servlet-structs
web-server/managers/manager
web-server/http
web-server/http/response
@ -47,8 +48,8 @@
; -----
(provide/contract
[make (->* (url->servlet/c)
(#:responders-servlet-loading (url? any/c . -> . response?)
#:responders-servlet (url? any/c . -> . response?))
(#:responders-servlet-loading (url? any/c . -> . response/c)
#:responders-servlet (url? any/c . -> . response/c))
dispatcher/c)])
(define (make url->servlet

13
collects/web-server/http/xexpr.rkt
View File

@ -3,10 +3,22 @@
racket/list
xml
web-server/private/xexpr
unstable/contract
"request-structs.rkt"
"cookie.rkt"
"response-structs.rkt")
(define xexpr-response/c
(coerce/c
(λ (x)
(cond
[(response? x)
x]
[(xexpr? x)
(response/xexpr x)]
[else
#f]))))
(define (response/xexpr
xexpr
#:code [code 200]
@ -25,6 +37,7 @@
(write-xexpr xexpr out))))
(provide/contract
[xexpr-response/c contract?]
[response/xexpr
((pretty-xexpr/c)
(#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?) #:preamble bytes?)

4
collects/web-server/insta/insta.rkt
View File

@ -58,8 +58,8 @@
#'(body ...))])
(quasisyntax/loc stx
(#,@expanded
(provide/contract (#,start (request? . -> . response?)))
(serve/servlet (contract (request? . -> . response?) #,start
(provide/contract (#,start (request? . -> . response/c)))
(serve/servlet (contract (request? . -> . response/c) #,start
'you 'web-server
"start"
#f)

13
collects/web-server/lang/web.rkt
View File

@ -2,6 +2,7 @@
(require net/url
racket/contract
racket/serialize
web-server/servlet/servlet-structs
web-server/http
web-server/managers/manager
web-server/private/define-closure
@ -26,22 +27,22 @@
(provide/contract
[make-stateless-servlet
(custodian? namespace? manager? path-string? (request? . -> . response?)
(custodian? namespace? manager? path-string? (request? . -> . response/c)
(stuffer/c serializable? bytes?) . -> . stateless-servlet?)])
; These contracts interfere with the continuation safety marks
#;(provide/contract
;; Server Interface
[initialize-servlet ((request? . -> . response?) . -> . (request? . -> . response?))]
[initialize-servlet ((request? . -> . response/c) . -> . (request? . -> . response/c))]
;; Servlet Interface
[send/suspend/hidden ((url? list? . -> . response?) . -> . request?)]
[send/suspend/url ((url? . -> . response?) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?)
[send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
. -> . any/c)]
[redirect/get (-> request?)])
;; initial-servlet : (request -> response) -> (request -> response?)
;; initial-servlet : (request -> response) -> (request -> response/c)
(define (initialize-servlet start)
(let ([params (current-parameterization)])
(lambda (req0)

5
collects/web-server/private/servlet.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/contract)
(require web-server/managers/manager
(require web-server/servlet/servlet-structs
web-server/managers/manager
web-server/http)
(define servlet-prompt (make-continuation-prompt-tag 'servlet))
@ -21,7 +22,7 @@
[namespace namespace?]
[manager manager?]
[directory path-string?]
[handler (request? . -> . response?)])]
[handler (request? . -> . response/c)])]
[struct execution-context
([request request?])]
[current-servlet (parameter/c (or/c false/c servlet?))]

3
collects/web-server/servlet-dispatch.rkt
View File

@ -18,6 +18,7 @@
web-server/http
web-server/stuffers
web-server/servlet/setup
web-server/servlet/servlet-structs
web-server/dispatchers/dispatch
(prefix-in filter: web-server/dispatchers/dispatch-filter)
(prefix-in servlets: web-server/dispatchers/dispatch-servlets))
@ -25,7 +26,7 @@
(define send-url (make-parameter net:send-url))
(provide/contract
[dispatch/servlet (((request? . -> . response?))
[dispatch/servlet (((request? . -> . response/c))
(#:regexp regexp?
#:current-directory path-string?
#:stateless? boolean?

5
collects/web-server/servlet-env.rkt
View File

@ -13,6 +13,7 @@
web-server/configuration/responders
web-server/private/mime-types
web-server/servlet/setup
web-server/servlet/servlet-structs
web-server/servlet-dispatch
unstable/contract
(prefix-in lift: web-server/dispatchers/dispatch-lift)
@ -38,7 +39,7 @@
"web-server/default-web-root"))
(provide/contract
[serve/servlet (((request? . -> . response?))
[serve/servlet (((request? . -> . response/c))
(#:connection-close? boolean?
#:command-line? boolean?
#:launch-browser? boolean?
@ -57,7 +58,7 @@
#:extra-files-paths (listof path-string?)
#:servlets-root path-string?
#:servlet-current-directory path-string?
#:file-not-found-responder (request? . -> . response?)
#:file-not-found-responder (request? . -> . response/c)
#:mime-types-path path-string?
#:servlet-path string?
#:servlet-regexp regexp?

16
collects/web-server/servlet/servlet-structs.rkt
View File

@ -1,22 +1,30 @@
#lang racket/base
(require racket/contract
unstable/contract
web-server/http)
(define current-response/c
(make-parameter any/c))
(define response/c
(dynamic/c any/c current-response/c response?))
(define k-url?
string?)
(define response-generator/c
(k-url? . -> . response?))
(k-url? . -> . response/c))
(define expiration-handler/c
(or/c false/c
(request? . -> . response?)))
(request? . -> . response/c)))
(define embed/url/c
((request? . -> . any/c) . -> . string?))
((request? . -> . any) . -> . string?))
(provide/contract
[current-response/c (parameter/c contract?)]
[response/c contract?]
[response-generator/c contract?]
[k-url? (any/c . -> . boolean?)]
[k-url? contract?]
[expiration-handler/c contract?]
[embed/url/c contract?])

15
collects/web-server/servlet/setup.rkt
View File

@ -11,6 +11,7 @@
web-server/http
web-server/servlet/web
web-server/configuration/namespace
web-server/servlet/servlet-structs
web-server/private/web-server-structs
web-server/private/servlet
web-server/private/util)
@ -111,9 +112,9 @@
servlet-module-specs
lang-module-specs))
(provide/contract
[make-v1.servlet (path-string? integer? (request? . -> . response?) . -> . servlet?)]
[make-v2.servlet (path-string? manager? (request? . -> . response?) . -> . servlet?)]
[make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . response?) . -> . servlet?)]
[make-v1.servlet (path-string? integer? (request? . -> . response/c) . -> . servlet?)]
[make-v2.servlet (path-string? manager? (request? . -> . response/c) . -> . servlet?)]
[make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . response/c) . -> . servlet?)]
[default-module-specs (listof (or/c resolved-module-path? module-path?))])
(define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
@ -143,13 +144,13 @@
(dynamic-require module-name 'timeout)
pos-blame neg-blame
"timeout" loc)]
[start (contract (request? . -> . response?)
[start (contract (request? . -> . response/c)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)])
(make-v1.servlet (directory-part a-path) timeout start))]
[(v2)
(let ([start (contract (request? . -> . response?)
(let ([start (contract (request? . -> . response/c)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)]
@ -159,7 +160,7 @@
"manager" loc)])
(make-v2.servlet (directory-part a-path) manager start))]
[(stateless)
(let ([start (contract (request? . -> . response?)
(let ([start (contract (request? . -> . response/c)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)]
@ -176,7 +177,7 @@
[else
(make-v1.servlet (directory-part a-path) timeouts-default-servlet
(v0.response->v1.lambda
(contract response? (response/xexpr s)
(contract response/c (response/xexpr s)
pos-blame neg-blame
path-string loc)
a-path))])))))

12
collects/web-server/servlet/web.rkt
View File

@ -41,13 +41,13 @@
[redirect/get/forget (() (#:headers (listof header?)) . ->* . request?)]
[adjust-timeout! (number? . -> . void?)]
[clear-continuation-table! (-> void?)]
[send/back (response? . -> . void?)]
[send/finish (response? . -> . void?)]
[send/back (response/c . -> . void?)]
[send/finish (response/c . -> . void?)]
[send/forward (response-generator/c . -> . request?)]
[send/suspend (response-generator/c . -> . request?)]
[send/suspend/dispatch ((embed/url/c . -> . response?) . -> . any/c)]
[send/suspend/url ((url? . -> . response?) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?) . -> . any/c)])
[send/suspend/dispatch ((embed/url/c . -> . response/c) . -> . any/c)]
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)])
;; ************************************************************
;; EXPORTS
@ -158,7 +158,7 @@
(provide/contract
[with-errors-to-browser
((response? . -> . request?)
((response/c . -> . request?)
(-> any)
. -> .
any)])