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

define print-object method for element

Browse source
This commit is contained in:
paku 2024-05-26 23:29:30 +09:00
parent c24da9a7e9
commit 9d0a425b49
3 changed files with 119 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

95
src/element.lisp
View file

@ -7,6 +7,8 @@
#:expand))
(in-package #:hsx/element)
;;;; class definitions
(defclass element ()
((type
:reader element-type
@ -18,23 +20,29 @@
:reader element-children
:initarg :children)))
(defclass builtin-element (element) ())
(defclass tag-element (builtin-element) ())
(defclass html-tag-element (tag-element) ())
(defclass fragment-element (builtin-element) ())
(defclass component-element (element) ())
;;;; constructor
(defun create-element (type props &rest children)
(let ((elm (make-instance 'element
(let ((elm (make-instance (cond ((functionp type) 'component-element)
((string= type "<>") 'fragment-element)
((string= type "html") 'html-tag-element)
(t 'tag-element))
:type type
:props props
:children (flatten children))))
(prog1 elm
;dry-run to validate props
(expand elm))))
(defmethod expand ((elm element))
(with-accessors ((type element-type)
(props element-props)
(children element-children)) elm
(if (functionp type)
(apply type
(merge-children-into-props props children))
elm)))
(create-element-hook elm)
elm))
(defun flatten (x)
(labels ((rec (x acc)
@ -45,7 +53,68 @@
(rec (cdr x) acc))))))
(rec x nil)))
(defmethod create-element-hook ((elm element)))
(defmethod create-element-hook ((elm fragment-element))
(when (element-props elm)
(error "Cannot pass props to fragment.")))
(defmethod create-element-hook ((elm component-element))
;dry-run to validate props
(expand elm))
;;;; methods
(defmethod expand ((elm component-element))
(with-accessors ((type element-type)
(props element-props)
(children element-children)) elm
(apply type (merge-children-into-props props children))))
(defun merge-children-into-props (props children)
(append props
(and children
(list :children children))))
(defmethod print-object ((elm tag-element) stream)
(with-accessors ((type element-type)
(props element-props)
(children element-children)) elm
(if children
(format stream (if (rest children)
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
type
(props->string props)
children
type)
(format stream "<~a~a></~a>"
type
(props->string props)
type))))
(defun props->string (props)
(with-output-to-string (stream)
(loop
:for (key value) :on props :by #'cddr
:do (format stream (if (typep value 'boolean)
"~@[ ~a~]"
" ~a=~s")
(string-downcase key)
value))))
(defmethod print-object ((elm html-tag-element) stream)
(format stream "<!DOCTYPE html>~%")
(call-next-method))
(defmethod print-object ((elm fragment-element) stream)
(with-accessors ((children element-children)) elm
(if children
(format stream (if (rest children)
"~<~@{~a~^~:@_~}~:>"
"~<~a~:>")
children))))
(defmethod print-object ((elm component-element) stream)
(print-object (expand elm) stream))

61
src/hsx.lisp
View file

@ -9,16 +9,10 @@
#:hsx))
(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)))
;;;; hsx definitions
(defparameter *builtin-elements* (make-hash-table))
(defmacro define-builtin-element (name)
`(defmacro ,name (&body body)
@ -28,9 +22,7 @@
(list ,@props)
,@children))))
(defparameter *builtin-elements* (make-hash-table))
(defmacro define-and-export-builtin-elements (&rest names)
(defmacro define-and-export-builtin-elements (&body names)
`(progn
,@(mapcan (lambda (name)
(list `(define-builtin-element ,name)
@ -39,15 +31,20 @@
names)))
(define-and-export-builtin-elements
a abbr address area article aside audio b base bdi bdo blockquote
; tag-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
figure footer form h1 h2 h3 h4 h5 h6 head header 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)
thead |time| title tr track u ul var video wbr
; html-tag-element
html
; fragment-element
<>)
(defmacro defcomp (name props &body body)
(let ((%name (symbolicate '% name)))
@ -61,9 +58,26 @@
(list ,@props)
,@children))))))
(defun builtin-element-p (node)
(and (symbolp node)
(gethash (make-keyword node) *builtin-elements*)))
(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)))
;;;; hsx macro to find hsx symbols
(defmacro hsx (&body body)
`(progn
,@(modify-first-leaves body
#'builtin-element-p
(lambda (node)
(find-symbol (string node) :hsx/hsx)))))
(defun modify-first-leaves (tree test result)
(if tree
@ -80,9 +94,6 @@
node))
(rest tree)))))
(defmacro hsx (&body body)
`(progn
,@(modify-first-leaves body
#'builtin-element-p
(lambda (node)
(find-symbol (string node) :hsx/hsx)))))
(defun builtin-element-p (node)
(and (symbolp node)
(gethash (make-keyword node) *builtin-elements*)))

2
tests/element.lisp
View file

@ -7,7 +7,7 @@
(def-suite element-test)
(in-suite element-test)
(test builtin-element
(test tag-element
(let ((elm (create-element "p"
'(:class "red")
"Hello,"