diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-09-12 18:45:13 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-09-12 18:45:13 -0400 |
| commit | 76702cdcefb1d4a149b78fa0a474d22bed348e75 (patch) | |
| tree | 8890026d5e60de5a5b303afe38e3014beaf220d0 | |
| parent | 3b2226ec916b648b23a2ae30ce1a657d16d61314 (diff) | |
| download | guile-76702cdcefb1d4a149b78fa0a474d22bed348e75.tar.gz | |
Web: Use functional setters in extend-request and extend-response.
* module/web/client.scm (extend-request):
* module/web/server.scm (extend-response): Reimplement using
functional setters.
| -rw-r--r-- | module/web/client.scm | 13 | ||||
| -rw-r--r-- | module/web/server.scm | 10 |
2 files changed, 9 insertions, 14 deletions
diff --git a/module/web/client.scm b/module/web/client.scm index 4da361ab7..3f6c45bfe 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -41,6 +41,8 @@ #:use-module (web uri) #:use-module (web http) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:export (current-http-proxy open-socket-for-uri http-get @@ -103,14 +105,9 @@ (loop (cdr addresses)))))))) (define (extend-request r k v . additional) - (let ((r (build-request (request-uri r) - #:method (request-method r) - #:version (request-version r) - #:headers - (assoc-set! (copy-tree (request-headers r)) - k v) - #:port (request-port r) - #:meta (request-meta r)))) + (let ((r (set-field r (request-headers) + (assoc-set! (copy-tree (request-headers r)) + k v)))) (if (null? additional) r (apply extend-request r additional)))) diff --git a/module/web/server.scm b/module/web/server.scm index bc204808d..99196faf9 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -74,6 +74,7 @@ (define-module (web server) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (web request) @@ -164,12 +165,9 @@ values." #:post-error (lambda _ (values #f #f #f)))) (define (extend-response r k v . additional) - (let ((r (build-response #:version (response-version r) - #:code (response-code r) - #:headers - (assoc-set! (copy-tree (response-headers r)) - k v) - #:port (response-port r)))) + (let ((r (set-field r (response-headers) + (assoc-set! (copy-tree (response-headers r)) + k v)))) (if (null? additional) r (apply extend-response r additional)))) |