paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Change type of element-type, add deftag macro

Browse source
This commit is contained in:
paku 2024-05-28 19:31:50 +09:00
parent 634daeb8c1
commit 8455ed4553
5 changed files with 48 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/builtin.lisp
View file

@ -1,16 +1,14 @@
(uiop:define-package #:hsx/builtin (uiop:define-package #:hsx/builtin
(:use #:cl) (:use #:cl)
(:import-from #:alexandria
#:make-keyword)
(:import-from #:hsx/defhsx (:import-from #:hsx/defhsx
#:defhsx)) #:deftag))
(in-package #:hsx/builtin) (in-package #:hsx/builtin)
(defmacro define-and-export-builtin-elements (&rest names) (defmacro define-and-export-builtin-elements (&rest names)
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
,@(mapcan (lambda (name) ,@(mapcan (lambda (name)
(list `(defhsx ,name ,(string-downcase name)) (list `(deftag ,name)
`(export ',name))) `(export ',name)))
names))) names)))

7
src/defhsx.lisp
View file

@ -1,10 +1,11 @@
(uiop:define-package #:hsx/defhsx (uiop:define-package #:hsx/defhsx
(:use #:cl) (:use #:cl)
(:import-from #:alexandria (:import-from #:alexandria
#:make-keyword
#:symbolicate) #:symbolicate)
(:import-from #:hsx/element (:import-from #:hsx/element
#:create-element) #:create-element)
(:export #:defhsx (:export #:deftag
#:defcomp)) #:defcomp))
(in-package #:hsx/defhsx) (in-package #:hsx/defhsx)
@ -27,6 +28,10 @@
:finally (return (values props nil))) :finally (return (values props nil)))
(values nil body))) (values nil body)))
(defmacro deftag (name)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defhsx ,name ,(make-keyword name))))
(defmacro defcomp (name props &body body) (defmacro defcomp (name props &body body)
(let ((%name (symbolicate '% name))) (let ((%name (symbolicate '% name)))
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)

34
src/element.lisp
View file

@ -30,13 +30,14 @@
(defclass component-element (element) ()) (defclass component-element (element) ())
;;;; constructor ;;;; factory
(defun create-element (type props &rest children) (defun create-element (type props &rest children)
(let ((elm (make-instance (cond ((functionp type) 'component-element) (let ((elm (make-instance (cond ((functionp type) 'component-element)
((string= type "<>") 'fragment-element) ((eq type :<>) 'fragment-element)
((string= type "html") 'html-tag-element) ((eq type :html) 'html-tag-element)
(t 'tag-element)) ((keywordp type) 'tag-element)
(t (error "element-type must be either a keyword or a function.")))
:type type :type type
:props props :props props
:children (flatten children)))) :children (flatten children))))
@ -69,18 +70,19 @@
(with-accessors ((type element-type) (with-accessors ((type element-type)
(props element-props) (props element-props)
(children element-children)) elm (children element-children)) elm
(if children (let ((type-str (string-downcase type)))
(format stream (if (rest children) (if children
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>" (format stream (if (rest children)
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>") "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
type "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
(props->string props) type-str
children (props->string props)
type) children
(format stream "<~a~a></~a>" type-str)
type (format stream "<~a~a></~a>"
(props->string props) type-str
type)))) (props->string props)
type-str)))))
(defun props->string (props) (defun props->string (props)
(with-output-to-string (stream) (with-output-to-string (stream)

31
tests/defhsx.lisp
View file

@ -15,14 +15,14 @@
(is (equal (macroexpand-1 (is (equal (macroexpand-1
'(div)) '(div))
'(create-element '(create-element
"div" :div
(list))))) (list)))))
(test hsx-with-props (test hsx-with-props
(is (equal (macroexpand-1 (is (equal (macroexpand-1
'(div :prop1 "value1" :prop2 "value2")) '(div :prop1 "value1" :prop2 "value2"))
'(create-element '(create-element
"div" :div
(list :prop1 "value1" :prop2 "value2"))))) (list :prop1 "value1" :prop2 "value2")))))
(test hsx-with-children (test hsx-with-children
@ -31,7 +31,7 @@
"child1" "child1"
"child2")) "child2"))
'(create-element '(create-element
"div" :div
(list) (list)
"child1" "child1"
"child2")))) "child2"))))
@ -42,12 +42,12 @@
"child1" "child1"
"child2")) "child2"))
'(create-element '(create-element
"div" :div
(list :prop1 "value1" :prop2 "value2") (list :prop1 "value1" :prop2 "value2")
"child1" "child1"
"child2")))) "child2"))))
(defhsx custom "custom") (deftag custom)
(test hsx-for-custom-tag-element (test hsx-for-custom-tag-element
(is (equal (macroexpand-1 (is (equal (macroexpand-1
@ -55,34 +55,21 @@
"child1" "child1"
"child2")) "child2"))
'(create-element '(create-element
"custom" :custom
(list :prop1 "value1" :prop2 "value2") (list :prop1 "value1" :prop2 "value2")
"child1" "child1"
"child2")))) "child2"))))
(defhsx comp1 #'%comp1) (defcomp comp (&key prop1 prop2 children)
(defun %comp1 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(defcomp comp2 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children))) (declare (ignore prop1 prop2 children)))
(test hsx-for-component-element (test hsx-for-component-element
(is (equal (macroexpand-1 (is (equal (macroexpand-1
'(comp1 :prop1 "value1" :prop2 "value2" '(comp :prop1 "value1" :prop2 "value2"
"child1" "child1"
"child2")) "child2"))
'(create-element '(create-element
#'%comp1 (fdefinition '%comp)
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2")))
(is (equal (macroexpand-1
'(comp2 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
(fdefinition '%comp2)
(list :prop1 "value1" :prop2 "value2") (list :prop1 "value1" :prop2 "value2")
"child1" "child1"
"child2")))) "child2"))))

26
tests/element.lisp
View file

@ -9,16 +9,16 @@
(in-suite element-test) (in-suite element-test)
(test tag-element (test tag-element
(let ((elm (create-element "p" (let ((elm (create-element :p
'(:class "red") '(:class "red")
"Hello," "Hello,"
"World"))) "World")))
(is (string= (element-type elm) "p")) (is (eq (element-type elm) :p))
(is (equal (element-props elm) '(:class "red"))) (is (equal (element-props elm) '(:class "red")))
(is (equal (element-children elm) (list "Hello," "World"))))) (is (equal (element-children elm) (list "Hello," "World")))))
(test flatten-children (test flatten-children
(let* ((elm (create-element "p" (let* ((elm (create-element :p
nil nil
"a" "a"
nil nil
@ -27,7 +27,7 @@
(is (equal (element-children elm) (list "a" "b" "c" "d" "e"))))) (is (equal (element-children elm) (list "a" "b" "c" "d" "e")))))
(defun comp1 (&key title children) (defun comp1 (&key title children)
(create-element "div" (create-element :div
nil nil
title title
children)) children))
@ -37,10 +37,10 @@
'(:title "foo") '(:title "foo")
"bar")) "bar"))
(expanded (expand-component elm))) (expanded (expand-component elm)))
(is (eql (element-type elm) #'comp1)) (is (eq (element-type elm) #'comp1))
(is (equal (element-props elm) '(:title "foo"))) (is (equal (element-props elm) '(:title "foo")))
(is (equal (element-children elm) (list "bar"))) (is (equal (element-children elm) (list "bar")))
(is (string= (element-type expanded) "div")) (is (eq (element-type expanded) :div))
(is (equal (element-children expanded) (list "foo" "bar"))) (is (equal (element-children expanded) (list "foo" "bar")))
(signals error (signals error
(create-element #'comp1 (create-element #'comp1
@ -48,7 +48,7 @@
"bar")))) "bar"))))
(defun comp2 (&rest props) (defun comp2 (&rest props)
(create-element "div" (create-element :div
nil nil
(getf props :title) (getf props :title)
(getf props :children))) (getf props :children)))
@ -58,21 +58,21 @@
'(:title "foo") '(:title "foo")
"bar")) "bar"))
(expanded (expand-component elm))) (expanded (expand-component elm)))
(is (eql (element-type elm) #'comp2)) (is (eq (element-type elm) #'comp2))
(is (equal (element-props elm) '(:title "foo"))) (is (equal (element-props elm) '(:title "foo")))
(is (equal (element-children elm) (list "bar"))) (is (equal (element-children elm) (list "bar")))
(is (string= (element-type expanded) "div")) (is (eq (element-type expanded) :div))
(is (equal (element-children expanded) (list "foo" "bar"))))) (is (equal (element-children expanded) (list "foo" "bar")))))
(defun comp3 (&rest props &key title children &allow-other-keys) (defun comp3 (&rest props &key title children &allow-other-keys)
(create-element "div" (create-element :div
nil nil
title title
children children
(getf props :other-key))) (getf props :other-key)))
(defun comp4 (&rest props &key title children) (defun comp4 (&rest props &key title children)
(create-element "div" (create-element :div
nil nil
title title
children children
@ -83,10 +83,10 @@
'(:title "foo" :other-key "baz") '(:title "foo" :other-key "baz")
"bar")) "bar"))
(expanded (expand-component elm))) (expanded (expand-component elm)))
(is (eql (element-type elm) #'comp3)) (is (eq (element-type elm) #'comp3))
(is (equal (element-props elm) '(:title "foo" :other-key "baz"))) (is (equal (element-props elm) '(:title "foo" :other-key "baz")))
(is (equal (element-children elm) (list "bar"))) (is (equal (element-children elm) (list "bar")))
(is (string= (element-type expanded) "div")) (is (eq (element-type expanded) :div))
(is (equal (element-children expanded) (list "foo" "bar" "baz"))) (is (equal (element-children expanded) (list "foo" "bar" "baz")))
(signals error (signals error
(create-element #'comp4 (create-element #'comp4