Add children slot to element

This commit is contained in:
paku 2024-05-26 00:57:06 +09:00
parent 6ddf42f6a4
commit 3eea6a4e39
2 changed files with 28 additions and 26 deletions

View file

@ -2,6 +2,7 @@
(:use #:cl) (:use #:cl)
(:export #:element-kind (:export #:element-kind
#:element-props #:element-props
#:element-children
#:create-element #:create-element
#:expand)) #:expand))
(in-package #:hsx/element) (in-package #:hsx/element)
@ -12,20 +13,25 @@
:initarg :kind) :initarg :kind)
(props (props
:reader element-props :reader element-props
:initarg :props))) :initarg :props)
(children
:reader element-children
:initarg :children)))
(defun create-element (kind props &rest children) (defun create-element (kind props &rest children)
(make-instance 'element (make-instance 'element
:kind kind :kind kind
:props (append props :props props
(and children :children (flatten children)))
(list :children (flatten children))))))
(defmethod expand ((elm element)) (defmethod expand ((elm element))
(with-accessors ((kind element-kind) (with-accessors ((kind element-kind)
(props element-props)) elm (props element-props)
(children element-children)) elm
(if (functionp kind) (if (functionp kind)
(apply kind props) (apply kind (append props
(and children
(list :children children))))
elm))) elm)))
;;;; utils ;;;; utils

View file

@ -8,7 +8,7 @@
(in-suite create-element) (in-suite create-element)
(test create-html-element (test create-builtin-element
(let* ((inner (create-element "span" (let* ((inner (create-element "span"
'(:class "red") '(:class "red")
"World!")) "World!"))
@ -16,14 +16,12 @@
nil nil
"Hello," "Hello,"
inner))) inner)))
(with-accessors ((kind element-kind) (is (string= (element-kind inner) "span"))
(props element-props)) inner (is (equal (element-props inner) `(:class "red")))
(is (string= kind "span")) (is (equal (element-children inner) (list "World!")))
(is (equal props `(:class "red" :children ("World!"))))) (is (string= (element-kind outer) "p"))
(with-accessors ((kind element-kind) (is (null (element-props outer)))
(props element-props)) outer (is (equal (element-children outer) (list "Hello," inner)))))
(is (string= kind "p"))
(is (equal props `(:children ("Hello," ,inner)))))))
(test flatten-element-children (test flatten-element-children
(let* ((elm (create-element "p" (let* ((elm (create-element "p"
@ -31,9 +29,8 @@
"a" "a"
nil nil
(list "b" (list nil "c")) (list "b" (list nil "c"))
(cons "d" "e"))) (cons "d" "e"))))
(children (getf (element-props elm) :children))) (is (equal (element-children elm) (list "a" "b" "c" "d" "e")))))
(is (equal children (list "a" "b" "c" "d" "e")))))
(test create-component-element (test create-component-element
(labels ((comp (&key variant children) (labels ((comp (&key variant children)
@ -47,11 +44,10 @@
(outer (create-element #'comp (outer (create-element #'comp
'(:variant "red") '(:variant "red")
inner))) inner)))
(with-accessors ((kind element-kind) (is (eql (element-kind outer) #'comp))
(props element-props)) outer (is (equal (element-props outer) `(:variant "red")))
(is (eql kind #'comp)) (is (equal (element-children outer) (list inner)))
(is (equal props `(:variant "red" :children (,inner))))) (let ((expanded-elm (expand outer)))
(with-accessors ((kind element-kind) (is (string= (element-kind expanded-elm) "p"))
(props element-props)) (expand outer) (is (equal (element-props expanded-elm) `(:class "red")))
(is (string= kind "p")) (is (equal (element-children expanded-elm) (list "Hello," inner)))))))
(is (equal props `(:class "red" :children ("Hello," ,inner))))))))