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

9
src/element.lisp
View file

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

4
src/hsx.lisp
View file

@ -10,7 +10,9 @@
(defun find-builtin-symbols (node) (defun find-builtin-symbols (node)
(if (atom 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) node)
(cons (find-builtin-symbols (car node)) (cons (find-builtin-symbols (car node))
(mapcar (lambda (n) (mapcar (lambda (n)

86
tests/defhsx.lisp
View file

@ -4,71 +4,49 @@
#:hsx/defhsx #:hsx/defhsx
#:hsx/builtin) #:hsx/builtin)
(:import-from #:hsx/element (:import-from #:hsx/element
#:create-element)) #:element-props
#:element-children))
(in-package #:hsx-test/defhsx) (in-package #:hsx-test/defhsx)
(def-suite defhsx-test) (def-suite defhsx-test)
(in-suite defhsx-test) (in-suite defhsx-test)
(test empty-hsx (test empty-hsx
(is (equal '(create-element (let ((elm (div)))
:div (is (null (element-props elm)))
(list)) (is (null (element-children elm)))))
(macroexpand-1
'(div)))))
(test hsx-with-props (test hsx-with-static-props
(is (equal '(create-element (let ((elm (div :prop1 "value1" :prop2 "value2")))
:div (is (equal '(:prop1 "value1" :prop2 "value2")
(list :prop1 "value1" :prop2 "value2")) (element-props elm)))
(macroexpand-1 (is (null (element-children elm)))))
'(div :prop1 "value1" :prop2 "value2")))))
(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 (test hsx-with-children
(is (equal '(create-element (let ((elm (div
:div
(list)
"child1" "child1"
"child2") "child2")))
(macroexpand-1 (is (null (element-props elm)))
'(div (is (equal (list "child1" "child2") (element-children elm)))))
"child1"
"child2")))))
(test hsx-with-props-and-children (test hsx-with-static-props-and-children
(is (equal '(create-element (let ((elm (div :prop1 "value1" :prop2 "value2"
:div
(list :prop1 "value1" :prop2 "value2")
"child1" "child1"
"child2") "child2")))
(macroexpand-1 (is (equal '(:prop1 "value1" :prop2 "value2")
'(div :prop1 "value1" :prop2 "value2" (element-props elm)))
"child1" (is (equal (list "child1" "child2") (element-children elm)))))
"child2")))))
(deftag custom) (test hsx-with-dynamic-props-and-children
(let* ((props '(:prop1 "value1" :prop2 "value2"))
(test hsx-for-custom-tag (elm (div props
(is (equal '(create-element
:custom
(list :prop1 "value1" :prop2 "value2")
"child1" "child1"
"child2") "child2")))
(macroexpand-1 (is (equal props (element-props elm)))
'(custom :prop1 "value1" :prop2 "value2" (is (equal (list "child1" "child2") (element-children elm)))))
"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")))))

82
tests/element.lisp
View file

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

18
tests/hsx.lisp
View file

@ -9,16 +9,18 @@
(in-suite hsx-test) (in-suite hsx-test)
(test find-symbols (test find-symbols
(is (equal '(hsx/builtin:div (is (equal '(hsx/builtin:div '(:div "div")
div div
(hsx/builtin:div (hsx/builtin:div
div 'div
(hsx/builtin:div)) (hsx/builtin:div)
div) :div)
"div")
(macroexpand-1 (macroexpand-1
'(hsx (div '(hsx (div '(:div "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-package :hsx-test/renderer)
(in-readtable mstrings:mstring-syntax) (in-readtable mstrings:mstring-syntax)
(def-suite renderer) (def-suite renderer-test)
(in-suite renderer) (in-suite renderer-test)
(test empty-tag (test empty-tag
(is (string= "<div></div>" (is (string= "<div></div>"