Add hsx macro
This commit is contained in:
parent
422b111114
commit
6c6dce401e
5 changed files with 66 additions and 5 deletions
|
@ -3,5 +3,6 @@
|
||||||
:pathname "tests"
|
:pathname "tests"
|
||||||
:depends-on ("fiveam"
|
:depends-on ("fiveam"
|
||||||
"hsx-test/element"
|
"hsx-test/element"
|
||||||
"hsx-test/hsx")
|
"hsx-test/hsx"
|
||||||
|
"hsx-test/hsx-macro")
|
||||||
:perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))
|
:perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))
|
||||||
|
|
35
src/hsx.lisp
35
src/hsx.lisp
|
@ -1,10 +1,12 @@
|
||||||
(uiop:define-package #:hsx/hsx
|
(uiop:define-package #:hsx/hsx
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:import-from #:alexandria
|
(:import-from #:alexandria
|
||||||
#:symbolicate)
|
#:symbolicate
|
||||||
|
#:make-keyword)
|
||||||
(:import-from #:hsx/element
|
(:import-from #:hsx/element
|
||||||
#:create-element)
|
#:create-element)
|
||||||
(:export #:defcomp))
|
(:export #:defcomp
|
||||||
|
#:hsx))
|
||||||
(in-package #:hsx/hsx)
|
(in-package #:hsx/hsx)
|
||||||
|
|
||||||
(defun parse-body (body)
|
(defun parse-body (body)
|
||||||
|
@ -26,10 +28,13 @@
|
||||||
',props
|
',props
|
||||||
,@children))))
|
,@children))))
|
||||||
|
|
||||||
|
(defparameter *builtin-elements* (make-hash-table))
|
||||||
|
|
||||||
(defmacro define-and-export-builtin-elements (&rest names)
|
(defmacro define-and-export-builtin-elements (&rest names)
|
||||||
`(progn
|
`(progn
|
||||||
,@(mapcan (lambda (name)
|
,@(mapcan (lambda (name)
|
||||||
(list `(define-builtin-element ,name)
|
(list `(define-builtin-element ,name)
|
||||||
|
`(setf (gethash (make-keyword ',name) *builtin-elements*) t)
|
||||||
`(export ',name)))
|
`(export ',name)))
|
||||||
names)))
|
names)))
|
||||||
|
|
||||||
|
@ -55,3 +60,29 @@
|
||||||
`(create-element #',',%name
|
`(create-element #',',%name
|
||||||
',props
|
',props
|
||||||
,@children))))))
|
,@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)))))
|
||||||
|
|
|
@ -5,7 +5,6 @@
|
||||||
(in-package :hsx-test/element)
|
(in-package :hsx-test/element)
|
||||||
|
|
||||||
(def-suite element-test)
|
(def-suite element-test)
|
||||||
|
|
||||||
(in-suite element-test)
|
(in-suite element-test)
|
||||||
|
|
||||||
(test builtin-element
|
(test builtin-element
|
||||||
|
|
31
tests/hsx-macro.lisp
Normal file
31
tests/hsx-macro.lisp
Normal 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"))))
|
|
@ -8,7 +8,6 @@
|
||||||
|
|
||||||
(def-suite hsx-test)
|
(def-suite hsx-test)
|
||||||
(in-suite hsx-test)
|
(in-suite hsx-test)
|
||||||
|
|
||||||
(test empty-hsx
|
(test empty-hsx
|
||||||
(is (equal (macroexpand-1
|
(is (equal (macroexpand-1
|
||||||
'(div))
|
'(div))
|
||||||
|
|
Loading…
Reference in a new issue