From 88d87a59206da1032cb9f0b27a0706f5e39422ac Mon Sep 17 00:00:00 2001
From: paku <paku@skyizwhite.dev>
Date: Thu, 8 Feb 2024 23:39:54 +0900
Subject: [PATCH] Add fragment (#2)

* Add fragment

* Fix test
---
 src/package.lisp |  3 +++
 src/piccolo.lisp | 53 ++++++++++++++++++++++++++++++++++--------------
 t/piccolo.lisp   |  9 +++++---
 3 files changed, 47 insertions(+), 18 deletions(-)

diff --git a/src/package.lisp b/src/package.lisp
index f04bf72..c3e13fb 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -21,6 +21,9 @@
    ;;; exported as |time|, |map|
    :html
 
+   ;;; fragment
+   :<>
+
    ;;; user defined elements
    :define-element
    :*expand-user-element*
diff --git a/src/piccolo.lisp b/src/piccolo.lisp
index 799bfff..af800cf 100644
--- a/src/piccolo.lisp
+++ b/src/piccolo.lisp
@@ -18,6 +18,9 @@
   ((expand-to :initarg :expander
               :accessor user-element-expander)))
 
+(defclass fragment (element)
+  ())
+
 (defun make-builtin-element (&key tag attrs children)
   (make-instance 'builtin-element
                  :tag tag
@@ -44,6 +47,12 @@
            (element-attrs element)
            (element-children element)))
 
+(defun make-fragment (&key children)
+  (make-instance 'fragment
+                 :tag 'fragment
+                 :attrs (make-attrs :alist nil)
+                 :children (escape-children children)))
+
 (defstruct (attrs (:constructor %make-attrs))
   alist)
 
@@ -164,21 +173,22 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
 (defmacro! define-element (name (&rest args) &body body)
   (let ((%name (alexandria:symbolicate '% name)))
     `(progn
-       (defun ,%name (&rest ,g!attrs-and-children)
+       (defun ,%name (&rest attrs-and-children)
          (multiple-value-bind (,g!attrs ,g!children)
-             (split-attrs-and-children ,g!attrs-and-children)
-           (let ((,g!element
-                   (make-user-element :tag (string-downcase ',name)
-                                      :attrs ,g!attrs
-                                      :children ,g!children)))
-             (setf (user-element-expander ,g!element)
-                   (lambda (tag attrs children)
-                     (declare (ignorable tag attrs children))
-                     (let ,(mapcar (lambda (arg)
-                                     (list arg `(attr attrs (make-keyword ',arg))))
-                                   args)
-                       (progn ,@body))))
-             ,g!element)))
+             (split-attrs-and-children attrs-and-children)
+           (make-user-element 
+            :tag (string-downcase ',name)
+            :attrs ,g!attrs
+            :children ,g!children
+            :expander (lambda (tag attrs ,g!exp-children)
+                        (declare (ignorable tag attrs ,g!exp-children))
+                        (let ((children (and ,g!exp-children
+                                             (make-fragment :children ,g!exp-children))))
+                          (declare (ignorable children))
+                          (let ,(mapcar (lambda (arg)
+                                          (list arg `(attr attrs (make-keyword ',arg))))
+                                        args)
+                            (progn ,@body)))))))
        (defmacro ,name (&body attrs-and-children)
          `(,',%name ,@attrs-and-children)))))
 
@@ -189,6 +199,19 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
       (print-object (user-element-expand-to element) stream)
       (call-next-method)))
 
+(defun %<> (&rest children)
+  (make-fragment :children children))
+
+(defmacro <> (&body children)
+  `(%<> ,@children))
+
+(defmethod print-object ((element fragment) stream)
+  (if (element-children element)
+      (format stream (if (rest (element-children element))
+                         "~<~@{~a~^~:@_~}~:>"
+                         "~<~a~:>")
+              (element-children element))))
+
 (defun html-element-p (x)
   (and (symbolp x) (not (keywordp x)) (gethash (make-keyword x) *builtin-elements*)))
 
@@ -196,7 +219,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
   `(progn
      ,@(modify-first-leaves
         body
-        (html-element-p x)
+        (or (html-element-p x) (string= x '<>))
         (find-symbol (string-upcase x) :piccolo))))
 
 (defmethod element-string ((element element))
diff --git a/t/piccolo.lisp b/t/piccolo.lisp
index 66f140a..b59cdb3 100644
--- a/t/piccolo.lisp
+++ b/t/piccolo.lisp
@@ -261,19 +261,22 @@
 
     (is (eql nil (attrs-alist (element-attrs dog3))))
     (is (string= "dog" (second (element-children (user-element-expand-to dog3)))))
-    (is (string= "dog.png" (attr (first (element-children (user-element-expand-to dog3))) :src)))
+    (is (string= "dog.png" (attr (first (element-children
+                                         (first (element-children (user-element-expand-to dog3))))) :src)))
     (is (string= "dog.png" (attr (first (element-children dog3)) :src)))
 
     (is (equal '((:id . "dog") (:size . 10)) (attrs-alist (element-attrs dog4))))
     (is (= 10 (attr dog4 :size)))
     (is (string= "img" (element-tag (first (element-children dog4)))))
-    (is (string= "dog4.png" (attr (first (element-children (user-element-expand-to dog4))) :src)))
+    (is (string= "dog4.png" (attr (first (element-children
+                                          (first (element-children (user-element-expand-to dog4))))) :src)))
     (is (string= "woo" (second (element-children dog4))))
 
     (setf (attr dog4 :size) 16)
     (is (string= "big-dog" (attr (user-element-expand-to dog4) :class)))
     (setf (element-children dog4) (list dog1 dog2 dog3))
-    (is (equal (list dog1 dog2 dog3 "dog") (element-children (user-element-expand-to dog4))))))
+    (is (equal (list dog1 dog2 dog3) (element-children
+                                      (first (element-children (user-element-expand-to dog4))))))))
 
 (test user-element-html-generation
   (LET* ((dog1 (dog))