helper function
svn: r13898
This commit is contained in:
parent
77d1cfdb84
commit
d7c9b2b771
|
@ -1,6 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/contract
|
||||
scheme/list
|
||||
#lang scheme
|
||||
(require scheme
|
||||
xml
|
||||
web-server/private/xexpr
|
||||
web-server/http/request-structs)
|
||||
|
@ -70,9 +69,18 @@
|
|||
[else
|
||||
(normalize-response
|
||||
close?
|
||||
(make-response/full
|
||||
200 #"Okay" (current-seconds) TEXT/HTML-MIME-TYPE empty
|
||||
(list (string->bytes/utf-8 (xexpr->string resp)))))]))
|
||||
(make-xexpr-response resp))]))
|
||||
|
||||
(define (make-xexpr-response
|
||||
xexpr
|
||||
#:code [code 200]
|
||||
#:message [message #"Okay"]
|
||||
#:seconds [seconds (current-seconds)]
|
||||
#:mime-type [mime-type TEXT/HTML-MIME-TYPE]
|
||||
#:headers [hdrs empty])
|
||||
(make-response/full
|
||||
code message seconds mime-type hdrs
|
||||
(list (string->bytes/utf-8 (xexpr->string xexpr)))))
|
||||
|
||||
(provide/contract
|
||||
[struct response/basic
|
||||
|
@ -94,7 +102,11 @@
|
|||
[seconds number?]
|
||||
[mime bytes?]
|
||||
[headers (listof header?)]
|
||||
[generator ((() (listof bytes?) . ->* . any) . -> . any)])]
|
||||
[generator ((() () #:rest (listof bytes?) . ->* . any) . -> . any)])]
|
||||
[response/c contract?]
|
||||
[make-xexpr-response
|
||||
((pretty-xexpr/c)
|
||||
(#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?))
|
||||
. ->* . response/full?)]
|
||||
[normalize-response (boolean? response/c . -> . (or/c response/full? response/incremental?))]
|
||||
[TEXT/HTML-MIME-TYPE bytes?])
|
||||
|
|
|
@ -13,6 +13,7 @@ The @web-server implements many HTTP RFCs that are provided by this module.
|
|||
@; ------------------------------------------------------------
|
||||
@section[#:tag "request-structs.ss"]{Requests}
|
||||
@(require (for-label web-server/http/request-structs
|
||||
xml
|
||||
scheme/match))
|
||||
|
||||
@defmodule[web-server/http/request-structs]{
|
||||
|
@ -198,7 +199,7 @@ Here is an example typical of what you will find in many applications:
|
|||
}
|
||||
|
||||
@defstruct[(response/incremental response/basic)
|
||||
([generator ((() (listof bytes?) . ->* . any) . -> . any)])]{
|
||||
([generator ((() () #:rest (listof bytes?) . ->* . any) . -> . any)])]{
|
||||
As with @scheme[response/basic], except with @scheme[generator] as a function that is
|
||||
called to generate the response body, by being given an @scheme[output-response] function
|
||||
that outputs the content it is called with.
|
||||
|
@ -224,6 +225,20 @@ Here is an example typical of what you will find in many applications:
|
|||
xexpr/c)].
|
||||
}
|
||||
|
||||
@defproc[(make-xexpr-response [xexpr xexpr/c]
|
||||
[#:code code number? 200]
|
||||
[#:message message bytes? #"Okay"]
|
||||
[#:seconds seconds number? (current-seconds)]
|
||||
[#:mime-type mime-type bytes? TEXT/HTML-MIME-TYPE]
|
||||
[#:headers headers (listof header?) empty])
|
||||
response/full?]{
|
||||
Equivalent to
|
||||
@schemeblock[
|
||||
(make-response/full
|
||||
code message seconds mime-type headers
|
||||
(list (string->bytes/utf-8 (xexpr->string xexpr))))
|
||||
]}
|
||||
|
||||
@defproc[(normalize-response [close? boolean?] [response response/c])
|
||||
(or/c response/full? response/incremental?)]{
|
||||
Coerces @scheme[response] into a full response, filling in additional details where appropriate.
|
||||
|
|
Loading…
Reference in New Issue
Block a user