diff --git a/module/web/http.scm b/module/web/http.scm index 2c1e93a81..d2117145b 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -860,6 +860,16 @@ phrase\"." (declare-header! name split-and-trim list-of-strings? write-list-of-strings)) +;; emacs: (put 'declare-symbol-list-header! 'scheme-indent-function 1) +(define (declare-symbol-list-header! name) + (declare-header! name + (lambda (str) + (map string->symbol (split-and-trim str))) + (lambda (v) + (list-of? symbol? v)) + (lambda (v port) + (write-list v port display ", ")))) + ;; emacs: (put 'declare-header-list-header! 'scheme-indent-function 1) (define (declare-header-list-header! name) (declare-header! name @@ -969,7 +979,7 @@ phrase\"." ;; e.g. ;; Connection: close, foo-header ;; -(declare-string-list-header! "Connection") +(declare-header-list-header! "Connection") ;; Date = "Date" ":" HTTP-date ;; e.g. @@ -1090,11 +1100,11 @@ phrase\"." ;; Allow = #Method ;; -(declare-string-list-header! "Allow") +(declare-symbol-list-header! "Allow") ;; Content-Encoding = 1#content-coding ;; -(declare-string-list-header! "Content-Encoding") +(declare-symbol-list-header! "Content-Encoding") ;; Content-Language = 1#language-tag ;; @@ -1407,7 +1417,7 @@ phrase\"." ;; Accept-Ranges = acceptable-ranges ;; acceptable-ranges = 1#range-unit | "none" ;; -(declare-string-list-header! "Accept-Ranges") +(declare-symbol-list-header! "Accept-Ranges") ;; Age = age-value ;; age-value = delta-seconds diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index aa7ddf670..ecefe7c00 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -83,8 +83,8 @@ (pass-if-parse cache-control "no-cache,max-age=10" '(no-cache (max-age . 10))) - (pass-if-parse connection "close" '("close")) - (pass-if-parse connection "close, foo" '("close" "foo")) + (pass-if-parse connection "close" '(close)) + (pass-if-parse connection "Content-Encoding" '(content-encoding)) (pass-if-parse date "Tue, 15 Nov 1994 08:12:31 GMT" (string->date "Tue, 15 Nov 1994 08:12:31 +0000" @@ -114,8 +114,8 @@ "~a, ~d ~b ~Y ~H:~M:~S ~z"))))) (with-test-prefix "entity headers" - (pass-if-parse allow "foo, bar" '("foo" "bar")) - (pass-if-parse content-encoding "qux, baz" '("qux" "baz")) + (pass-if-parse allow "foo, bar" '(foo bar)) + (pass-if-parse content-encoding "qux, baz" '(qux baz)) (pass-if-parse content-language "qux, baz" '("qux" "baz")) (pass-if-parse content-length "100" 100) (pass-if-parse content-length "0" 0) @@ -187,7 +187,7 @@ ;; Response headers ;; (with-test-prefix "response headers" - (pass-if-parse accept-ranges "foo,bar" '("foo" "bar")) + (pass-if-parse accept-ranges "foo,bar" '(foo bar)) (pass-if-parse age "30" 30) (pass-if-parse etag "\"foo\"" '("foo" . #t)) (pass-if-parse etag "W/\"foo\"" '("foo" . #f)) diff --git a/test-suite/tests/web-response.test b/test-suite/tests/web-response.test index 278b0b3e3..7e7331ea7 100644 --- a/test-suite/tests/web-response.test +++ b/test-suite/tests/web-response.test @@ -72,12 +72,12 @@ abcdefghijklmnopqrstuvwxyz0123456789") `((date . ,(string->date "Wed, 03 Nov 2010 22:27:07 +0000" "~a, ~d ~b ~Y ~H:~M:~S ~z")) (server . "Apache/2.0.55") - (accept-ranges . ("bytes")) + (accept-ranges . (bytes)) (cache-control . ((max-age . 543234))) (expires . ,(string->date "Thu, 28 Oct 2010 15:33:13 GMT +0000" "~a, ~d ~b ~Y ~H:~M:~S ~z")) (vary . (accept-encoding)) - (content-encoding . ("gzip")) + (content-encoding . (gzip)) (content-length . 36) (content-type . (text/html (charset . "utf-8")))))) @@ -96,4 +96,4 @@ abcdefghijklmnopqrstuvwxyz0123456789") (responses-equal? r body r* body*)))) (pass-if "by accessor" - (equal? (response-content-encoding r) '("gzip"))))) + (equal? (response-content-encoding r) '(gzip)))))