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

36
src/dsl.lisp
View file

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

35
tests/dsl.lisp
View file

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