Add hsx macro

This commit is contained in:
paku 2024-05-26 19:48:09 +09:00
parent 422b111114
commit 6c6dce401e
5 changed files with 66 additions and 5 deletions

View file

@ -3,5 +3,6 @@
:pathname "tests"
:depends-on ("fiveam"
"hsx-test/element"
"hsx-test/hsx")
"hsx-test/hsx"
"hsx-test/hsx-macro")
:perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))

View file

@ -1,10 +1,12 @@
(uiop:define-package #:hsx/hsx
(:use #:cl)
(:import-from #:alexandria
#:symbolicate)
#:symbolicate
#:make-keyword)
(:import-from #:hsx/element
#:create-element)
(:export #:defcomp))
(:export #:defcomp
#:hsx))
(in-package #:hsx/hsx)
(defun parse-body (body)
@ -26,10 +28,13 @@
',props
,@children))))
(defparameter *builtin-elements* (make-hash-table))
(defmacro define-and-export-builtin-elements (&rest names)
`(progn
,@(mapcan (lambda (name)
(list `(define-builtin-element ,name)
`(setf (gethash (make-keyword ',name) *builtin-elements*) t)
`(export ',name)))
names)))
@ -55,3 +60,29 @@
`(create-element #',',%name
',props
,@children))))))
(defun builtin-element-p (node)
(and (symbolp node)
(gethash (make-keyword node) *builtin-elements*)))
(defun modify-first-leaves (tree test result)
(if tree
(cons (let ((first-node (first tree)))
(cond
((listp first-node)
(modify-first-leaves first-node test result))
((funcall test first-node)
(funcall result first-node))
(t first-node)))
(mapcar (lambda (node)
(if (listp node)
(modify-first-leaves node test result)
node))
(rest tree)))))
(defmacro hsx (&body body)
`(progn
,@(modify-first-leaves body
#'builtin-element-p
(lambda (node)
(find-symbol (string node) :hsx/hsx)))))

View file

@ -5,7 +5,6 @@
(in-package :hsx-test/element)
(def-suite element-test)
(in-suite element-test)
(test builtin-element

31
tests/hsx-macro.lisp Normal file
View file

@ -0,0 +1,31 @@
(defpackage #:hsx-test/hsx-macro
(:use #:cl
#:fiveam)
(:import-from #:hsx/element
#:element-type
#:element-props)
(:import-from #:hsx/hsx
#:hsx
#:defcomp))
(in-package #:hsx-test/hsx-macro)
(def-suite hsx-macro-test)
(in-suite hsx-macro-test)
(defcomp div (&rest props)
(declare (ignore props))
"This is fake!")
(defcomp p (&rest props)
(declare (ignore props))
"This is fake!")
(test find-symbols
(let ((fake-elm (div :prop "value"
(p "brah"))))
(is (eql (element-type fake-elm) #'%div)
(eql (element-type (first (element-children fake-elm))) #'%p)))
(let ((true-elm (hsx (div :prop "value"
(p "brah")))))
(is (equal (element-type true-elm) "div")
(equal (element-type (first (element-children true-elm))) "p"))))

View file

@ -8,7 +8,6 @@
(def-suite hsx-test)
(in-suite hsx-test)
(test empty-hsx
(is (equal (macroexpand-1
'(div))