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

Separate defhsx package from hsx package

Browse source
This commit is contained in:
paku 2024-05-28 12:33:01 +09:00
parent 8e5f597be6
commit ead5c408e3
10 changed files with 156 additions and 150 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
hsx-test.asd
View file

@ -3,6 +3,6 @@
:pathname "tests"
:depends-on ("fiveam"
"hsx-test/element"
"hsx-test/hsx"
"hsx-test/hsx-macro")
"hsx-test/defhsx"
"hsx-test/hsx")
:perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))

5
src/builtin.lisp
View file

@ -2,12 +2,13 @@
(:use #:cl)
(:import-from #:alexandria
#:make-keyword)
(:import-from #:hsx/hsx
(:import-from #:hsx/defhsx
#:defhsx))
(in-package #:hsx/builtin)
(defmacro define-and-export-builtin-elements (&rest names)
`(progn
`(eval-when (:compile-toplevel :load-toplevel :execute)
,@(mapcan (lambda (name)
(list `(defhsx ,name ,(string-downcase name))
`(export ',name)))

35
src/defhsx.lisp Normal file
View file

@ -0,0 +1,35 @@
(uiop:define-package #:hsx/defhsx
(:use #:cl)
(:import-from #:alexandria
#:symbolicate)
(:import-from #:hsx/element
#:create-element)
(:export #:defhsx
#:defcomp))
(in-package #:hsx/defhsx)
(defmacro defhsx (name element-type)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro ,name (&body body)
(multiple-value-bind (props children)
(parse-body body)
`(create-element ,',element-type (list ,@props) ,@children)))))
(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 defcomp (name props &body body)
(let ((%name (symbolicate '% name)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defun ,%name ,props
,@body)
(defhsx ,name (fdefinition ',%name)))))

1
src/element.lisp
View file

@ -7,6 +7,7 @@
#:expand-component))
(in-package #:hsx/element)
;;;; class definitions
(defclass element ()

38
src/hsx.lisp
View file

@ -1,45 +1,9 @@
(uiop:define-package #:hsx/hsx
(:use #:cl)
(:import-from #:alexandria
#:symbolicate)
(:import-from #:hsx/element
#:create-element)
(:export #:defhsx
#:defcomp
#:hsx))
(:export #:hsx))
(in-package #:hsx/hsx)
;;;; hsx definitions
(defmacro defhsx (name element-type)
(eval-when (:compile-toplevel :load-toplevel :execute)
`(defmacro ,name (&body body)
(multiple-value-bind (props children)
(parse-body body)
`(create-element ,',element-type (list ,@props) ,@children)))))
(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 defcomp (name props &body body)
(let ((%name (symbolicate '% name)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defun ,%name ,props
,@body)
(defhsx ,name (fdefinition ',%name)))))
;;;; hsx macro to find hsx symbols
(defmacro hsx (&body form)
(when (not (= (length form) 1))
(error "The body of the hsx macro must be a single form."))

5
src/main.lisp
View file

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

88
tests/defhsx.lisp Normal file
View file

@ -0,0 +1,88 @@
(defpackage #:hsx-test/defhsx
(:use #:cl
#:fiveam
#:hsx/defhsx
#:hsx/builtin)
(:import-from #:hsx/element
#:create-element))
(in-package #:hsx-test/defhsx)
(def-suite defhsx-test)
(in-suite defhsx-test)
(test empty-hsx
(is (equal (macroexpand-1
'(div))
'(create-element
"div"
(list)))))
(test hsx-with-props
(is (equal (macroexpand-1
'(div :prop1 "value1" :prop2 "value2"))
'(create-element
"div"
(list :prop1 "value1" :prop2 "value2")))))
(test hsx-with-children
(is (equal (macroexpand-1
'(div
"child1"
"child2"))
'(create-element
"div"
(list)
"child1"
"child2"))))
(test hsx-with-props-and-children
(is (equal (macroexpand-1
'(div :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
"div"
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(defhsx custom "custom")
(test hsx-for-custom-tag-element
(is (equal (macroexpand-1
'(custom :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
"custom"
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(defhsx comp1 #'%comp1)
(defun %comp1 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(defcomp comp2 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(test hsx-for-component-element
(is (equal (macroexpand-1
'(comp1 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
#'%comp1
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2")))
(is (equal (macroexpand-1
'(comp2 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
(fdefinition '%comp2)
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))

1
tests/element.lisp
View file

@ -4,6 +4,7 @@
#:hsx/element))
(in-package #:hsx-test/element)
(def-suite element-test)
(in-suite element-test)

31
tests/hsx-macro.lisp
View file

@ -1,31 +0,0 @@
(defpackage #:hsx-test/hsx-macro
(:use #:cl
#:fiveam)
(:import-from #:hsx/element
#:element-type
#:element-children)
(: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"))))

98
tests/hsx.lisp
View file

@ -1,87 +1,33 @@
(defpackage #:hsx-test/hsx
(:use #:cl
#:fiveam
#:hsx/hsx
#:hsx/builtin)
#:hsx/hsx)
(:import-from #:hsx/element
#:create-element))
#:element-type
#:element-children)
(:import-from #:hsx/defhsx
#:defcomp)
(:import-from #:hsx/builtin))
(in-package #:hsx-test/hsx)
(def-suite hsx-test)
(in-suite hsx-test)
(test empty-hsx
(is (equal (macroexpand-1
'(div))
'(create-element
"div"
(list)))))
(defcomp div (&rest props)
(declare (ignore props))
"This is fake!")
(test hsx-with-props
(is (equal (macroexpand-1
'(div :prop1 "value1" :prop2 "value2"))
'(create-element
"div"
(list :prop1 "value1" :prop2 "value2")))))
(defcomp p (&rest props)
(declare (ignore props))
"This is fake!")
(test hsx-with-children
(is (equal (macroexpand-1
'(div
"child1"
"child2"))
'(create-element
"div"
(list)
"child1"
"child2"))))
(test hsx-with-props-and-children
(is (equal (macroexpand-1
'(div :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
"div"
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(defhsx custom "custom")
(test hsx-for-custom-tag-element
(is (equal (macroexpand-1
'(custom :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
"custom"
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(defhsx comp1 #'%comp1)
(defun %comp1 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(defcomp comp2 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(test hsx-for-component-element
(is (equal (macroexpand-1
'(comp1 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
#'%comp1
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2")))
(is (equal (macroexpand-1
'(comp2 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
(fdefinition '%comp2)
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(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"))))