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

34
src/defhsx.lisp
View file

@ -9,23 +9,31 @@
#:defcomp))
(in-package #:hsx/defhsx)
(defun %create-element (type &rest body)
(multiple-value-bind (props children)
(parse-body body)
(create-element type props children)))
(defmacro defhsx (name element-type)
`(defmacro ,name (&body body)
(multiple-value-bind (props children)
(parse-body body)
`(create-element ,',element-type (list ,@props) ,@children))))
`(%create-element ,',element-type ,@body)))
(defun parse-body (body)
(if (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)))
(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))))
(t (values nil body))))
(defmacro deftag (name)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defhsx ,name ,(make-keyword name))))

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)))))

82
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"
nil
(list "b" (list nil "c"))
(cons "d" "e"))))
(list "a"
nil
(list "b" (list nil "c"))
(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
children
(getf props :other-key)))
(list prop
children
(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>"