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
(:use #:cl)
(:import-from #:alexandria
#:make-keyword)
(:import-from #:hsx/defhsx
#:defhsx))
#:deftag))
(in-package #:hsx/builtin)
(defmacro define-and-export-builtin-elements (&rest names)
`(eval-when (:compile-toplevel :load-toplevel :execute)
,@(mapcan (lambda (name)
(list `(defhsx ,name ,(string-downcase name))
(list `(deftag ,name)
`(export ',name)))
names)))

7
src/defhsx.lisp
View file

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

18
src/element.lisp
View file

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

31
tests/defhsx.lisp
View file

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

26
tests/element.lisp
View file

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