paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Add test for hsx/hsx package

Browse source
This commit is contained in:
paku 2024-05-26 12:26:09 +09:00
parent c29e8d4882
commit 55cf69582f
4 changed files with 136 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/element.lisp
View file

@ -19,10 +19,13 @@
:initarg :children))) :initarg :children)))
(defun create-element (type props &rest children) (defun create-element (type props &rest children)
(make-instance 'element (let ((elm (make-instance 'element
:type type :type type
:props props :props props
:children (flatten children))) :children (flatten children))))
(prog1 elm
;dry-run to validate props
(expand elm))))
(defmethod expand ((elm element)) (defmethod expand ((elm element))
(with-accessors ((type element-type) (with-accessors ((type element-type)
@ -34,8 +37,6 @@
(list :children children)))) (list :children children))))
elm))) elm)))
;;;; utils
(defun flatten (x) (defun flatten (x)
(labels ((rec (x acc) (labels ((rec (x acc)
(cond ((null x) acc) (cond ((null x) acc)

4
src/hsx.lisp
View file

@ -26,7 +26,7 @@
',props ',props
,@children)))) ,@children))))
(defmacro define-and-export-builtin-elements (&body names) (defmacro define-and-export-builtin-elements (&rest names)
`(progn `(progn
,@(mapcan (lambda (name) ,@(mapcan (lambda (name)
(list `(define-builtin-element ,name) (list `(define-builtin-element ,name)
@ -34,7 +34,7 @@
names))) names)))
(define-and-export-builtin-elements (define-and-export-builtin-elements
a abbr address area article aside audio b base bdi bdo blockquote a abbr address area article aside audio b base bdi bdo blockquote
body br button canvas caption cite code col colgroup data datalist body br button canvas caption cite code col colgroup data datalist
dd del details dfn dialog div dl dt em embed fieldset figcaption dd del details dfn dialog div dl dt em embed fieldset figcaption
figure footer form h1 h2 h3 h4 h5 h6 head header html hr i iframe figure footer form h1 h2 h3 h4 h5 h6 head header html hr i iframe

113
tests/element.lisp
View file

@ -4,26 +4,20 @@
:hsx/element)) :hsx/element))
(in-package :hsx-test/element) (in-package :hsx-test/element)
(def-suite create-element) (def-suite element-test)
(in-suite create-element) (in-suite element-test)
(test create-builtin-element (test builtin-element
(let* ((inner (create-element "span" (let ((elm (create-element "p"
'(:class "red") '(:class "red")
"World!")) "Hello,"
(outer (create-element "p" "World")))
nil (is (string= (element-type elm) "p"))
"Hello," (is (equal (element-props elm) '(:class "red")))
inner))) (is (equal (element-children elm) (list "Hello," "World")))))
(is (string= (element-type inner) "span"))
(is (equal (element-props inner) `(:class "red")))
(is (equal (element-children inner) (list "World!")))
(is (string= (element-type outer) "p"))
(is (null (element-props outer)))
(is (equal (element-children outer) (list "Hello," inner)))))
(test flatten-element-children (test flatten-children
(let* ((elm (create-element "p" (let* ((elm (create-element "p"
nil nil
"a" "a"
@ -32,22 +26,69 @@
(cons "d" "e")))) (cons "d" "e"))))
(is (equal (element-children elm) (list "a" "b" "c" "d" "e"))))) (is (equal (element-children elm) (list "a" "b" "c" "d" "e")))))
(test create-component-element (defun comp1 (&key title children)
(labels ((comp (&key variant children) (create-element "div"
(create-element "p" nil
`(:class ,variant) title
"Hello," children))
children)))
(let* ((inner (create-element "span" (test component-elment-with-keyword-args
nil (let* ((elm (create-element #'comp1
"World!")) '(:title "foo")
(outer (create-element #'comp "bar"))
'(:variant "red") (expanded (expand elm)))
inner))) (is (eql (element-type elm) #'comp1))
(is (eql (element-type outer) #'comp)) (is (equal (element-props elm) '(:title "foo")))
(is (equal (element-props outer) `(:variant "red"))) (is (equal (element-children elm) (list "bar")))
(is (equal (element-children outer) (list inner))) (is (string= (element-type expanded) "div"))
(let ((expanded-elm (expand outer))) (is (equal (element-children expanded) (list "foo" "bar")))
(is (string= (element-type expanded-elm) "p")) (signals error
(is (equal (element-props expanded-elm) `(:class "red"))) (create-element #'comp1
(is (equal (element-children expanded-elm) (list "Hello," inner))))))) '(:title "foo" :other-key "baz")
"bar"))))
(defun comp2 (&rest props)
(create-element "div"
nil
(getf props :title)
(getf props :children)))
(test component-element-with-property-list
(let* ((elm (create-element #'comp2
'(:title "foo")
"bar"))
(expanded (expand elm)))
(is (eql (element-type elm) #'comp2))
(is (equal (element-props elm) '(:title "foo")))
(is (equal (element-children elm) (list "bar")))
(is (string= (element-type expanded) "div"))
(is (equal (element-children expanded) (list "foo" "bar")))))
(defun comp3 (&rest props &key title children &allow-other-keys)
(create-element "div"
nil
title
children
(getf props :other-key)))
(defun comp4 (&rest props &key title children)
(create-element "div"
nil
title
children
(getf props :other-key)))
(test component-element-with-keyword-args-and-property-list
(let* ((elm (create-element #'comp3
'(:title "foo" :other-key "baz")
"bar"))
(expanded (expand elm)))
(is (eql (element-type elm) #'comp3))
(is (equal (element-props elm) '(:title "foo" :other-key "baz")))
(is (equal (element-children elm) (list "bar")))
(is (string= (element-type expanded) "div"))
(is (equal (element-children expanded) (list "foo" "bar" "baz")))
(signals error
(create-element #'comp4
'(:title "foo" :other-key "baz")
"bar"))))

68
tests/hsx.lisp
View file

@ -1,31 +1,63 @@
(defpackage #:hsx-test/hsx (defpackage #:hsx-test/hsx
(:use #:cl (:use #:cl
#:fiveam #:fiveam
#:hsx/element #:hsx/hsx)
#:hsx/hsx)) (:import-from #:hsx/element
#:create-element))
(in-package #:hsx-test/hsx) (in-package #:hsx-test/hsx)
(def-suite builtin-element-hsx) (def-suite hsx-test)
(def-suite component-element-hsx) (in-suite hsx-test)
(in-suite builtin-element-hsx)
(test empty-hsx (test empty-hsx
(let ((elm (div))) (is (equal (macroexpand-1
(is (null (element-props elm))) '(div))
(is (null (element-children elm))))) '(create-element
"div"
'nil))))
(test hsx-with-props (test hsx-with-props
(let ((elm (div :prop1 "value1" :prop2 "value2"))) (is (equal (macroexpand-1
(is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) '(div :prop1 "value1" :prop2 "value2"))
(is (null (element-children elm))))) '(create-element
"div"
'(:prop1 "value1" :prop2 "value2")))))
(test hsx-with-children (test hsx-with-children
(let ((elm (div "child1" "child2"))) (is (equal (macroexpand-1
(is (null (element-props elm))) '(div
(is (equal (element-children elm) (list "child1" "child2"))))) "child1"
"child2"))
'(create-element
"div"
'nil
"child1"
"child2"))))
(test hsx-with-props-and-children (test hsx-with-props-and-children
(let ((elm (div :prop1 "value1" :prop2 "value2" (is (equal (macroexpand-1
"child1" "child2"))) '(div :prop1 "value1" :prop2 "value2"
(is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) "child1"
(is (equal (element-children elm) (list "child1" "child2"))))) "child2"))
'(create-element
"div"
'(:prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(defcomp comp (&key prop1 prop2 children)
(div
prop1
prop2
children))
(test component-hsx
(is (equal (macroexpand-1
'(comp :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
#'%comp
'(:prop1 "value1" :prop2 "value2")
"child1"
"child2"))))