Add hsx/hsx package

hsx-test.asd

@@ -2,5 +2,6 @@
   :class :package-inferred-system
   :pathname "tests"
   :depends-on ("fiveam"
-               "hsx-test/element")
+               "hsx-test/element"
+               "hsx-test/hsx")
   :perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))

qlfile

@@ -1 +1,2 @@
 ql fiveam
+ql alexandria

qlfile.lock

@@ -6,3 +6,7 @@
  (:class qlot/source/ql:source-ql
   :initargs (:%version :latest)
   :version "ql-2023-10-21"))
+("alexandria" .
+ (:class qlot/source/ql:source-ql
+  :initargs (:%version :latest)
+  :version "ql-2023-10-21"))

src/hsx.lisp

@@ -0,0 +1,57 @@
+(uiop:define-package #:hsx/hsx
+  (:use #:cl)
+  (:import-from #:alexandria
+                #:symbolicate)
+  (:import-from #:hsx/element
+                #:create-element)
+  (:export #:defcomp))
+(in-package #:hsx/hsx)
+
+(defun parse-body (body)
+  (if (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)))
+      (values nil body)))
+
+(defmacro define-builtin-element (name)
+  `(defmacro ,name (&body body)
+     (multiple-value-bind (props children)
+         (parse-body body)
+       `(create-element ,',(string-downcase name)
+                        ',props
+                        ,@children))))
+
+(defmacro define-and-export-builtin-elements (&body names)
+  `(progn
+     ,@(mapcan (lambda (name)
+                 (list `(define-builtin-element ,name)
+                       `(export ',name)))
+               names)))
+
+(define-and-export-builtin-elements
+  a abbr address area article aside audio b base bdi bdo blockquote
+  body br button canvas caption cite code col colgroup data datalist
+  dd del details dfn dialog div dl dt em embed fieldset figcaption
+  figure footer form h1 h2 h3 h4 h5 h6 head header html hr i iframe
+  img input ins kbd label legend li link main |map| mark meta meter nav
+  noscript object ol optgroup option output p param picture pre progress
+  q rp rt ruby s samp script section select small source span strong
+  style sub summary sup svg table tbody td template textarea tfoot th
+  thead |time| title tr track u ul var video wbr)
+
+(defmacro defcomp (name props &body body)
+  (let ((%name (symbolicate '% name)))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (defun ,%name ,props
+         ,@body)
+       (defmacro ,name (&body body)
+         (multiple-value-bind (props children)
+             (parse-body body)
+           `(create-element #',',%name
+                            ',props
+                            ,@children))))))

tests/hsx.lisp

@@ -0,0 +1,32 @@
+(defpackage #:hsx-test/hsx
+  (:use #:cl
+        #:fiveam
+        #:hsx/element
+        #:hsx/hsx))
+(in-package #:hsx-test/hsx)
+
+(def-suite builtin-element-hsx)
+(def-suite component-element-hsx)
+(in-suite builtin-element-hsx)
+
+(test empty-hsx
+  (let ((elm (div)))
+    (is (null (element-props elm)))
+    (is (null (element-children elm)))))
+
+(test hsx-with-props
+  (let ((elm (div :prop1 "value1" :prop2 "value2")))
+    (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2")))
+    (is (null (element-children elm)))))
+
+(test hsx-with-children
+  (let ((elm (div "child1" "child2")))
+    (is (null (element-props elm)))
+    (is (equal (element-children elm) (list "child1" "child2")))))
+
+(test hsx-with-props-and-children
+  (test hsx-with-props
+    (let ((elm (div :prop1 "value1" :prop2 "value2"
+                 "child1" "child2")))
+      (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2")))
+      (is (equal (element-children elm) (list "child1" "child2"))))))