From 6c6dce401ec8922d52e4f4039912cacadab5a0ee Mon Sep 17 00:00:00 2001
From: paku <paku@skyizwhite.dev>
Date: Sun, 26 May 2024 19:48:09 +0900
Subject: [PATCH] Add hsx macro

---
 hsx-test.asd         |  3 ++-
 src/hsx.lisp         | 35 +++++++++++++++++++++++++++++++++--
 tests/element.lisp   |  1 -
 tests/hsx-macro.lisp | 31 +++++++++++++++++++++++++++++++
 tests/hsx.lisp       |  1 -
 5 files changed, 66 insertions(+), 5 deletions(-)
 create mode 100644 tests/hsx-macro.lisp

diff --git a/hsx-test.asd b/hsx-test.asd
index cb03e2f..b118701 100644
--- a/hsx-test.asd
+++ b/hsx-test.asd
@@ -3,5 +3,6 @@
   :pathname "tests"
   :depends-on ("fiveam"
                "hsx-test/element"
-               "hsx-test/hsx")
+               "hsx-test/hsx"
+               "hsx-test/hsx-macro")
   :perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))
diff --git a/src/hsx.lisp b/src/hsx.lisp
index 6aa8c3f..ac49790 100644
--- a/src/hsx.lisp
+++ b/src/hsx.lisp
@@ -1,10 +1,12 @@
 (uiop:define-package #:hsx/hsx
   (:use #:cl)
   (:import-from #:alexandria
-                #:symbolicate)
+                #:symbolicate
+                #:make-keyword)
   (:import-from #:hsx/element
                 #:create-element)
-  (:export #:defcomp))
+  (:export #:defcomp
+           #:hsx))
 (in-package #:hsx/hsx)
 
 (defun parse-body (body)
@@ -26,10 +28,13 @@
                         ',props
                         ,@children))))
 
+(defparameter *builtin-elements* (make-hash-table))
+
 (defmacro define-and-export-builtin-elements (&rest names)
   `(progn
      ,@(mapcan (lambda (name)
                  (list `(define-builtin-element ,name)
+                       `(setf (gethash (make-keyword ',name) *builtin-elements*) t)
                        `(export ',name)))
                names)))
 
@@ -55,3 +60,29 @@
            `(create-element #',',%name
                             ',props
                             ,@children))))))
+
+(defun builtin-element-p (node)
+  (and (symbolp node)
+       (gethash (make-keyword node) *builtin-elements*)))
+
+(defun modify-first-leaves (tree test result)
+  (if tree
+      (cons (let ((first-node (first tree)))
+              (cond
+                ((listp first-node)
+                 (modify-first-leaves first-node test result))
+                ((funcall test first-node)
+                 (funcall result first-node))
+                (t first-node)))
+            (mapcar (lambda (node)
+                      (if (listp node)
+                          (modify-first-leaves node test result)
+                          node))
+                    (rest tree)))))
+
+(defmacro hsx (&body body)
+  `(progn
+     ,@(modify-first-leaves body
+                            #'builtin-element-p
+                            (lambda (node)
+                              (find-symbol (string node) :hsx/hsx)))))
diff --git a/tests/element.lisp b/tests/element.lisp
index 43575b7..027574e 100644
--- a/tests/element.lisp
+++ b/tests/element.lisp
@@ -5,7 +5,6 @@
 (in-package :hsx-test/element)
 
 (def-suite element-test)
-
 (in-suite element-test)
 
 (test builtin-element
diff --git a/tests/hsx-macro.lisp b/tests/hsx-macro.lisp
new file mode 100644
index 0000000..6829c27
--- /dev/null
+++ b/tests/hsx-macro.lisp
@@ -0,0 +1,31 @@
+(defpackage #:hsx-test/hsx-macro
+  (:use #:cl
+        #:fiveam)
+  (:import-from #:hsx/element
+                #:element-type
+                #:element-props)
+  (:import-from #:hsx/hsx
+                #:hsx
+                #:defcomp))
+(in-package #:hsx-test/hsx-macro)
+
+(def-suite hsx-macro-test)
+(in-suite hsx-macro-test)
+
+(defcomp div (&rest props)
+  (declare (ignore props))
+  "This is fake!")
+
+(defcomp p (&rest props)
+  (declare (ignore props))
+  "This is fake!")
+
+(test find-symbols
+  (let ((fake-elm (div :prop "value"
+                    (p "brah"))))
+    (is (eql (element-type fake-elm) #'%div)
+        (eql (element-type (first (element-children fake-elm))) #'%p)))
+  (let ((true-elm (hsx (div :prop "value"
+                         (p "brah")))))
+    (is (equal (element-type true-elm) "div")
+        (equal (element-type (first (element-children true-elm))) "p"))))
diff --git a/tests/hsx.lisp b/tests/hsx.lisp
index e511f85..81783ef 100644
--- a/tests/hsx.lisp
+++ b/tests/hsx.lisp
@@ -8,7 +8,6 @@
 
 (def-suite hsx-test)
 (in-suite hsx-test)
-
 (test empty-hsx
   (is (equal (macroexpand-1
               '(div))