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

Improve find-builtin-symbols

Browse source
This commit is contained in:
paku 2024-12-12 12:57:05 +09:00
parent 011ccd6b2a
commit a170c58530
2 changed files with 63 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
src/dsl.lisp
View file

@ -16,18 +16,27 @@
"Detect built-in HSX elements and automatically import them."
(find-builtin-symbols form))
(defun find-builtin-symbols (node)
(if (atom node)
(or (and (symbolp node)
(not (keywordp node))
(find-symbol (string node) :hsx/builtin))
node)
(cons (find-builtin-symbols (car node))
(mapcar (lambda (n)
(if (listp n)
(find-builtin-symbols n)
n))
(cdr node)))))
(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)
(check-type form cons)
(let* ((head (first form))
(tail (rest form))
(well-formed-p (listp tail))
(builtin-sym (and (symbolp head)
(not (keywordp head))
(get-builtin-symbol head))))
(if (and well-formed-p builtin-sym)
(cons builtin-sym
(mapcar (lambda (sub-form)
(if (consp sub-form)
(find-builtin-symbols sub-form)
sub-form))
tail))
form)))
;;;; defhsx macro

73
tests/dsl.lisp
View file

@ -1,67 +1,78 @@
(defpackage #:hsx-test/dsl
(:use #:cl
#:rove
#:hsx/dsl
#:hsx/builtin)
#:hsx/dsl)
(:import-from #:hsx/builtin)
(:import-from #:hsx/element
#:element-props
#:element-children))
(in-package #:hsx-test/dsl)
(deftest find-builtin-symbols-test
(testing "normal-cases"
(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)))))))
(testing "ignore-cases"
(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)))))))
(deftest dsl-test
(testing "find-symbols"
(ok (expands
'(hsx (div '(:div "div")
div
(div
'div
(div)
:div)
"div"))
'(hsx/builtin:div '(:div "div")
div
(hsx/builtin:div
'div
(hsx/builtin:div)
:div)
"div"))))
(testing "empty-hsx"
(let ((elm (div)))
(let ((elm (hsx (div))))
(ok (null (element-props elm)))
(ok (null (element-children elm)))))
(testing "hsx-with-static-props"
(let ((elm (div :prop1 "value1" :prop2 "value2")))
(let ((elm (hsx (div :prop1 "value1" :prop2 "value2"))))
(ok (equal '(:prop1 "value1" :prop2 "value2")
(element-props elm)))
(ok (null (element-children elm)))))
(testing "hsx-with-dynamic-props"
(let* ((props '(:prop1 "value1" :prop2 "value2"))
(elm (div props)))
(elm (hsx (div props))))
(ok (equal props (element-props elm)))
(ok (null (element-children elm)))))
(testing "hsx-with-children"
(let ((elm (div
"child1"
"child2")))
(let ((elm (hsx (div
"child1"
"child2"))))
(ok (null (element-props elm)))
(ok (equal (list "child1" "child2") (element-children elm)))))
(testing "hsx-with-static-props-and-children"
(let ((elm (div :prop1 "value1" :prop2 "value2"
"child1"
"child2")))
(let ((elm (hsx (div :prop1 "value1" :prop2 "value2"
"child1"
"child2"))))
(ok (equal '(:prop1 "value1" :prop2 "value2")
(element-props elm)))
(ok (equal (list "child1" "child2") (element-children elm)))))
(testing "hsx-with-dynamic-props-and-children"
(let* ((props '(:prop1 "value1" :prop2 "value2"))
(elm (div props
"child1"
"child2")))
(elm (hsx (div props
"child1"
"child2"))))
(ok (equal props (element-props elm)))
(ok (equal (list "child1" "child2") (element-children elm))))))