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:
parent
3b2226ec91
commit
76702cdcef
2 changed files with 9 additions and 14 deletions
|
@ -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))))
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue