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 #lang racket
(require web-server/servlet-env (require web-server/servlet-env
web-server/servlet/servlet-structs
web-server/http) web-server/http)
(define (serve/dispatch dispatch) (define (serve/dispatch dispatch)
@ -8,4 +9,4 @@
#:servlet-regexp #rx"")) #:servlet-regexp #rx""))
(provide/contract (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 #lang racket/base
(require racket/contract) (require racket/contract)
(require web-server/servlet/setup (require web-server/servlet/setup
web-server/servlet/servlet-structs
web-server/managers/manager web-server/managers/manager
web-server/http web-server/http
web-server/http/response web-server/http/response
@ -47,8 +48,8 @@
; ----- ; -----
(provide/contract (provide/contract
[make (->* (url->servlet/c) [make (->* (url->servlet/c)
(#:responders-servlet-loading (url? any/c . -> . response?) (#:responders-servlet-loading (url? any/c . -> . response/c)
#:responders-servlet (url? any/c . -> . response?)) #:responders-servlet (url? any/c . -> . response/c))
dispatcher/c)]) dispatcher/c)])
(define (make url->servlet (define (make url->servlet

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

@ -3,10 +3,22 @@
racket/list racket/list
xml xml
web-server/private/xexpr web-server/private/xexpr
unstable/contract
"request-structs.rkt" "request-structs.rkt"
"cookie.rkt" "cookie.rkt"
"response-structs.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 (define (response/xexpr
xexpr xexpr
#:code [code 200] #:code [code 200]
@ -25,6 +37,7 @@
(write-xexpr xexpr out)))) (write-xexpr xexpr out))))
(provide/contract (provide/contract
[xexpr-response/c contract?]
[response/xexpr [response/xexpr
((pretty-xexpr/c) ((pretty-xexpr/c)
(#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?) #:preamble bytes?) (#: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 ...))]) #'(body ...))])
(quasisyntax/loc stx (quasisyntax/loc stx
(#,@expanded (#,@expanded
(provide/contract (#,start (request? . -> . response?))) (provide/contract (#,start (request? . -> . response/c)))
(serve/servlet (contract (request? . -> . response?) #,start (serve/servlet (contract (request? . -> . response/c) #,start
'you 'web-server 'you 'web-server
"start" "start"
#f) #f)

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

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

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

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require racket/contract) (require racket/contract)
(require web-server/managers/manager (require web-server/servlet/servlet-structs
web-server/managers/manager
web-server/http) web-server/http)
(define servlet-prompt (make-continuation-prompt-tag 'servlet)) (define servlet-prompt (make-continuation-prompt-tag 'servlet))
@ -21,7 +22,7 @@
[namespace namespace?] [namespace namespace?]
[manager manager?] [manager manager?]
[directory path-string?] [directory path-string?]
[handler (request? . -> . response?)])] [handler (request? . -> . response/c)])]
[struct execution-context [struct execution-context
([request request?])] ([request request?])]
[current-servlet (parameter/c (or/c false/c servlet?))] [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/http
web-server/stuffers web-server/stuffers
web-server/servlet/setup web-server/servlet/setup
web-server/servlet/servlet-structs
web-server/dispatchers/dispatch web-server/dispatchers/dispatch
(prefix-in filter: web-server/dispatchers/dispatch-filter) (prefix-in filter: web-server/dispatchers/dispatch-filter)
(prefix-in servlets: web-server/dispatchers/dispatch-servlets)) (prefix-in servlets: web-server/dispatchers/dispatch-servlets))
@ -25,7 +26,7 @@
(define send-url (make-parameter net:send-url)) (define send-url (make-parameter net:send-url))
(provide/contract (provide/contract
[dispatch/servlet (((request? . -> . response?)) [dispatch/servlet (((request? . -> . response/c))
(#:regexp regexp? (#:regexp regexp?
#:current-directory path-string? #:current-directory path-string?
#:stateless? boolean? #:stateless? boolean?

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

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

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

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

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

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

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

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