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

improving contracts

Browse Source 
svn: r2214
This commit is contained in:
Jay McCarthy 2006-02-13 18:40:07 +00:00
parent d6fcafefb2
commit 933685e454
1 changed files with 34 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/web-server/servlet.ss
View File

@ -1,4 +1,3 @@
;; Default choice for writing module servlets
(module servlet mzscheme (module servlet mzscheme
(require (lib "contract.ss") (require (lib "contract.ss")
(lib "etc.ss") (lib "etc.ss")
@ -9,10 +8,9 @@
"timer.ss" "timer.ss"
"web-cells.ss") "web-cells.ss")
;; ************************************************************ ;; CONTRACT HELPERS
;; HELPERS (define servlet-response? any/c)
;; Is it a Xexpr, or an Xexpr with procedures?
(define (xexpr/callback? x) (define (xexpr/callback? x)
(correct-xexpr? x (correct-xexpr? x
(lambda () #t) (lambda () #t)
@ -21,7 +19,25 @@
#t #t
(begin ((error-display-handler) (exn-message exn) exn) (begin ((error-display-handler) (exn-message exn) exn)
#f))))) #f)))))
(define response-generator?
(string? . -> . servlet-response?))
(define url-transform?
(string? . -> . string?))
(define expiration-handler?
(request? . -> . void?))
(define (parameter/c c)
parameter?)
(define embed/url?
(((request? . -> . any/c)) (expiration-handler?) . opt-> . string?))
;; ************************************************************
;; HELPERS
;; replace-procedures : (proc -> url) xexpr/callbacks? -> xexpr? ;; replace-procedures : (proc -> url) xexpr/callbacks? -> xexpr?
;; Change procedures to the send/suspend of a k-url ;; Change procedures to the send/suspend of a k-url
(define (xexpr/callback->xexpr p->a p-exp) (define (xexpr/callback->xexpr p->a p-exp)
@ -41,25 +57,24 @@
;; Weak contracts: the input is checked in output-response, and a message is ;; Weak contracts: the input is checked in output-response, and a message is
;; sent directly to the client (Web browser) instead of the terminal/log. ;; sent directly to the client (Web browser) instead of the terminal/log.
(provide/contract (provide/contract
[xexpr/callback? (any/c . -> . boolean?)]
[xexpr/callback->xexpr (embed/url? xexpr/callback? . -> . xexpr?)]
[current-url-transform (parameter/c url-transform?)]
[current-servlet-continuation-expiration-handler (parameter/c expiration-handler?)]
[redirect/get (-> request?)] [redirect/get (-> request?)]
[redirect/get/forget (-> request?)] [redirect/get/forget (-> request?)]
[adjust-timeout! (number? . -> . any)] [adjust-timeout! (number? . -> . void?)]
[send/back (any/c . -> . any)] [clear-continuation-table! (-> void?)]
[send/finish (any/c . -> . any)] [send/back (any/c . -> . void?)]
[send/suspend (((string? . -> . any/c)) ((request? . -> . any/c)) . opt-> . request?)] [send/finish (any/c . -> . void?)]
[send/forward (((string? . -> . any/c)) ((request? . -> . any/c)) . opt-> . request?)] [send/suspend ((response-generator?) (expiration-handler?) . opt-> . request?)]
;;; validate-xexpr/callback is not checked anywhere: [send/forward ((response-generator?) (expiration-handler?) . opt-> . request?)]
[send/suspend/callback (xexpr/callback? . -> . any)]) [send/suspend/dispatch ((embed/url? . -> . servlet-response?) . -> . any/c)]
[send/suspend/callback (xexpr/callback? . -> . any/c)])
(provide (provide
clear-continuation-table!
send/suspend/dispatch
current-url-transform
current-servlet-continuation-expiration-handler
xexpr/callback?
xexpr/callback->xexpr
(all-from "web-cells.ss") (all-from "web-cells.ss")
(all-from "servlet-helpers.ss")) (all-from "servlet-helpers.ss"))
;; ************************************************************ ;; ************************************************************
;; EXPORTS ;; EXPORTS