From 9d0a425b49e607116a9e548855639f3b171b515a Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 23:29:30 +0900 Subject: [PATCH] define print-object method for element --- src/element.lisp | 95 +++++++++++++++++++++++++++++++++++++++------- src/hsx.lisp | 61 +++++++++++++++++------------ tests/element.lisp | 2 +- 3 files changed, 119 insertions(+), 39 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 1110b56..bd9b120 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -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>~2I~:_~<~a~^~:@_~:>~0I~_~:>") + type + (props->string props) + children + type) + (format stream "<~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 "~%") + (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)) diff --git a/src/hsx.lisp b/src/hsx.lisp index db0ac09..3b3bf08 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -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*))) diff --git a/tests/element.lisp b/tests/element.lisp index 027574e..5c7f0c8 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -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,"