All checks were successful
/ test (push) Successful in 9s
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.
102 lines
3.7 KiB
Scheme
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)
|