1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

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.
This commit is contained in:
Mark H Weaver 2013-09-12 18:45:13 -04:00
parent 3b2226ec91
commit 76702cdcef
2 changed files with 9 additions and 14 deletions

View file

@ -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))))

View file

@ -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))))