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

Fix defcomp to detect components in HSX

Browse source
This commit is contained in:
paku 2024-12-13 01:33:01 +09:00
parent 3193054e04
commit dfc074ec71
2 changed files with 42 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
src/dsl.lisp
View file

@ -13,27 +13,34 @@
;;;; hsx macro ;;;; hsx macro
(defmacro hsx (form) (defmacro hsx (form)
"Detect built-in HSX elements and automatically import them." "Detect HSX elements and automatically import them."
(find-builtin-symbols form)) (detect-elements form))
(defun get-builtin-symbol (sym) (defun get-builtin-symbol (sym)
(multiple-value-bind (builtin-sym kind) (multiple-value-bind (builtin-sym kind)
(find-symbol (string sym) :hsx/builtin) (find-symbol (string sym) :hsx/builtin)
(and (eq kind :external) builtin-sym))) (and (eq kind :external) builtin-sym)))
(defun find-builtin-symbols (form) (defun start-with-tilde-p (sym)
(string= "~" (subseq (string sym) 0 1)))
(defun get-component-symbol (sym)
(and (start-with-tilde-p sym) sym))
(defun detect-elements (form)
(check-type form cons) (check-type form cons)
(let* ((head (first form)) (let* ((head (first form))
(tail (rest form)) (tail (rest form))
(well-formed-p (listp tail)) (well-formed-p (listp tail))
(builtin-sym (and (symbolp head) (detected-sym (and (symbolp head)
(not (keywordp head)) (not (keywordp head))
(get-builtin-symbol head)))) (or (get-builtin-symbol head)
(if (and well-formed-p builtin-sym) (get-component-symbol head)))))
(cons builtin-sym (if (and well-formed-p detected-sym)
(cons detected-sym
(mapcar (lambda (sub-form) (mapcar (lambda (sub-form)
(if (consp sub-form) (if (consp sub-form)
(find-builtin-symbols sub-form) (detect-elements sub-form)
sub-form)) sub-form))
tail)) tail))
form))) form)))
@ -67,16 +74,19 @@
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
(defhsx ,name ,(make-keyword name)))) (defhsx ,name ,(make-keyword name))))
(defmacro defcomp (name props &body body) (defmacro defcomp (~name props &body body)
"Define a function component for use in HSX. "Define a function component for HSX.
The props must be declared with either &key or &rest (or both). The component name must start with a tilde (~).
Properties must be declared using &key, &rest, or both.
The body must return an HSX element." The body must return an HSX element."
(unless (start-with-tilde-p ~name)
(error "The component name must start with a tilde (~~)."))
(unless (or (null props) (unless (or (null props)
(member '&key props) (member '&key props)
(member '&rest props)) (member '&rest props))
(error "Component properties must be declared with either &key, &rest, or both.")) (error "Component properties must be declared with either &key, &rest, or both."))
(let ((%name (symbolicate '% name))) (let ((%name (symbolicate '% ~name)))
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
(defun ,%name ,props (defun ,%name ,props
,@body) ,@body)
(defhsx ,name (fdefinition ',%name))))) (defhsx ,~name (fdefinition ',%name)))))

35
tests/dsl.lisp
View file

@ -8,33 +8,34 @@
#:element-children)) #:element-children))
(in-package #:hsx-test/dsl) (in-package #:hsx-test/dsl)
(deftest find-builtin-symbols-test (defcomp ~comp1 (&key children)
(testing "normal-cases" (hsx (div children)))
(deftest detect-elements-test
(testing "detect-tags"
(ok (expands '(hsx (div div div)) (ok (expands '(hsx (div div div))
'(hsx/builtin:div div div))) '(hsx/builtin:div div div)))
(ok (expands '(hsx (div (div div (div)))) (ok (expands '(hsx (div (div div (div))))
'(hsx/builtin:div '(hsx/builtin:div
(hsx/builtin:div (hsx/builtin:div
div div
(hsx/builtin:div))))) (hsx/builtin:div))))))
(ok (expands '(hsx (div
(labels ((div () "div"))
(hsx (div)))))
'(hsx/builtin:div
(labels ((div () "div"))
(hsx (div)))))))
(testing "ignore-cases" (testing "detect-components"
(ok (expands '(hsx (~comp1 (div)))
'(~comp1 (hsx/builtin:div)))))
(testing "ignore-malformed-form"
(ok (expands '(hsx (div . div)) (ok (expands '(hsx (div . div))
'(div . div))) '(div . div)))
(ok (expands '(hsx ((div))) (ok (expands '(hsx ((div)))
'((div)))) '((div)))))
(ok (expands '(hsx (div
(labels ((div () "div")) (testing "ignore-cl-form"
(div)))) (ok (expands '(hsx (labels ((div () "div"))
'(hsx/builtin:div (div)))
(labels ((div () "div")) '(labels ((div () "div"))
(div))))))) (div))))))
(deftest dsl-test (deftest dsl-test
(testing "empty-hsx" (testing "empty-hsx"