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

73
tests/dsl.lisp
View file

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