safsaf/tests/test-templating.scm
Christopher Baines 5b0e6397dc
All checks were successful
/ test (push) Successful in 9s
Initial commit
Safsaf is a Guile web framework, written using Claude Code running
Claude Opus 4.6, based off of the Guix Data Service, Nar Herder and
Guix Build Coordinator codebases.
2026-04-13 14:24:19 +03:00

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