Correcting tests and examples

collects/tests/web-server/dispatchers/dispatch-files-test.rkt

@@ -112,7 +112,7 @@
                 #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
    (test-equal? "dir, not dir-url, get"
                 (collect (dispatch #t a-dir) (req #f #"GET" empty))
-                #"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Length: 0\r\nContent-Type: text/html\r\nLocation: /foo/\r\n\r\n")
+                #"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nLocation: /foo/\r\n\r\n")
    (test-exn "dir, not exists, get"
              exn:dispatcher?
              (lambda () (collect (dispatch #f a-dir) (req #t #"GET" empty))))

collects/tests/web-server/run-all-tests.rkt

@@ -4,8 +4,7 @@
 (require rackunit/text-ui)
 (run-tests all-web-server-tests)
 
-#|
-(require rackunit/gui)
-(test/gui all-web-server-tests)
 
-|#
+#;(require rackunit/gui)
+#;(test/gui all-web-server-tests)
+

collects/web-server/default-web-root/htdocs/servlets/examples/clear.rkt

@@ -6,7 +6,8 @@
 (define (start initial-request)
   (parameterize ([current-servlet-continuation-expiration-handler
                   (lambda _
-                    `(html (body "Expired")))])
+                    (response/xexpr
+                     `(html (body "Expired"))))])
     (send/suspend (lambda (k-url) (response/xexpr `(html (a ([href ,k-url]) "Link")))))
     (send/forward (lambda (k-url) (response/xexpr `(html (a ([href ,k-url]) "Link")))))
     (send/finish (response/xexpr `(html (body "Done."))))))

collects/web-server/default-web-root/htdocs/servlets/examples/count.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require racket/date)
+(require racket/date
+         web-server/http)
 (provide (all-defined-out))
 (define interface-version 'v1)
 (define timeout +inf.0)

collects/web-server/default-web-root/htdocs/servlets/examples/hello.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+(require web-server/http)
 (provide (all-defined-out))
 (define interface-version 'v1)
 (define timeout +inf.0)

collects/web-server/formlets/servlet.rkt

@@ -5,7 +5,7 @@
 
 (provide/contract
  [send/formlet ((formlet*/c)
-                (#:wrap (pretty-xexpr/c . -> . response?))                 
+                (#:wrap (pretty-xexpr/c . -> . pretty-xexpr/c))
                 . ->* . any)])
 
 (define (send/formlet f
@@ -18,9 +18,10 @@
    f
    (send/suspend
     (lambda (k-url)
-      (wrapper
-       `(form ([action ,k-url])
-              ,@(formlet-display f)))))))
+      (response/xexpr
+       (wrapper
+        `(form ([action ,k-url])
+               ,@(formlet-display f))))))))
 
 (provide/contract
  [embed-formlet (embed/url/c formlet*/c . -> . pretty-xexpr/c)])

collects/web-server/http.rkt

@@ -1,15 +1,17 @@
-#lang racket
+#lang racket/base
 (require web-server/http/basic-auth
          web-server/http/digest-auth
          web-server/http/request-structs
          web-server/http/response-structs
          web-server/http/cookie
          web-server/http/cookie-parse
-         web-server/http/redirect)
+         web-server/http/redirect
+         web-server/http/xexpr)
 (provide (all-from-out web-server/http/basic-auth
                        web-server/http/digest-auth
                        web-server/http/request-structs
                        web-server/http/response-structs
                        web-server/http/cookie
                        web-server/http/cookie-parse
-                       web-server/http/redirect))
+                       web-server/http/redirect
+                       web-server/http/xexpr))

collects/web-server/http/response-structs.rkt

@@ -17,7 +17,7 @@
                    headers)
             (lambda (op)
               (for ([b (in-list body)])
-                (write-bytes op)))))
+                (write-bytes b op)))))
 
 (provide/contract
  [struct response

collects/web-server/http/xexpr.rkt

@@ -2,9 +2,10 @@
 (require racket/contract
          racket/list
          xml
-         web-server/http/cookie
          web-server/private/xexpr
-         web-server/http/response-structs)
+         "request-structs.rkt"
+         "cookie.rkt"
+         "response-structs.rkt")
 
 (define (response/xexpr
          xexpr

collects/web-server/servlet/setup.rkt

@@ -176,7 +176,7 @@
           [else
            (make-v1.servlet (directory-part a-path) timeouts-default-servlet
                             (v0.response->v1.lambda 
-                             (contract response? s
+                             (contract response? (response/xexpr s)
                                        pos-blame neg-blame
                                        path-string loc)
                              a-path))])))))