paku/hsx
1
0
Fork 0
Code Issues2 Pull requests Projects Releases2 Packages Wiki Activity Actions

Change HSX parsing environment from compile-time to runtime

Browse source
This commit is contained in:
Akira Tempaku 2024-05-30 12:55:13 +09:00
parent 6471ee88d6
commit 8d3a2588d0
7 changed files with 109 additions and 128 deletions

20
src/defhsx.lisp
View file

@ -9,22 +9,30 @@
#:defcomp))
(in-package #:hsx/defhsx)
(defmacro defhsx (name element-type)
`(defmacro ,name (&body body)
(defun %create-element (type &rest body)
(multiple-value-bind (props children)
(parse-body body)
`(create-element ,',element-type (list ,@props) ,@children))))
(create-element type props children)))
(defmacro defhsx (name element-type)
`(defmacro ,name (&body body)
`(%create-element ,',element-type ,@body)))
(defun parse-body (body)
(if (keywordp (first body))
(cond (; plist
(and (listp (first body))
(keywordp (first (first body))))
(values (first body) (rest body)))
(; inline-plist
(keywordp (first body))
(loop :for thing :on body :by #'cddr
:for (k v) := thing
:when (and (keywordp k) v)
:append (list k v) :into props
:when (not (keywordp k))
:return (values props thing)
:finally (return (values props nil)))
(values nil body)))
:finally (return (values props nil))))
(t (values nil body))))
(defmacro deftag (name)
`(eval-when (:compile-toplevel :load-toplevel :execute)

9
src/element.lisp
View file

@ -1,6 +1,11 @@
(defpackage #:hsx/element
(:use #:cl)
(:export #:create-element
(:export #:element
#:tag
#:html-tag
#:fragment
#:component
#:create-element
#:element-type
#:element-props
#:element-children
@ -31,7 +36,7 @@
;;;; factory
(defun create-element (type props &rest children)
(defun create-element (type props children)
(make-instance (cond ((functionp type) 'component)
((eq type :<>) 'fragment)
((eq type :html) 'html-tag)

4
src/hsx.lisp
View file

@ -10,7 +10,9 @@
(defun find-builtin-symbols (node)
(if (atom node)
(or (find-symbol (string node) :hsx/builtin)
(or (and (symbolp node)
(not (keywordp node))
(find-symbol (string node) :hsx/builtin))
node)
(cons (find-builtin-symbols (car node))
(mapcar (lambda (n)

86
tests/defhsx.lisp
View file

@ -4,71 +4,49 @@
#:hsx/defhsx
#:hsx/builtin)
(:import-from #:hsx/element
#:create-element))
#:element-props
#:element-children))
(in-package #:hsx-test/defhsx)
(def-suite defhsx-test)
(in-suite defhsx-test)
(test empty-hsx
(is (equal '(create-element
:div
(list))
(macroexpand-1
'(div)))))
(let ((elm (div)))
(is (null (element-props elm)))
(is (null (element-children elm)))))
(test hsx-with-props
(is (equal '(create-element
:div
(list :prop1 "value1" :prop2 "value2"))
(macroexpand-1
'(div :prop1 "value1" :prop2 "value2")))))
(test hsx-with-static-props
(let ((elm (div :prop1 "value1" :prop2 "value2")))
(is (equal '(:prop1 "value1" :prop2 "value2")
(element-props elm)))
(is (null (element-children elm)))))
(test hsx-with-dynamic-props
(let* ((props '(:prop1 "value1" :prop2 "value2"))
(elm (div props)))
(is (equal props (element-props elm)))
(is (null (element-children elm)))))
(test hsx-with-children
(is (equal '(create-element
:div
(list)
(let ((elm (div
"child1"
"child2")
(macroexpand-1
'(div
"child1"
"child2")))))
"child2")))
(is (null (element-props elm)))
(is (equal (list "child1" "child2") (element-children elm)))))
(test hsx-with-props-and-children
(is (equal '(create-element
:div
(list :prop1 "value1" :prop2 "value2")
(test hsx-with-static-props-and-children
(let ((elm (div :prop1 "value1" :prop2 "value2"
"child1"
"child2")
(macroexpand-1
'(div :prop1 "value1" :prop2 "value2"
"child1"
"child2")))))
"child2")))
(is (equal '(:prop1 "value1" :prop2 "value2")
(element-props elm)))
(is (equal (list "child1" "child2") (element-children elm)))))
(deftag custom)
(test hsx-for-custom-tag
(is (equal '(create-element
:custom
(list :prop1 "value1" :prop2 "value2")
(test hsx-with-dynamic-props-and-children
(let* ((props '(:prop1 "value1" :prop2 "value2"))
(elm (div props
"child1"
"child2")
(macroexpand-1
'(custom :prop1 "value1" :prop2 "value2"
"child1"
"child2")))))
(defcomp comp (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(test hsx-for-component
(is (equal '(create-element
(fdefinition '%comp)
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2")
(macroexpand-1
'(comp :prop1 "value1" :prop2 "value2"
"child1"
"child2")))))
"child2")))
(is (equal props (element-props elm)))
(is (equal (list "child1" "child2") (element-children elm)))))

76
tests/element.lisp
View file

@ -7,72 +7,58 @@
(def-suite element-test)
(in-suite element-test)
(test tag
(let ((elm (create-element :p
'(:class "red")
"Hello,"
"World")))
(is (eq :p (element-type elm)))
(is (equal '(:class "red") (element-props elm)))
(is (equal (list "Hello," "World") (element-children elm)))))
(test element-class
(is (typep (create-element :div nil nil) 'tag))
(is (typep (create-element :html nil nil) 'html-tag))
(is (typep (create-element :<> nil nil) 'fragment))
(is (typep (create-element (lambda ()) nil nil) 'component))
(signals error (create-element "div" nil nil)))
(test flatten-children
(let* ((elm (create-element :p
nil
"a"
(list "a"
nil
(list "b" (list nil "c"))
(cons "d" "e"))))
(cons "d" "e")))))
(is (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
(defun comp1 (&key title children)
(defun comp1 (&key prop children)
(create-element :div
nil
title
children))
(list prop
children)))
(test component-accepting-keyword-args
(let* ((elm (create-element #'comp1
'(:title "foo")
"bar"))
(expanded (expand-component elm)))
(is (eq #'comp1 (element-type elm)))
(is (equal '(:title "foo") (element-props elm)))
(is (equal (list "bar") (element-children elm)))
(is (eq :div (element-type expanded)))
(is (equal (list "foo" "bar") (element-children expanded)))))
(let ((elm (expand-component (create-element #'comp1
'(:prop "value")
(list "child")))))
(is (eq :div (element-type elm)))
(is (equal (list "value" "child") (element-children elm)))))
(defun comp2 (&rest props)
(create-element :div
nil
(getf props :title)
(getf props :children)))
(list (getf props :prop)
(getf props :children))))
(test component-accepting-property-list
(let* ((elm (create-element #'comp2
'(:title "foo")
"bar"))
(expanded (expand-component elm)))
(is (eq #'comp2 (element-type elm)))
(is (equal '(:title "foo") (element-props elm)))
(is (equal (list "bar") (element-children elm)))
(is (eq :div (element-type expanded)))
(is (equal (list "foo" "bar") (element-children expanded)))))
(let ((elm (expand-component (create-element #'comp2
'(:prop "value")
(list "child")))))
(is (eq :div (element-type elm)))
(is (equal (list "value" "child") (element-children elm)))))
(defun comp3 (&rest props &key title children &allow-other-keys)
(defun comp3 (&rest props &key prop children &allow-other-keys)
(create-element :div
nil
title
(list prop
children
(getf props :other-key)))
(getf props :other-key))))
(test component-accepting-keyword-args-and-property-list
(let* ((elm (create-element #'comp3
'(:title "foo" :other-key "baz")
"bar"))
(expanded (expand-component elm)))
(is (eq #'comp3 (element-type elm)))
(is (equal '(:title "foo" :other-key "baz") (element-props elm)))
(is (equal (list "bar") (element-children elm)))
(is (eq :div (element-type expanded)))
(is (equal (list "foo" "bar" "baz") (element-children expanded)))))
(let ((elm (expand-component (create-element #'comp3
'(:prop "value" :other-key "other")
(list "child")))))
(is (eq :div (element-type elm)))
(is (equal (list "value" "child" "other") (element-children elm)))))

18
tests/hsx.lisp
View file

@ -9,16 +9,18 @@
(in-suite hsx-test)
(test find-symbols
(is (equal '(hsx/builtin:div
(is (equal '(hsx/builtin:div '(:div "div")
div
(hsx/builtin:div
div
(hsx/builtin:div))
div)
'div
(hsx/builtin:div)
:div)
"div")
(macroexpand-1
'(hsx (div
'(hsx (div '(:div "div")
div
(div
div
(div))
div))))))
'div
(div)
:div)
"div"))))))

4
tests/renderer.lisp
View file

@ -7,8 +7,8 @@
(in-package :hsx-test/renderer)
(in-readtable mstrings:mstring-syntax)
(def-suite renderer)
(in-suite renderer)
(def-suite renderer-test)
(in-suite renderer-test)
(test empty-tag
(is (string= "<div></div>"