hsx/src/element.lisp

(defpackage #:hsx/element
  (:use #:cl)
  (:import-from #:hsx/escaper
                #:escape-html-attribute
                #:escape-html-text-content)
  (:import-from #:hsx/group
                #:self-closing-tag-p
                #:non-escaping-tag-p)
  (:export #:element
           #:tag
           #:html-tag
           #:self-closing-tag
           #:non-escaping-tag
           #:fragment
           #:component
           #:create-element
           #:element-type
           #:element-props
           #:element-children
           #:expand-component
           #:render-to-string))
(in-package #:hsx/element)

;;;; class definitions

(defclass element ()
  ((type
    :reader element-type
    :initarg :type)
   (props
    :reader element-props
    :initarg :props)
   (children
    :reader element-children
    :initarg :children)))

(defclass tag (element) ())

(defclass html-tag (tag) ())

(defclass self-closing-tag (tag) ())

(defclass non-escaping-tag (tag) ())

(defclass fragment (tag) ())

(defclass component (element) ())

;;;; factory

(defun create-element (type props children)
  (make-instance 
   (cond ((functionp type) 'component)
         ((eq type :<>) 'fragment)
         ((eq type :html) 'html-tag)
         ((self-closing-tag-p type) 'self-closing-tag)
         ((non-escaping-tag-p type) 'non-escaping-tag)
         ((keywordp type) 'tag)
         (t (error "element-type must be a keyword or a function.")))
   :type type
   :props props
   :children (flatten children)))

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

;;;; methods

(defmethod render-to-string ((element element) &key pretty)
  (with-output-to-string (stream)
    (write element :stream stream :pretty pretty)))

(defmethod print-object ((element tag) stream)
  (with-slots (type props children) element
    (let ((type-str (string-downcase type))
          (props-str (render-props props)))
      (if children
          (format stream
                  (if (or (rest children)
                          (typep (first children) 'element))
                      "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
                      "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
                  type-str
                  props-str
                  (render-children element)
                  type-str)
          (format stream "<~a~a></~a>" type-str props-str type-str)))))

(defmethod print-object ((element self-closing-tag) stream)
  (with-slots (type props) element
    (format stream "<~a~a>" (string-downcase type) (render-props props))))

(defun render-props (props)
  (with-output-to-string (stream)
    (loop
      :for (key value) :on props :by #'cddr
      :do (let ((key-str (string-downcase key)))
            (if (typep value 'boolean)
                (format stream
                        "~@[ ~a~]"
                        (and value key-str))
                (format stream
                        " ~a=\"~a\""
                        key-str
                        (escape-html-attribute value)))))))

(defmethod render-children ((element tag))
  (mapcar (lambda (child)
            (if (stringp child)
                (escape-html-text-content child)
                child))
          (element-children element)))

(defmethod render-children ((element non-escaping-tag))
  (element-children element))

(defmethod print-object ((element html-tag) stream)
  (format stream "<!DOCTYPE html>~%")
  (call-next-method))

(defmethod print-object ((element fragment) stream)
  (with-slots (children) element
    (if children
        (format stream
                (if (rest children)
                    "~<~@{~a~^~:@_~}~:>"
                    "~<~a~:>")
                children))))

(defmethod print-object ((element component) stream)
  (print-object (expand-component element) stream))

(defmethod expand-component ((element component))
  (with-slots (type props children) element
    (apply type (merge-children-into-props props children))))

(defun merge-children-into-props (props children)
  (append props
          (and children
               (list :children children))))
Rename piccolo to hsx 2024-05-25 12:48:35 +00:00			`(defpackage #:hsx/element`
Add create-element 2024-05-25 03:00:39 +00:00			`(:use #:cl)`
Add escaper package 2024-05-31 09:39:25 +00:00			`(:import-from #:hsx/escaper`
			`#:escape-html-attribute`
			`#:escape-html-text-content)`
Add group package 2024-06-01 11:14:17 +00:00			`(:import-from #:hsx/group`
Add non-escaping-tag group 2024-06-01 12:40:45 +00:00			`#:self-closing-tag-p`
			`#:non-escaping-tag-p)`
Change HSX parsing environment from compile-time to runtime 2024-05-30 03:55:13 +00:00			`(:export #:element`
			`#:tag`
			`#:html-tag`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`#:self-closing-tag`
			`#:non-escaping-tag`
Change HSX parsing environment from compile-time to runtime 2024-05-30 03:55:13 +00:00			`#:fragment`
			`#:component`
			`#:create-element`
Improve 2024-05-28 11:15:29 +00:00			`#:element-type`
Add create-element 2024-05-25 03:00:39 +00:00			`#:element-props`
Add children slot to element 2024-05-25 15:57:06 +00:00			`#:element-children`
Rename elm to element, add render method 2024-05-29 01:30:06 +00:00			`#:expand-component`
Rename render to render-to-string 2024-06-01 13:49:15 +00:00			`#:render-to-string))`
Rename piccolo to hsx 2024-05-25 12:48:35 +00:00			`(in-package #:hsx/element)`
Add create-element 2024-05-25 03:00:39 +00:00
define print-object method for element 2024-05-26 14:29:30 +00:00			`;;;; class definitions`

Add create-element 2024-05-25 03:00:39 +00:00			`(defclass element ()`
Rename kind to type 2024-05-25 16:29:58 +00:00			`((type`
			`:reader element-type`
			`:initarg :type)`
Add create-element 2024-05-25 03:00:39 +00:00			`(props`
			`:reader element-props`
Add children slot to element 2024-05-25 15:57:06 +00:00			`:initarg :props)`
			`(children`
			`:reader element-children`
			`:initarg :children)))`
Add create-element 2024-05-25 03:00:39 +00:00
Rename class names 2024-05-28 11:48:39 +00:00			`(defclass tag (element) ())`
define print-object method for element 2024-05-26 14:29:30 +00:00
Rename class names 2024-05-28 11:48:39 +00:00			`(defclass html-tag (tag) ())`
define print-object method for element 2024-05-26 14:29:30 +00:00
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(defclass self-closing-tag (tag) ())`

			`(defclass non-escaping-tag (tag) ())`

Add renderer test 2024-05-29 03:46:57 +00:00			`(defclass fragment (tag) ())`
define print-object method for element 2024-05-26 14:29:30 +00:00
Rename class names 2024-05-28 11:48:39 +00:00			`(defclass component (element) ())`
define print-object method for element 2024-05-26 14:29:30 +00:00
Change type of element-type, add deftag macro 2024-05-28 10:31:50 +00:00			`;;;; factory`
define print-object method for element 2024-05-26 14:29:30 +00:00
Change HSX parsing environment from compile-time to runtime 2024-05-30 03:55:13 +00:00			`(defun create-element (type props children)`
format 2024-06-04 23:22:14 +00:00			`(make-instance`
			`(cond ((functionp type) 'component)`
			`((eq type :<>) 'fragment)`
			`((eq type :html) 'html-tag)`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`((self-closing-tag-p type) 'self-closing-tag)`
			`((non-escaping-tag-p type) 'non-escaping-tag)`
format 2024-06-04 23:22:14 +00:00			`((keywordp type) 'tag)`
			`(t (error "element-type must be a keyword or a function.")))`
			`:type type`
			`:props props`
			`:children (flatten children)))`
Amend 2024-06-08 05:29:00 +00:00
Add create-element 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)))`
Add merge-children-into-props function 2024-05-26 04:57:51 +00:00
define print-object method for element 2024-05-26 14:29:30 +00:00			`;;;; methods`

Rename render to render-to-string 2024-06-01 13:49:15 +00:00			`(defmethod render-to-string ((element element) &key pretty)`
Format 2024-05-29 03:57:51 +00:00			`(with-output-to-string (stream)`
Rename render to render-to-string 2024-06-01 13:49:15 +00:00			`(write element :stream stream :pretty pretty)))`
Format 2024-05-29 03:57:51 +00:00
Rename elm to element, add render method 2024-05-29 01:30:06 +00:00			`(defmethod print-object ((element tag) stream)`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(with-slots (type props children) element`
Improve rendering 2024-06-07 01:07:37 +00:00			`(let ((type-str (string-downcase type))`
			`(props-str (render-props props)))`
Change type of element-type, add deftag macro 2024-05-28 10:31:50 +00:00			`(if children`
Fix props->string function 2024-05-28 12:42:28 +00:00			`(format stream`
Improve rendering 2024-06-07 01:07:37 +00:00			`(if (or (rest children)`
			`(typep (first children) 'element))`
			`"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"`
			`"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")`
Change type of element-type, add deftag macro 2024-05-28 10:31:50 +00:00			`type-str`
Improve rendering 2024-06-07 01:07:37 +00:00			`props-str`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(render-children element)`
Change type of element-type, add deftag macro 2024-05-28 10:31:50 +00:00			`type-str)`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(format stream "<~a~a></~a>" type-str props-str type-str)))))`

			`(defmethod print-object ((element self-closing-tag) stream)`
			`(with-slots (type props) element`
			`(format stream "<~a~a>" (string-downcase type) (render-props props))))`
define print-object method for element 2024-05-26 14:29:30 +00:00
Improve rendering 2024-06-07 01:07:37 +00:00			`(defun render-props (props)`
define print-object method for element 2024-05-26 14:29:30 +00:00			`(with-output-to-string (stream)`
			`(loop`
			`:for (key value) :on props :by #'cddr`
Fix props->string function 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`
Add escaper package 2024-05-31 09:39:25 +00:00			`(escape-html-attribute value)))))))`
define print-object method for element 2024-05-26 14:29:30 +00:00
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(defmethod render-children ((element tag))`
Improve rendering 2024-06-07 01:07:37 +00:00			`(mapcar (lambda (child)`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(if (stringp child)`
Improve rendering 2024-06-07 01:07:37 +00:00			`(escape-html-text-content child)`
			`child))`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(element-children element)))`

			`(defmethod render-children ((element non-escaping-tag))`
			`(element-children element))`
Improve rendering 2024-06-07 01:07:37 +00:00
Rename elm to element, add render method 2024-05-29 01:30:06 +00:00			`(defmethod print-object ((element html-tag) stream)`
define print-object method for element 2024-05-26 14:29:30 +00:00			`(format stream "<!DOCTYPE html>~%")`
			`(call-next-method))`

Rename elm to element, add render method 2024-05-29 01:30:06 +00:00			`(defmethod print-object ((element fragment) stream)`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(with-slots (children) element`
define print-object method for element 2024-05-26 14:29:30 +00:00			`(if children`
Fix props->string function 2024-05-28 12:42:28 +00:00			`(format stream`
			`(if (rest children)`
			`"~<~@{~a~^~:@_~}~:>"`
			`"~<~a~:>")`
define print-object method for element 2024-05-26 14:29:30 +00:00			`children))))`

Rename elm to element, add render method 2024-05-29 01:30:06 +00:00			`(defmethod print-object ((element component) stream)`
			`(print-object (expand-component element) stream))`
Rename to expand component 2024-05-27 07:03:23 +00:00
Rename elm to element, add render method 2024-05-29 01:30:06 +00:00			`(defmethod expand-component ((element component))`
Add subclasses of tag 2024-06-09 12:03:21 +00:00			`(with-slots (type props children) element`
Rename to expand component 2024-05-27 07:03:23 +00:00			`(apply type (merge-children-into-props props children))))`

			`(defun merge-children-into-props (props children)`
			`(append props`
			`(and children`
			`(list :children children))))`