diff --git a/hsx-test.asd b/hsx-test.asd index 1936af1..cb03e2f 100644 --- a/hsx-test.asd +++ b/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))) diff --git a/qlfile b/qlfile index 856c2fc..bf1c3a3 100644 --- a/qlfile +++ b/qlfile @@ -1 +1,2 @@ ql fiveam +ql alexandria diff --git a/qlfile.lock b/qlfile.lock index 0e284d6..22f6050 100644 --- a/qlfile.lock +++ b/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")) diff --git a/src/hsx.lisp b/src/hsx.lisp new file mode 100644 index 0000000..0eef85a --- /dev/null +++ b/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)))))) diff --git a/tests/hsx.lisp b/tests/hsx.lisp new file mode 100644 index 0000000..1f123cc --- /dev/null +++ b/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"))))))