From 8455ed45530a034be9a7c93006094a95e78970e0 Mon Sep 17 00:00:00 2001 From: paku Date: Tue, 28 May 2024 19:31:50 +0900 Subject: [PATCH] Change type of element-type, add deftag macro --- src/builtin.lisp | 6 ++---- src/defhsx.lisp | 7 ++++++- src/element.lisp | 34 ++++++++++++++++++---------------- tests/defhsx.lisp | 31 +++++++++---------------------- tests/element.lisp | 26 +++++++++++++------------- 5 files changed, 48 insertions(+), 56 deletions(-) diff --git a/src/builtin.lisp b/src/builtin.lisp index ee3acdb..2afed93 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -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))) diff --git a/src/defhsx.lisp b/src/defhsx.lisp index 60eb1a7..9072348 100644 --- a/src/defhsx.lisp +++ b/src/defhsx.lisp @@ -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) @@ -26,6 +27,10 @@ :return (values props thing) :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))) diff --git a/src/element.lisp b/src/element.lisp index 46ab4fa..5a31635 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -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 - (if children - (format stream (if (rest children) - "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_~:>" - "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_~:>") - type - (props->string props) - children - type) - (format stream "<~a~a>" - type - (props->string props) - type)))) + (let ((type-str (string-downcase type))) + (if children + (format stream (if (rest children) + "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_~:>" + "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_~:>") + type-str + (props->string props) + children + type-str) + (format stream "<~a~a>" + type-str + (props->string props) + type-str))))) (defun props->string (props) (with-output-to-string (stream) diff --git a/tests/defhsx.lisp b/tests/defhsx.lisp index 2d5d46f..38edc98 100644 --- a/tests/defhsx.lisp +++ b/tests/defhsx.lisp @@ -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")))) diff --git a/tests/element.lisp b/tests/element.lisp index 00309d4..51ab77c 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -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