cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve render procedures

Browse source
This commit is contained in:
Christopher Baines 2025-06-19 09:40:01 +01:00
parent 41c0d76a3d
commit 9f431462db
1 changed files with 29 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

49
guix-data-service/web/render.scm
View file

@ -26,6 +26,7 @@
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 iconv) #:use-module (ice-9 iconv)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:use-module (ice-9 textual-ports)
#:use-module (web request) #:use-module (web request)
#:use-module (web response) #:use-module (web response)
#:use-module (web uri) #:use-module (web uri)
@ -147,15 +148,15 @@
'((content-type . (text/html '((content-type . (text/html
(charset . "utf-8"))) (charset . "utf-8")))
(vary . (accept))))) (vary . (accept)))))
(if stream? (and
(lambda (port) sxml
(set-port-encoding! port "utf-8") (if stream?
(setvbuf port 'block (expt 2 20))
(sxml->html sxml port))
(call-with-encoded-output-string
"utf-8"
(lambda (port) (lambda (port)
(sxml->html sxml port)))))) (sxml->html sxml port))
(call-with-encoded-output-string
"utf-8"
(lambda (port)
(sxml->html sxml port)))))))
(define* (render-json json #:key (extra-headers '()) (define* (render-json json #:key (extra-headers '())
(code 200) (code 200)
@ -166,27 +167,35 @@
'((content-type . (application/json '((content-type . (application/json
(charset . "utf-8"))) (charset . "utf-8")))
(vary . (accept))))) (vary . (accept)))))
(if stream?
(lambda (port) (and
(setvbuf port 'block (expt 2 16)) json
(scm->json json port #:unicode #t)) (if stream?
(call-with-encoded-output-string
"utf-8"
(lambda (port) (lambda (port)
(scm->json json port #:unicode #t)))))) (scm->json json port #:unicode #t))
(call-with-encoded-output-string
"utf-8"
(lambda (port)
(scm->json json port)))))))
(define* (render-text text #:key (extra-headers '()) (define* (render-text text #:key (extra-headers '())
(code 200)) (code 200)
stream?)
(list (build-response (list (build-response
#:code code #:code code
#:headers (append extra-headers #:headers (append extra-headers
'((content-type . (text/plain '((content-type . (text/plain
(charset . "utf-8"))) (charset . "utf-8")))
(vary . (accept))))) (vary . (accept)))))
(call-with-encoded-output-string (and
"utf-8" text
(lambda (port) (if stream?
(display text port))))) (lambda (port)
(put-string port text))
(call-with-encoded-output-string
"utf-8"
(lambda (port)
(display text port)))))))
(define (not-found uri) (define (not-found uri)
(list (build-response #:code 404) (list (build-response #:code 404)