paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Integrate defhsx package into hsx package

Browse source
This commit is contained in:
paku 2024-06-06 14:59:46 +09:00
parent 97139dca49
commit 693e6704f9
8 changed files with 98 additions and 108 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
hsx-test.asd
View file

@ -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))

2
src/builtin.lisp
View file

@ -1,6 +1,6 @@
(uiop:define-package #:hsx/builtin
(:use #:cl)
(:import-from #:hsx/defhsx
(:import-from #:hsx/hsx
#:deftag))
(in-package #:hsx/builtin)

48
src/defhsx.lisp
View file

@ -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)))))

52
src/hsx.lisp
View file

@ -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)))))

2
src/main.lisp
View file

@ -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

52
tests/defhsx.lisp
View file

@ -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)))))

2
tests/element.lisp
View file

@ -1,6 +1,6 @@
(defpackage #:hsx-test/element
(:use #:cl
#:fiveam
#:fiveam
#:hsx/element)
(:import-from #:named-readtables
#:in-readtable)

46
tests/hsx.lisp
View file

@ -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)))))