103 lines
3.7 KiB
Scheme
103 lines
3.7 KiB
Scheme
|
;; Safsaf, a Guile web framework
|
||
|
|
;; Copyright (C) 2026 Christopher Baines <mail@cbaines.net>
|
||
|
|
|
||
|
|
;; This program is free software: you can redistribute it and/or
|
||
|
|
;; modify it under the terms of the GNU Lesser General Public License
|
||
|
|
;; as published by the Free Software Foundation, either version 3 of
|
||
|
|
;; the License, or (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This program is distributed in the hope that it will be useful, but
|
||
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
|
|
;; Lesser General Public License for more details.
|
||
|
|
;;
|
||
|
|
;; You should have received a copy of the GNU Lesser General Public
|
||
|
|
;; License along with this program. If not, see
|
||
|
|
;; <https://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; test-templating.scm — Tests for (safsaf templating)
|
||
|
|
|
||
|
|
(use-modules (tests support)
|
||
|
|
(safsaf templating)
|
||
|
|
(htmlprag)
|
||
|
|
(srfi srfi-71)
|
||
|
|
(web response))
|
||
|
|
|
||
|
|
(define (render shtml)
|
||
|
|
"Write SHTML via write-shtml-as-html/streaming and capture as a string."
|
||
|
|
(call-with-output-string
|
||
|
|
(lambda (port) (write-shtml-as-html/streaming shtml port))))
|
||
|
|
|
||
|
|
(define-suite templating-tests
|
||
|
|
|
||
|
|
(suite "write-shtml-as-html/streaming"
|
||
|
|
|
||
|
|
(test "pure static shtml"
|
||
|
|
(let ((out (render '(p "hello"))))
|
||
|
|
(is (string-contains out "<p>hello</p>"))))
|
||
|
|
|
||
|
|
(test "single proc slot"
|
||
|
|
(let ((out (render
|
||
|
|
`(div ,(lambda (port) (display "dynamic" port))))))
|
||
|
|
(is (string-contains out "dynamic"))))
|
||
|
|
|
||
|
|
(test "multiple slots in order"
|
||
|
|
(let ((out (render
|
||
|
|
`(div ,(lambda (port) (display "AAA" port))
|
||
|
|
,(lambda (port) (display "BBB" port))))))
|
||
|
|
(let ((a (string-contains out "AAA"))
|
||
|
|
(b (string-contains out "BBB")))
|
||
|
|
(is a)
|
||
|
|
(is b)
|
||
|
|
(is (< a b)))))
|
||
|
|
|
||
|
|
(test "static content between slots preserved"
|
||
|
|
(let ((out (render
|
||
|
|
`(div ,(lambda (port) (display "X" port))
|
||
|
|
(hr)
|
||
|
|
,(lambda (port) (display "Y" port))))))
|
||
|
|
(is (string-contains out "<hr"))))
|
||
|
|
|
||
|
|
(test "nested element with proc child"
|
||
|
|
(let ((out (render
|
||
|
|
`(html (body ,(lambda (port) (display "inner" port)))))))
|
||
|
|
(is (string-contains out "<body>inner</body>"))))
|
||
|
|
|
||
|
|
(test "attributes preserved"
|
||
|
|
(let ((out (render
|
||
|
|
`(div (@ (class "box"))
|
||
|
|
,(lambda (port) (display "content" port))))))
|
||
|
|
(is (string-contains out "class=\"box\""))
|
||
|
|
(is (string-contains out "content"))))
|
||
|
|
|
||
|
|
(test "*TOP* with procs"
|
||
|
|
(let ((out (render
|
||
|
|
`(*TOP*
|
||
|
|
(*DECL* DOCTYPE html)
|
||
|
|
(html (body ,(lambda (port) (display "hi" port))))))))
|
||
|
|
(is (string-contains out "<!DOCTYPE html>"))
|
||
|
|
(is (string-contains out "hi"))))
|
||
|
|
|
||
|
|
(test "proc can write shtml via htmlprag"
|
||
|
|
(let ((out (render
|
||
|
|
`(div ,(lambda (port)
|
||
|
|
(write-shtml-as-html '(p "from-proc") port))))))
|
||
|
|
(is (string-contains out "<p>from-proc</p>")))))
|
||
|
|
|
||
|
|
(suite "streaming-html-response"
|
||
|
|
|
||
|
|
(test "returns response and writer"
|
||
|
|
(let ((resp body (streaming-html-response '(p "hi"))))
|
||
|
|
(is (= 200 (response-code resp)))
|
||
|
|
(is (procedure? body))
|
||
|
|
(is (equal? '(text/html (charset . "utf-8"))
|
||
|
|
(assq-ref (response-headers resp) 'content-type)))))
|
||
|
|
|
||
|
|
(test "body writes shtml with procs"
|
||
|
|
(let ((resp body (streaming-html-response
|
||
|
|
`(div ,(lambda (port) (display "streamed" port))))))
|
||
|
|
(let ((out (call-with-output-string body)))
|
||
|
|
(is (string-contains out "streamed")))))))
|
||
|
|
|
||
|
|
(run-tests templating-tests)
|