mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

Web: Use functional setters in extend-request and extend-response.

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

11
module/web/client.scm
View file

@ -41,6 +41,8 @@
#:use-module (web uri) #:use-module (web uri)
#:use-module (web http) #:use-module (web http)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:export (current-http-proxy #:export (current-http-proxy
open-socket-for-uri open-socket-for-uri
http-get http-get
@ -103,14 +105,9 @@
(loop (cdr addresses)))))))) (loop (cdr addresses))))))))
(define (extend-request r k v . additional) (define (extend-request r k v . additional)
(let ((r (build-request (request-uri r) (let ((r (set-field r (request-headers)
#:method (request-method r)
#:version (request-version r)
#:headers
(assoc-set! (copy-tree (request-headers r)) (assoc-set! (copy-tree (request-headers r))
k v) k v))))
#:port (request-port r)
#:meta (request-meta r))))
(if (null? additional) (if (null? additional)
r r
(apply extend-request r additional)))) (apply extend-request r additional))))

8
module/web/server.scm
View file

@ -74,6 +74,7 @@
(define-module (web server) (define-module (web server)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:use-module (web request) #:use-module (web request)
@ -164,12 +165,9 @@ values."
#:post-error (lambda _ (values #f #f #f)))) #:post-error (lambda _ (values #f #f #f))))
(define (extend-response r k v . additional) (define (extend-response r k v . additional)
(let ((r (build-response #:version (response-version r) (let ((r (set-field r (response-headers)
#:code (response-code r)
#:headers
(assoc-set! (copy-tree (response-headers r)) (assoc-set! (copy-tree (response-headers r))
k v) k v))))
#:port (response-port r))))
(if (null? additional) (if (null? additional)
r r
(apply extend-response r additional)))) (apply extend-response r additional))))