From 693e6704f91eec9a41ab781b5f205dfcf1be5166 Mon Sep 17 00:00:00 2001 From: paku Date: Thu, 6 Jun 2024 14:59:46 +0900 Subject: [PATCH] Integrate defhsx package into hsx package --- hsx-test.asd | 2 -- src/builtin.lisp | 2 +- src/defhsx.lisp | 48 ------------------------------------------ src/hsx.lisp | 52 ++++++++++++++++++++++++++++++++++++++++++++-- src/main.lisp | 2 +- tests/defhsx.lisp | 52 ---------------------------------------------- tests/element.lisp | 2 +- tests/hsx.lisp | 46 +++++++++++++++++++++++++++++++++++++++- 8 files changed, 98 insertions(+), 108 deletions(-) delete mode 100644 src/defhsx.lisp delete mode 100644 tests/defhsx.lisp diff --git a/hsx-test.asd b/hsx-test.asd index e2f5324..c3ccb1f 100644 --- a/hsx-test.asd +++ b/hsx-test.asd @@ -4,12 +4,10 @@ :pathname "tests" :depends-on ("fiveam" "hsx-test/element" - "hsx-test/defhsx" "hsx-test/hsx" "hsx-test/escaper" "hsx-test/group") :test-names ((#:element-test . #:hsx-test/element) - (#:defhsx-test . #:hsx-test/defhsx) (#:hsx-test . #:hsx-test/hsx) (#:escaper-test . #:hsx-test/escaper) (#:group-test . #:hsx-test/group)) diff --git a/src/builtin.lisp b/src/builtin.lisp index 91d446b..66b1695 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -1,6 +1,6 @@ (uiop:define-package #:hsx/builtin (:use #:cl) - (:import-from #:hsx/defhsx + (:import-from #:hsx/hsx #:deftag)) (in-package #:hsx/builtin) diff --git a/src/defhsx.lisp b/src/defhsx.lisp deleted file mode 100644 index fe84d3a..0000000 --- a/src/defhsx.lisp +++ /dev/null @@ -1,48 +0,0 @@ -(defpackage #:hsx/defhsx - (:use #:cl) - (:import-from #:alexandria - #:make-keyword - #:symbolicate) - (:import-from #:hsx/element - #:create-element) - (:export #:deftag - #:defcomp)) -(in-package #:hsx/defhsx) - -(defmacro defhsx (name element-type) - `(defmacro ,name (&body body) - `(%create-element ,',element-type ,@body))) - -(defun %create-element (type &rest body) - (multiple-value-bind (props children) - (parse-body body) - (create-element type props children))) - -(defun parse-body (body) - (cond ((and (listp (first body)) - (keywordp (first (first body)))) - (values (first body) (rest body))) - ((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)))) - -(defmacro defcomp (name props &body body) - (unless (or (null props) - (member '&key props) - (member '&rest props)) - (error "Component properties must be declared with either &key, &rest, or both.")) - (let ((%name (symbolicate '% name))) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (defun ,%name ,props - ,@body) - (defhsx ,name (fdefinition ',%name))))) diff --git a/src/hsx.lisp b/src/hsx.lisp index dccac5e..a3e3d85 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -1,9 +1,17 @@ (defpackage #:hsx/hsx (:use #:cl) - (:import-from #:hsx/builtin) - (:export #:hsx)) + (:import-from #:alexandria + #:make-keyword + #:symbolicate) + (:import-from #:hsx/element + #:create-element) + (:export #:hsx + #:deftag + #:defcomp)) (in-package #:hsx/hsx) +;;;; hsx macro + (defmacro hsx (form) (find-builtin-symbols form)) @@ -19,3 +27,43 @@ (find-builtin-symbols n) n)) (cdr node))))) + +;;;; defhsx macro + +(defmacro defhsx (name element-type) + `(defmacro ,name (&body body) + `(%create-element ,',element-type ,@body))) + +(defun %create-element (type &rest body) + (multiple-value-bind (props children) + (parse-body body) + (create-element type props children))) + +(defun parse-body (body) + (cond ((and (listp (first body)) + (keywordp (first (first body)))) + (values (first body) (rest body))) + ((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)))) + +(defmacro defcomp (name props &body body) + (unless (or (null props) + (member '&key props) + (member '&rest props)) + (error "Component properties must be declared with either &key, &rest, or both.")) + (let ((%name (symbolicate '% name))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defun ,%name ,props + ,@body) + (defhsx ,name (fdefinition ',%name))))) diff --git a/src/main.lisp b/src/main.lisp index ce1f322..e187090 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -2,8 +2,8 @@ (:nicknames #:hsx/main) (:use #:cl #:hsx/element - #:hsx/defhsx #:hsx/hsx) + (:import-from #:hsx/builtin) (:export #:hsx #:defcomp #:render-to-string diff --git a/tests/defhsx.lisp b/tests/defhsx.lisp deleted file mode 100644 index 513354f..0000000 --- a/tests/defhsx.lisp +++ /dev/null @@ -1,52 +0,0 @@ -(defpackage #:hsx-test/defhsx - (:use #:cl - #:fiveam - #:hsx/defhsx - #:hsx/builtin) - (:import-from #:hsx/element - #:element-props - #:element-children)) -(in-package #:hsx-test/defhsx) - -(def-suite defhsx-test) -(in-suite defhsx-test) - -(test empty-hsx - (let ((elm (div))) - (is (null (element-props elm))) - (is (null (element-children elm))))) - -(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 - (let ((elm (div - "child1" - "child2"))) - (is (null (element-props elm))) - (is (equal (list "child1" "child2") (element-children elm))))) - -(test hsx-with-static-props-and-children - (let ((elm (div :prop1 "value1" :prop2 "value2" - "child1" - "child2"))) - (is (equal '(:prop1 "value1" :prop2 "value2") - (element-props elm))) - (is (equal (list "child1" "child2") (element-children elm))))) - -(test hsx-with-dynamic-props-and-children - (let* ((props '(:prop1 "value1" :prop2 "value2")) - (elm (div props - "child1" - "child2"))) - (is (equal props (element-props elm))) - (is (equal (list "child1" "child2") (element-children elm))))) diff --git a/tests/element.lisp b/tests/element.lisp index 1daf267..797879a 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -1,6 +1,6 @@ (defpackage #:hsx-test/element (:use #:cl - #:fiveam + #:fiveam #:hsx/element) (:import-from #:named-readtables #:in-readtable) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index 259c362..49b7427 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -1,7 +1,11 @@ (defpackage #:hsx-test/hsx (:use #:cl #:fiveam - #:hsx/hsx)) + #:hsx/hsx + #:hsx/builtin) + (:import-from #:hsx/element + #:element-props + #:element-children)) (in-package #:hsx-test/hsx) (def-suite hsx-test) @@ -23,3 +27,43 @@ (div) :div) "div")))))) + +(test empty-hsx + (let ((elm (div))) + (is (null (element-props elm))) + (is (null (element-children elm))))) + +(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 + (let ((elm (div + "child1" + "child2"))) + (is (null (element-props elm))) + (is (equal (list "child1" "child2") (element-children elm))))) + +(test hsx-with-static-props-and-children + (let ((elm (div :prop1 "value1" :prop2 "value2" + "child1" + "child2"))) + (is (equal '(:prop1 "value1" :prop2 "value2") + (element-props elm))) + (is (equal (list "child1" "child2") (element-children elm))))) + +(test hsx-with-dynamic-props-and-children + (let* ((props '(:prop1 "value1" :prop2 "value2")) + (elm (div props + "child1" + "child2"))) + (is (equal props (element-props elm))) + (is (equal (list "child1" "child2") (element-children elm)))))