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

Unit contracts

Browse Source 
svn: r13711
This commit is contained in:
Jay McCarthy 2009-02-17 22:11:14 +00:00
parent bd208ad520
commit acef860a60
13 changed files with 93 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss
View File

@ -3,6 +3,7 @@
(provide start interface-version)
(define msg (make-parameter "unknown"))
(define printf void)
(define (gn)
(printf "gn ~a~n" (msg))

1
collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss
View File

@ -3,6 +3,7 @@
(provide start interface-version)
(define msg (make-web-parameter "unknown"))
(define printf void)
(define (gn)
(printf "gn ~a~n" (msg))

2
collects/web-server/default-web-root/htdocs/lang-servlets/add.ss
View File

@ -2,6 +2,8 @@
(define interface-version 'stateless)
(provide start interface-version)
(define printf void)
;; get-number-from-user: string -> number
;; ask the user for a number
(define (get-number msg)

9
collects/web-server/http/request.ss
View File

@ -1,6 +1,5 @@
#lang scheme
(require mzlib/contract
mzlib/plt-match
(require mzlib/plt-match
net/url
mzlib/list
net/uri-codec
@ -10,7 +9,11 @@
(provide/contract
[rename ext:read-request read-request
((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))])
(connection?
port-number?
(input-port? . -> . (values string? string?))
. -> .
(values request? boolean?))])
(define (ext:read-request conn host-port port-addresses)
(with-handlers ([exn? (lambda (exn)

14
collects/web-server/lang.ss
View File

@ -13,15 +13,15 @@
(provide (rename-out [lang-module-begin #%module-begin])
(all-from-out "lang/lang-api.ss"))
(define-for-syntax anormalize (make-anormal-term elim-letrec-term))
(define-syntax lang-module-begin
(make-lang-module-begin
make-labeling
(make-module-case/new-defs
(make-define-case/new-defs
(compose #;(lambda (stx) (values stx empty))
defun
elim-callcc
(make-anormal-term elim-letrec-term)
#;(make-anormal-term (lambda (x) x))
#;elim-letrec-term
)))))
(lambda (stx)
(define anf-stx (anormalize stx))
(define no-callcc-stx (elim-callcc anf-stx))
(define-values (defun-stx new-defs) (defun no-callcc-stx))
(values defun-stx new-defs))))))

20
collects/web-server/lang/util.ss
View File

@ -1,9 +1,21 @@
#lang scheme/base
(require (for-template scheme/base)
syntax/kerncase
mzlib/pretty
mzlib/list)
(provide (all-defined-out))
scheme/pretty
scheme/list
scheme/contract
syntax/kerncase)
(provide/contract
[transformer? (parameter/c boolean?)]
[recertify (syntax? syntax? . -> . syntax?)]
[recertify* (syntax? (listof syntax?) . -> . (listof syntax?))]
[recertify/new-defs (syntax? (-> (values syntax? (listof syntax?))) . -> . (values syntax? (listof syntax?)))]
[current-code-labeling (parameter/c (syntax? . -> . syntax?))]
[generate-formal ((symbol?) ((or/c false/c syntax?)) . ->* . (values syntax? syntax?))]
[formals-list (syntax? . -> . (listof syntax?))]
[make-define-case/new-defs ((syntax? . -> . (values syntax? (listof syntax?))) . -> . (syntax? . -> . (listof syntax?)))]
[make-module-case/new-defs ((syntax? . -> . (listof syntax?)) . -> . (syntax? . -> . (listof syntax?)))]
[make-lang-module-begin ((bytes? . -> . (-> symbol?)) (syntax? . -> . (listof syntax?)) . -> . (syntax? . -> . syntax?))]
[bound-identifier-member? (syntax? (listof syntax?) . -> . boolean?)])
(define transformer? (make-parameter #f))

25
collects/web-server/private/dispatch-server-sig.ss
View File

@ -1,13 +1,26 @@
#lang scheme/base
(require mzlib/unit)
#lang scheme
(require web-server/private/util
web-server/private/connection-manager)
(define-signature dispatch-server^
(serve
serve-ports))
((contracted
[serve (-> (-> void))]
[serve-ports (input-port? output-port? . -> . (-> void))])))
(define-signature dispatch-server-config^
(port listen-ip max-waiting initial-connection-timeout
read-request dispatch))
((contracted
[port port-number?]
[listen-ip (or/c string? false/c)]
[max-waiting integer?]
[initial-connection-timeout integer?]
[read-request
(connection?
port-number?
(input-port? . -> . (values string? string?))
. -> .
(values any/c boolean?))]
[dispatch
(-> connection? any/c void)])))
(provide
dispatch-server^ dispatch-server-config^)

20
collects/web-server/scribblings/private.scrbl
View File

@ -147,21 +147,19 @@ The @scheme[dispatch-server^] signature is an alias for
@defsignature[dispatch-server-config^ ()]{
@defthing[port port?]{Specifies the port to serve on.}
@defthing[listen-ip string?]{Passed to @scheme[tcp-accept].}
@defthing[port port-number?]{Specifies the port to serve on.}
@defthing[listen-ip (or/c string? false/c)]{Passed to @scheme[tcp-listen].}
@defthing[max-waiting integer?]{Passed to @scheme[tcp-accept].}
@defthing[initial-connection-timeout integer?]{Specifies the initial timeout given to a connection.}
@defproc[(read-request [c connection?]
[p port?]
[port-addresses (-> port? boolean?
(or/c (values string? string?)
(values string? (integer-in 1 65535)
string? (integer-in 1 65535))))])
any/c]{
[p port-number?]
[port-addresses
(input-port? . -> . (values string? string?))])
(values any/c boolean?)]{
Defines the way the server reads requests off connections to be passed
to @scheme[dispatch].
}
@defthing[dispatch dispatcher/c]{How to handle requests.}
@defthing[dispatch (-> connection? any/c void)]{How to handle requests.}
}
}
@ -173,8 +171,8 @@ The @scheme[dispatch-server^] signature is an alias for
The @schememodname[web-server/private/dispatch-server-unit] module
provides the unit that actually implements a dispatching server.
@defthing[dispatch-server@ (unit/c (tcp^ dispatch-server-config^)
(dispatch-server^))]{
@defthing[dispatch-server@ (unit/c (import tcp^ dispatch-server-config^)
(export dispatch-server^))]{
Runs the dispatching server config in a very basic way, except that it uses
@secref["connection-manager.ss"] to manage connections.
}

10
collects/web-server/scribblings/running.scrbl
View File

@ -99,7 +99,7 @@ of the @web-server in other applications, or loading a custom
dispatcher.
@defproc[(serve [#:dispatch dispatch dispatcher/c]
[#:tcp@ tcp@ tcp-unit^ raw:tcp@]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]
[#:port port integer? 80]
[#:listen-ip listen-ip (or/c string? false/c) #f]
[#:max-waiting max-waiting integer? 40]
@ -127,7 +127,7 @@ from a given path:
]
@defproc[(serve/ports [#:dispatch dispatch dispatcher/c]
[#:tcp@ tcp@ tcp-unit^ raw:tcp@]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]
[#:ports ports (listof integer?) (list 80)]
[#:listen-ip listen-ip (or/c string? false/c) #f]
[#:max-waiting max-waiting integer? 40]
@ -138,7 +138,7 @@ from a given path:
}
@defproc[(serve/ips+ports [#:dispatch dispatch dispatcher/c]
[#:tcp@ tcp@ tcp-unit^ raw:tcp@]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]
[#:ips+ports ips+ports (listof (cons/c (or/c string? false/c) (listof integer?))) (list (cons #f (list 80)))]
[#:max-waiting max-waiting integer? 40]
[#:initial-connection-timeout initial-connection-timeout integer? 60])
@ -147,8 +147,8 @@ from a given path:
a function that shuts down all of the server instances.
}
@defproc[(serve/web-config@ [config@ web-config^]
[#:tcp@ tcp@ tcp-unit^ raw:tcp@])
@defproc[(serve/web-config@ [config@ (unit/c (import) (export web-config^))]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@])
(-> void)]{
Starts the @web-server with the settings defined by the given @scheme[web-config^] unit.

10
collects/web-server/scribblings/web-config-unit.scrbl
View File

@ -31,7 +31,7 @@ Provides contains the following identifiers.
Passed to @scheme[tcp-accept].
}
@defthing[virtual-hosts (listof (cons/c string? host-table?))]{
@defthing[virtual-hosts (string? . -> . host?)]{
Contains the configuration of individual virtual hosts.
}
@ -43,8 +43,8 @@ Provides contains the following identifiers.
Specifies the port to serve HTTP on.
}
@defthing[listen-ip string?]{
Passed to @scheme[tcp-accept].
@defthing[listen-ip (or/c false/c string?)]{
Passed to @scheme[tcp-listen].
}
@defthing[make-servlet-namespace make-servlet-namespace/c]{
@ -62,7 +62,7 @@ Provides contains the following identifiers.
[#:port port (or/c false/c port-number?) #f]
[#:listen-ip listen-ip (or/c false/c string?) #f]
[#:make-servlet-namespace make-servlet-namespace make-servlet-namespace/c (make-make-servlet-namespace)])
(unit? web-config^)]{
(unit/c (import) (export web-config^))]{
Reads the S-expression at @scheme[path] and calls
@scheme[configuration-table-sexpr->web-config@] appropriately.
}
@ -74,7 +74,7 @@ Provides contains the following identifiers.
[#:listen-ip listen-ip (or/c false/c string?) #f]
[#:make-servlet-namespace make-servlet-namespace make-servlet-namespace/c
(make-make-servlet-namespace)])
(unit? web-config^)]{
(unit/c (import) (export web-config^))]{
Parses @scheme[sexpr] as a configuration-table and constructs a @scheme[web-config^] unit.
}

23
collects/web-server/web-config-sig.ss
View File

@ -1,8 +1,17 @@
#lang scheme/signature
#lang scheme
(require web-server/private/util
web-server/configuration/namespace
web-server/configuration/configuration-table-structs)
max-waiting
virtual-hosts
initial-connection-timeout
port
listen-ip
make-servlet-namespace
(provide
web-config^)
(define-signature
web-config^
((contracted
[max-waiting integer?]
[virtual-hosts (string? . -> . host?)]
[initial-connection-timeout integer?]
[port port-number?]
[listen-ip (or/c false/c string?)]
[make-servlet-namespace make-servlet-namespace/c])))

4
collects/web-server/web-config-unit.ss
View File

@ -14,14 +14,14 @@
(#:port (or/c false/c number?)
#:listen-ip (or/c false/c string?)
#:make-servlet-namespace make-servlet-namespace/c)
unit?)]
(unit/c (import) (export web-config^)))]
[configuration-table-sexpr->web-config@
(->* (configuration-table-sexpr?)
(#:web-server-root path-string?
#:port (or/c false/c number?)
#:listen-ip (or/c false/c string?)
#:make-servlet-namespace make-servlet-namespace/c)
unit?)])
(unit/c (import) (export web-config^)))])
; configuration-table->web-config@ : path -> configuration
(define (configuration-table->web-config@

8
collects/web-server/web-server.ss
View File

@ -14,7 +14,7 @@
(provide/contract
[serve
(->* (#:dispatch dispatcher/c)
(#:tcp@ unit?
(#:tcp@ (unit/c (import) (export tcp^))
#:port number?
#:listen-ip (or/c false/c string?)
#:max-waiting number?
@ -22,7 +22,7 @@
(-> void))]
[serve/ports
(->* (#:dispatch dispatcher/c)
(#:tcp@ unit?
(#:tcp@ (unit/c (import) (export tcp^))
#:ports (listof number?)
#:listen-ip (or/c false/c string?)
#:max-waiting number?
@ -30,13 +30,13 @@
(-> void))]
[serve/ips+ports
(->* (#:dispatch dispatcher/c)
(#:tcp@ unit?
(#:tcp@ (unit/c (import) (export tcp^))
#:ips+ports (listof (cons/c (or/c false/c string?) (listof number?)))
#:max-waiting number?
#:initial-connection-timeout number?)
(-> void))]
[do-not-return (-> void)]
[serve/web-config@ ((unit?) (#:tcp@ unit?) . ->* . (-> void?))])
[serve/web-config@ (((unit/c (import) (export web-config^))) (#:tcp@ (unit/c (import) (export tcp^))) . ->* . (-> void?))])
(define (do-not-return)
(semaphore-wait (make-semaphore 0)))