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

pr8515

Browse Source 
svn: r5561
This commit is contained in:
Jay McCarthy 2007-02-06 14:46:06 +00:00
parent 970a05a066
commit bb1f188642
23 changed files with 123 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/web-server/default-web-root/htdocs/Defaults/documentation/examples/add.ss
View File

@ -1,8 +1,9 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "date.ss"))
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
; request-number : str -> num
(define (request-number which-number)

5
collects/web-server/default-web-root/htdocs/Defaults/documentation/examples/count.ss
View File

@ -1,10 +1,11 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "date.ss"))
(let ([count 0]
[date (date->string (seconds->date (current-seconds)) 'time-too)])
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
(set! count (add1 count))

5
collects/web-server/default-web-root/htdocs/Defaults/documentation/examples/hello.ss
View File

@ -1,7 +1,8 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
(define the-text "Hello, Web!")

30
collects/web-server/default-web-root/servlets/examples/add-module.ss Normal file
View File

@ -0,0 +1,30 @@
(module add-module mzscheme
(require (lib "servlet.ss" "web-server")
(lib "date.ss"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 30)
; request-number : str -> num
(define (request-number which-number)
(string->number
(extract-binding/single
'number
(request-bindings (send/suspend (build-request-page which-number))))))
; build-request-page : str -> str -> response
(define (build-request-page which-number)
(lambda (k-url)
`(html (head (title "Enter a Number to Add"))
(body ([bgcolor "white"])
(form ([action ,k-url] [method "post"])
"Enter the " ,which-number " number to add: "
(input ([type "text"] [name "number"] [value ""]))
(input ([type "submit"] [name "enter"] [value "Enter"])))))))
(define (start initial-request)
`(html (head (title "Sum"))
(body ([bgcolor "white"])
(p "The sum is "
,(number->string (+ (request-number "first") (request-number "second"))))))))

5
collects/web-server/default-web-root/servlets/examples/add.ss
View File

@ -1,8 +1,9 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "date.ss"))
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
; request-number : str -> num
(define (request-number which-number)

16
collects/web-server/default-web-root/servlets/examples/compound/add.ss
View File

@ -1,10 +1,11 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
"helper-sig.ss")
(define main@
(unit/sig ()
(unit
(import servlet^ my-servlet-helpers^)
(export)
`(html (head (title "Sum"))
(body ([bgcolor "white"])
@ -12,9 +13,8 @@
,(number->string (+ (get-number "the first number to add")
(get-number "the second number to add"))))))))
(compound-unit/sig
(import (S : servlet^))
(link
[H : my-servlet-helpers^ ((load-relative "helper.ss") S)]
[M : () (main@ S H)])
(export (open M)))
(compound-unit (import (S : servlet^))
(export)
(link
(((H : my-servlet-helpers^)) ((load-relative "helper.ss") S))
(() main@ S H)))

2
collects/web-server/default-web-root/servlets/examples/compound/helper-sig.ss
View File

@ -1,5 +1,5 @@
(module helper-sig mzscheme
(provide my-servlet-helpers^)
(require (lib "unitsig.ss"))
(require (lib "unit.ss"))
(define-signature my-servlet-helpers^ (get-number)))

5
collects/web-server/default-web-root/servlets/examples/compound/helper.ss
View File

@ -1,10 +1,11 @@
(require (lib "xml.ss" "xml")
(lib "unitsig.ss")
(lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
"helper-sig.ss")
(unit/sig my-servlet-helpers^
(unit
(import servlet^)
(export my-servlet-helpers^)
; get-number : string -> number
; to prompt the user for a number

16
collects/web-server/default-web-root/servlets/examples/compound/multiply.ss
View File

@ -1,11 +1,12 @@
(require (lib "servlet-sig.ss" "web-server")
(lib "unitsig.ss")
(lib "unit.ss")
(lib "etc.ss")
"helper-sig.ss")
(define multiply@
(unit/sig ()
(unit
(import servlet^ my-servlet-helpers^)
(export)
; matrix = (listof (listof num))
@ -86,9 +87,8 @@
(matrix-multiply (get-matrix r c)
(get-matrix c r)))))))))
(compound-unit/sig
(import (S : servlet^))
(link
[H : my-servlet-helpers^ ((load-relative "helper.ss") S)]
[M : () (multiply@ S H)])
(export (open M)))
(compound-unit (import (S : servlet^))
(export)
(link
(((H : my-servlet-helpers^)) ((load-relative "helper.ss") S))
(() multiply@ S H)))

5
collects/web-server/default-web-root/servlets/examples/count.ss
View File

@ -1,10 +1,11 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "date.ss"))
(let ([count 0]
[date (date->string (seconds->date (current-seconds)) 'time-too)])
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
(define other-count 0)
(set! other-count (add1 other-count))

5
collects/web-server/default-web-root/servlets/examples/dir.ss
View File

@ -1,8 +1,9 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "date.ss"))
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
(send/back
`(html (head (title "Current Directory Page"))

5
collects/web-server/default-web-root/servlets/examples/hello.ss
View File

@ -1,7 +1,8 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
(define the-text "Hello, Web!")

5
collects/web-server/default-web-root/servlets/examples/quiz.ss
View File

@ -19,12 +19,13 @@
(define *questions-per-quiz* 5)
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "list.ss")
(lib "etc.ss"))
(unit/sig () (import servlet^)
(unit (import servlet^)
(export)
;; Accessors into question sexp's
(define question-text car)

7
collects/web-server/default-web-root/servlets/tests/bad-return.ss
View File

@ -1,5 +1,6 @@
(require (lib "unitsig.ss"))
(require (lib "servlet-sig.ss" "web-server"))
(unit/sig ()
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(unit
(import servlet^)
(export)
5)

7
collects/web-server/default-web-root/servlets/tests/broken.ss
View File

@ -1,5 +1,6 @@
(require (lib "unitsig.ss"))
(require (lib "servlet-sig.ss" "web-server"))
(unit/sig ()
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(unit
(import servlet^)
(export)
(raise 'kablooie))

5
collects/web-server/default-web-root/servlets/tests/incremental.ss
View File

@ -1,8 +1,9 @@
(require (lib "servlet-sig.ss" "web-server")
(lib "unitsig.ss"))
(lib "unit.ss"))
(unit/sig ()
(unit
(import servlet^)
(export)
(send/finish
(make-html-response/incremental

7
collects/web-server/default-web-root/servlets/tests/mime.ss
View File

@ -1,7 +1,8 @@
(require (lib "unitsig.ss"))
(require (lib "servlet-sig.ss" "web-server"))
(unit/sig ()
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(unit
(import servlet^)
(export)
`("text/uber-format"
"uber uber uber"
"-de-doo"))

7
collects/web-server/default-web-root/servlets/tests/size.ss
View File

@ -1,5 +1,5 @@
(require (lib "unitsig.ss"))
(require (lib "servlet-sig.ss" "web-server"))
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(let* ([line-size 80]
[build-a-str
@ -10,8 +10,9 @@
[else (cons #\a (loop (sub1 n)))]))))]
[line (build-a-str (sub1 line-size))]
[html-overhead 68])
(unit/sig ()
(unit
(import servlet^)
(export)
(define size (- (string->number (cdr (assq 'size bindings))) html-overhead))
(define nlines (quotient size line-size))

26
collects/web-server/default-web-root/servlets/tests/test.ss
View File

@ -1,15 +1,15 @@
(require (lib "unitsig.ss"))
(require (lib "servlet-sig.ss" "web-server"))
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server"))
(let ([count 0])
(unit/sig ()
(unit
(import servlet^)
(with-handlers ([void (lambda (exn) `(html (body (p ,(exn-message exn)))))])
(set! count (add1 count))
`(html (head (title "Testing 1...2...3"))
(body (p "This is a generated web page.")
(p ,(format "Here are the bindings:~n~s~n" (request-bindings initial-request))
(br)
"Count = " ,(number->string count)
(br)
,(format "Here are the headers:~n~s~n" (request-headers initial-request)))))))
)
(export)
(with-handlers ([void (lambda (exn) `(html (body (p ,(exn-message exn)))))])
(set! count (add1 count))
`(html (head (title "Testing 1...2...3"))
(body (p "This is a generated web page.")
(p ,(format "Here are the bindings:~n~s~n" (request-bindings initial-request))
(br)
"Count = " ,(number->string count)
(br)
,(format "Here are the headers:~n~s~n" (request-headers initial-request))))))))

5
collects/web-server/default-web-root/servlets/tests/url.ss
View File

@ -1,9 +1,10 @@
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "url.ss" "net"))
(let ([count 0])
(unit/sig ()
(unit
(import servlet^)
(export)
(set! count (add1 count))
`(html (head (title "URL Test"))
(body (p "The method requested is: " ,(format "~s" (request-method initial-request)))

8
collects/web-server/dispatchers/dispatch-servlets.ss
View File

@ -281,10 +281,12 @@
(define (load-servlet/path a-path)
(define (v0.servlet->v1.lambda servlet)
(lambda (initial-request)
(define servlet@ (unit-from-context servlet^))
(invoke-unit
(compound-unit (import) (export)
(link (((S : servlet^)) (unit-from-context servlet^))
(() servlet S))))))
(compound-unit
(import) (export)
(link (((S : servlet^)) servlet@)
(() servlet S))))))
(define (v0.response->v1.lambda response-path response)
(define go
(box

9
collects/web-server/private/configure.ss
View File

@ -1,5 +1,5 @@
(module configure mzscheme
(require (lib "unitsig.ss")
(require (lib "unit.ss")
(lib "servlet-sig.ss" "web-server")
(lib "url.ss" "net")
(lib "etc.ss")
@ -14,9 +14,9 @@
(lib "configuration-util.ss" "web-server" "private")
(lib "util.ss" "web-server" "private"))
(provide/contract
[servlet unit/sig?]
[servlet unit?]
; XXX contract
[servlet-maker (string? . -> . unit/sig?)])
[servlet-maker (string? . -> . unit?)])
;; FIX
; - fuss with changing absolute paths into relative ones internally
@ -32,8 +32,9 @@
; servlet-maker : str -> (unit/sig servlet^ -> ())
(define (servlet-maker default-configuration-path)
(unit/sig ()
(unit
(import servlet^)
(export)
(define CONFIGURE-SERVLET-NAME "configure.ss")
(define WIDE "70")

7
collects/web-server/private/servlet-language.ss
View File

@ -3,13 +3,14 @@
(lib "tool.ss" "drscheme")
(lib "contract.ss")
;(lib "mred.ss" "mred")
(lib "unitsig.ss"))
(lib "unit.ss"))
(provide/contract
[tool@ unit/sig?])
[tool@ unit?])
(define tool@
(unit/sig drscheme:tool-exports^
(unit
(import drscheme:tool^)
(export drscheme:tool-exports^)
(define (phase1) (void))
(define (phase2)
(add-servlet-language))