2024-05-25 12:48:35 +00:00
|
|
|
(defpackage #:hsx/element
|
2024-05-25 03:00:39 +00:00
|
|
|
(:use #:cl)
|
2024-05-28 11:15:29 +00:00
|
|
|
(:export #:create-element
|
|
|
|
|
#:element-type
|
2024-05-25 03:00:39 +00:00
|
|
|
#:element-props
|
2024-05-25 15:57:06 +00:00
|
|
|
#:element-children
|
2024-05-27 07:03:23 +00:00
|
|
|
#:expand-component))
|
2024-05-25 12:48:35 +00:00
|
|
|
(in-package #:hsx/element)
|
2024-05-25 03:00:39 +00:00
|
|
|
|
2024-05-28 03:33:01 +00:00
|
|
|
|
2024-05-26 14:29:30 +00:00
|
|
|
;;;; class definitions
|
|
|
|
|
|
2024-05-25 03:00:39 +00:00
|
|
|
(defclass element ()
|
2024-05-25 16:29:58 +00:00
|
|
|
((type
|
|
|
|
|
:reader element-type
|
|
|
|
|
:initarg :type)
|
2024-05-25 03:00:39 +00:00
|
|
|
(props
|
|
|
|
|
:reader element-props
|
2024-05-25 15:57:06 +00:00
|
|
|
:initarg :props)
|
|
|
|
|
(children
|
|
|
|
|
:reader element-children
|
|
|
|
|
:initarg :children)))
|
2024-05-25 03:00:39 +00:00
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defclass tag (element) ())
|
2024-05-26 14:29:30 +00:00
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defclass html-tag (tag) ())
|
2024-05-26 14:29:30 +00:00
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defclass fragment (element) ())
|
2024-05-26 14:29:30 +00:00
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defclass component (element) ())
|
2024-05-26 14:29:30 +00:00
|
|
|
|
|
|
|
|
|
2024-05-28 10:31:50 +00:00
|
|
|
;;;; factory
|
2024-05-26 14:29:30 +00:00
|
|
|
|
2024-05-25 16:29:58 +00:00
|
|
|
(defun create-element (type props &rest children)
|
2024-05-28 11:48:39 +00:00
|
|
|
(let ((elm (make-instance (cond ((functionp type) 'component)
|
|
|
|
|
((eq type :<>) 'fragment)
|
|
|
|
|
((eq type :html) 'html-tag)
|
|
|
|
|
((keywordp type) 'tag)
|
2024-05-28 10:31:50 +00:00
|
|
|
(t (error "element-type must be either a keyword or a function.")))
|
2024-05-26 03:26:09 +00:00
|
|
|
:type type
|
|
|
|
|
:props props
|
|
|
|
|
:children (flatten children))))
|
2024-05-26 14:29:30 +00:00
|
|
|
(create-element-hook elm)
|
|
|
|
|
elm))
|
2024-05-25 11:09:09 +00:00
|
|
|
|
2024-05-25 03:00:39 +00:00
|
|
|
(defun flatten (x)
|
|
|
|
|
(labels ((rec (x acc)
|
|
|
|
|
(cond ((null x) acc)
|
|
|
|
|
((atom x) (cons x acc))
|
|
|
|
|
(t (rec
|
|
|
|
|
(car x)
|
|
|
|
|
(rec (cdr x) acc))))))
|
|
|
|
|
(rec x nil)))
|
2024-05-26 04:57:51 +00:00
|
|
|
|
2024-05-26 14:29:30 +00:00
|
|
|
(defmethod create-element-hook ((elm element)))
|
|
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod create-element-hook ((elm fragment))
|
2024-05-26 14:29:30 +00:00
|
|
|
(when (element-props elm)
|
|
|
|
|
(error "Cannot pass props to fragment.")))
|
|
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod create-element-hook ((elm component))
|
2024-05-26 14:29:30 +00:00
|
|
|
;dry-run to validate props
|
2024-05-27 07:03:23 +00:00
|
|
|
(expand-component elm))
|
2024-05-26 14:29:30 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;; methods
|
|
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod print-object ((elm tag) stream)
|
2024-05-26 14:29:30 +00:00
|
|
|
(with-accessors ((type element-type)
|
|
|
|
|
(props element-props)
|
|
|
|
|
(children element-children)) elm
|
2024-05-28 10:31:50 +00:00
|
|
|
(let ((type-str (string-downcase type)))
|
|
|
|
|
(if children
|
2024-05-28 12:42:28 +00:00
|
|
|
(format stream
|
|
|
|
|
(if (rest children)
|
|
|
|
|
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
|
|
|
|
|
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
|
2024-05-28 10:31:50 +00:00
|
|
|
type-str
|
|
|
|
|
(props->string props)
|
|
|
|
|
children
|
|
|
|
|
type-str)
|
2024-05-28 12:42:28 +00:00
|
|
|
(format stream
|
|
|
|
|
"<~a~a></~a>"
|
2024-05-28 10:31:50 +00:00
|
|
|
type-str
|
|
|
|
|
(props->string props)
|
|
|
|
|
type-str)))))
|
2024-05-26 14:29:30 +00:00
|
|
|
|
|
|
|
|
(defun props->string (props)
|
|
|
|
|
(with-output-to-string (stream)
|
|
|
|
|
(loop
|
|
|
|
|
:for (key value) :on props :by #'cddr
|
2024-05-28 12:42:28 +00:00
|
|
|
:do (let ((key-str (string-downcase key)))
|
|
|
|
|
(if (typep value 'boolean)
|
|
|
|
|
(format stream
|
|
|
|
|
"~@[ ~a~]"
|
|
|
|
|
(and value key-str))
|
|
|
|
|
(format stream
|
|
|
|
|
" ~a=\"~a\""
|
|
|
|
|
key-str
|
|
|
|
|
value))))))
|
2024-05-26 14:29:30 +00:00
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod print-object ((elm html-tag) stream)
|
2024-05-26 14:29:30 +00:00
|
|
|
(format stream "<!DOCTYPE html>~%")
|
|
|
|
|
(call-next-method))
|
|
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod print-object ((elm fragment) stream)
|
2024-05-26 14:29:30 +00:00
|
|
|
(with-accessors ((children element-children)) elm
|
|
|
|
|
(if children
|
2024-05-28 12:42:28 +00:00
|
|
|
(format stream
|
|
|
|
|
(if (rest children)
|
|
|
|
|
"~<~@{~a~^~:@_~}~:>"
|
|
|
|
|
"~<~a~:>")
|
2024-05-26 14:29:30 +00:00
|
|
|
children))))
|
|
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod print-object ((elm component) stream)
|
2024-05-27 07:03:23 +00:00
|
|
|
(print-object (expand-component elm) stream))
|
|
|
|
|
|
2024-05-28 11:48:39 +00:00
|
|
|
(defmethod expand-component ((elm component))
|
2024-05-27 07:03:23 +00:00
|
|
|
(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))))
|
