From 95eea6da44453339b2c1c42c6f92267efd11d63a Mon Sep 17 00:00:00 2001
From: paku <paku@skyizwhite.dev>
Date: Fri, 9 Feb 2024 01:37:34 +0900
Subject: [PATCH] Use package-inferred-system (#3)

---
 piccolo-test.asd                    |   2 +-
 piccolo.asd                         |  25 ++----
 src/{piccolo.lisp => elements.lisp} | 127 ++++++++++++++++++++--------
 src/main.lisp                       |   6 ++
 src/package.lisp                    |  61 -------------
 src/util.lisp                       |  91 ++++++++++----------
 6 files changed, 153 insertions(+), 159 deletions(-)
 rename src/{piccolo.lisp => elements.lisp} (65%)
 create mode 100644 src/main.lisp
 delete mode 100644 src/package.lisp

diff --git a/piccolo-test.asd b/piccolo-test.asd
index 88b7216..51ca721 100644
--- a/piccolo-test.asd
+++ b/piccolo-test.asd
@@ -1,5 +1,5 @@
 (defsystem piccolo-test
-  :author "Bo Yao <icerove@gmail.com>"
+  :author "paku <paku@skyizwhite.dev>"
   :license "MIT"
   :depends-on (:piccolo :fiveam)
   :components ((:module "t"
diff --git a/piccolo.asd b/piccolo.asd
index 407149d..2937d21 100644
--- a/piccolo.asd
+++ b/piccolo.asd
@@ -1,18 +1,11 @@
-(defsystem piccolo
-  :author "Bo Yao <icerove@gmail.com>"
+(defsystem "piccolo"
+  :version "0.1.0"
+  :description "A beautiful, easily composable HTML5 generation library"
+  :author "paku <paku@skyizwhite.dev>"
   :license "MIT"
-  :version "0.2-dev"
-  :components ((:module "src"
-                :serial t
-                :components
-                ((:file "package")
-                 (:file "util")
-                 (:file "piccolo"))))
-  :description "A beautiful, easilly composable HTML5 generation library"
-  :long-description
-  #.(uiop:read-file-string
-     (uiop:subpathname *load-pathname* "README.md"))
+  :long-description #.(uiop:read-file-string
+                       (uiop:subpathname *load-pathname* "README.md"))
   :in-order-to ((test-op (test-op piccolo-test)))
-  :depends-on (:alexandria
-               :assoc-utils
-               :let-over-lambda))
+  :class :package-inferred-system
+  :pathname "src"
+  :depends-on ("piccolo/main"))
diff --git a/src/piccolo.lisp b/src/elements.lisp
similarity index 65%
rename from src/piccolo.lisp
rename to src/elements.lisp
index af800cf..c459b33 100644
--- a/src/piccolo.lisp
+++ b/src/elements.lisp
@@ -1,4 +1,46 @@
-(in-package :piccolo)
+(uiop:define-package #:piccolo/elements
+  (:use #:cl)
+  (:local-nicknames (#:util #:piccolo/util))
+  (:local-nicknames (#:asc #:assoc-utils))
+  (:local-nicknames (#:lol #:let-over-lambda))
+  (:local-nicknames (#:alx #:alexandria))
+  (:export
+   ;;; builtin HTML elements
+   ;;; all html5 elements, e.g. div, nav, media, export in code except
+   ;;; <time> and <map> conflicts with cl symbol, are defined and
+   ;;; exported as |time|, |map|
+   #:html
+
+   ;;; fragment lets you group elements without a wrapper element.
+   #:<>
+
+   ;;; user defined elements
+   #:define-element
+   #:*expand-user-element*
+   ;; for reference tag name, attributes and children elements in user
+   ;; element definition
+   #:tag
+   #:children
+   #:attrs
+
+   ;;; attribute accessing utilility
+   #:attrs-alist
+   #:make-attrs
+   #:copy-attrs
+   #:attr
+   #:delete-attr
+
+   ;;; element slots
+   #:element-tag
+   #:element-attrs
+   #:element-children
+   #:user-element-expand-to
+
+   ;;; the h macro for avoiding import all builtin html element functions
+   #:h
+   #:element-string
+   #:elem-str))
+(in-package #:piccolo/elements)
 
 (defclass element ()
   ((tag :initarg :tag
@@ -25,21 +67,21 @@
   (make-instance 'builtin-element
                  :tag tag
                  :attrs attrs
-                 :children (escape-children children)))
+                 :children (util:escape-children children)))
 
 (defun make-builtin-element-with-prefix (&key tag attrs children prefix)
   (make-instance 'builtin-element-with-prefix
                  :tag tag
                  :attrs attrs
                  :prefix prefix
-                 :children (escape-children children)))
+                 :children (util:escape-children children)))
 
 (defun make-user-element (&key tag attrs children expander)
   (make-instance 'user-element
                  :tag tag
                  :attrs attrs
                  :expander expander
-                 :children (escape-children children)))
+                 :children (util:escape-children children)))
 
 (defmethod user-element-expand-to ((element user-element))
   (funcall (user-element-expander element)
@@ -51,35 +93,24 @@
   (make-instance 'fragment
                  :tag 'fragment
                  :attrs (make-attrs :alist nil)
-                 :children (escape-children children)))
+                 :children (util:escape-children children)))
 
 (defstruct (attrs (:constructor %make-attrs))
   alist)
 
-(defvar *escape-html* :utf8
-  "Specify the escape option when generate html, can be :UTF8, :ASCII, :ATTR or NIL.
-If :UTF8, escape only #\<, #\> and #\& in body, and \" in attribute keys. #\' will
-in attribute keys will not be escaped since piccolo will always use double quote for
-attribute keys.
-If :ASCII, besides what escaped in :UTF8, also escape all non-ascii characters.
-If :ATTR, only #\" in attribute values will be escaped.
-If NIL, nothing is escaped and programmer is responsible to escape elements properly.
-When given :ASCII and :ATTR, it's possible to insert html text as a children, e.g.
-(div :id \"container\" \"Some <b>text</b>\")")
-
 (defun make-attrs (&key alist)
-  (if *escape-html*
-      (%make-attrs :alist (escape-attrs-alist alist))
+  (if util:*escape-html*
+      (%make-attrs :alist (util:escape-attrs-alist alist))
       (%make-attrs :alist alist)))
 
 (defmethod (setf attr) (value (attrs attrs) key)
-  (setf (aget (attrs-alist attrs) key) value))
+  (setf (asc:aget (attrs-alist attrs) key) value))
 
 (defmethod delete-attr ((attrs attrs) key)
-  (delete-from-alistf (attrs-alist attrs) key))
+  (asc:delete-from-alistf (attrs-alist attrs) key))
 
 (defmethod attr ((attrs attrs) key)
-  (aget (attrs-alist attrs) key))
+  (asc:aget (attrs-alist attrs) key))
 
 (defmethod (setf attr) (value (element element) key)
   (setf (attr (element-attrs element) key) value))
@@ -92,6 +123,30 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
 
 (defvar *builtin-elements* (make-hash-table))
 
+(defun split-attrs-and-children (attrs-and-children)
+  (cond
+    ((attrs-p (first attrs-and-children))
+     (values (first attrs-and-children) (lol:flatten (rest attrs-and-children))))
+    ((asc:alistp (first attrs-and-children))
+     (values (make-attrs :alist (first attrs-and-children))
+             (lol:flatten (rest attrs-and-children))))
+    ((listp (first attrs-and-children)) ;plist
+     (values (make-attrs :alist (util:plist-alist (first attrs-and-children)))
+             (lol:flatten (rest attrs-and-children))))
+    ((hash-table-p (first attrs-and-children))
+     (values (make-attrs :alist (asc:hash-alist (first attrs-and-children)))
+             (lol:flatten (rest attrs-and-children))))
+    ((keywordp (first attrs-and-children)) ;inline-plist
+     (loop for thing on attrs-and-children by #'cddr
+           for (k v) = thing
+           when (and (keywordp k) v)
+           collect (cons k v) into attrs
+           when (not (keywordp k))
+           return (values (make-attrs :alist attrs) (lol:flatten thing))
+           finally (return (values (make-attrs :alist attrs) nil))))
+    (t
+     (values (make-attrs :alist nil) (lol:flatten attrs-and-children)))))
+
 (defun %html (&rest attrs-and-children)
   (multiple-value-bind (attrs children)
       (split-attrs-and-children attrs-and-children)
@@ -106,12 +161,12 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
 (setf (gethash :html *builtin-elements*) t)
 
 (defmacro define-builtin-element (element-name)
-  (let ((%element-name (alexandria:symbolicate '% element-name)))
+  (let ((%element-name (alx:symbolicate '% element-name)))
     `(progn
        (defun ,%element-name (&rest attrs-and-children)
          (multiple-value-bind (attrs children)
              (split-attrs-and-children attrs-and-children)
-           (make-builtin-element :tag (string-downcase (mkstr ',element-name))
+           (make-builtin-element :tag (string-downcase (lol:mkstr ',element-name))
                                  :attrs attrs
                                  :children children)))
        (defmacro ,element-name (&body attrs-and-children)
@@ -121,7 +176,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
   `(progn
      ,@(mapcan (lambda (e)
                  (list `(define-builtin-element ,e)
-                       `(setf (gethash (make-keyword ',e) *builtin-elements*) t)
+                       `(setf (gethash (alx:make-keyword ',e) *builtin-elements*) t)
                        `(export ',e)))
                element-names)))
 
@@ -138,7 +193,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
 
 (defmethod print-object ((attrs attrs) stream)
   (if (attrs-alist attrs)
-      (format stream " ~{~a=~s~^ ~}" (alist-plist (attrs-alist attrs)))
+      (format stream " ~{~a=~s~^ ~}" (util:alist-plist (attrs-alist attrs)))
       (format stream "")))
 
 (defparameter *self-closing-tags*
@@ -170,8 +225,8 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
   (format stream "~a~%" (element-prefix element))
   (call-next-method))
 
-(defmacro! define-element (name (&rest args) &body body)
-  (let ((%name (alexandria:symbolicate '% name)))
+(lol:defmacro! define-element (name (&rest args) &body body)
+  (let ((%name (alx:symbolicate '% name)))
     `(progn
        (defun ,%name (&rest attrs-and-children)
          (multiple-value-bind (,g!attrs ,g!children)
@@ -186,7 +241,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
                                              (make-fragment :children ,g!exp-children))))
                           (declare (ignorable children))
                           (let ,(mapcar (lambda (arg)
-                                          (list arg `(attr attrs (make-keyword ',arg))))
+                                          (list arg `(attr attrs (alx:make-keyword ',arg))))
                                         args)
                             (progn ,@body)))))))
        (defmacro ,name (&body attrs-and-children)
@@ -212,15 +267,21 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
                          "~<~a~:>")
               (element-children element))))
 
-(defun html-element-p (x)
-  (and (symbolp x) (not (keywordp x)) (gethash (make-keyword x) *builtin-elements*)))
+(defun html-element-p (node)
+  (and (symbolp node)
+       (not (keywordp node))
+       (gethash (alx:make-keyword node) *builtin-elements*)))
 
 (defmacro h (&body body)
   `(progn
-     ,@(modify-first-leaves
+     ,@(util:modify-first-leaves
         body
-        (or (html-element-p x) (string= x '<>))
-        (find-symbol (string-upcase x) :piccolo))))
+        (lambda (node)
+          (declare (ignorable node))
+          (or (html-element-p node) (string= node '<>)))
+        (lambda (node)
+          (declare (ignorable node))
+          (find-symbol (string-upcase node) :piccolo)))))
 
 (defmethod element-string ((element element))
   (with-output-to-string (s)
diff --git a/src/main.lisp b/src/main.lisp
new file mode 100644
index 0000000..3f3d606
--- /dev/null
+++ b/src/main.lisp
@@ -0,0 +1,6 @@
+(uiop:define-package :piccolo
+  (:nicknames #:piccolo/main)
+  (:use #:cl)
+  (:use-reexport #:piccolo/elements)
+  (:use-reexport #:piccolo/util))
+(in-package :piccolo)
diff --git a/src/package.lisp b/src/package.lisp
deleted file mode 100644
index c3e13fb..0000000
--- a/src/package.lisp
+++ /dev/null
@@ -1,61 +0,0 @@
-(in-package :cl-user)
-(defpackage piccolo
-  (:use :cl)
-  (:import-from :assoc-utils
-                :alist
-                :alistp
-                :hash-alist
-                :aget
-                :delete-from-alistf)
-  (:import-from :let-over-lambda
-                :defmacro!
-                :mkstr
-                :flatten)
-  (:import-from :alexandria
-                :make-keyword
-                :if-let)
-  (:export
-   ;;; builtin HTML elements
-   ;;; all html5 elements, e.g. div, nav, media, export in code except
-   ;;; <time> and <map> conflicts with cl symbol, are defined and
-   ;;; exported as |time|, |map|
-   :html
-
-   ;;; fragment
-   :<>
-
-   ;;; user defined elements
-   :define-element
-   :*expand-user-element*
-   ;; for reference tag name, attributes and children elements in user
-   ;; element definition
-   :tag
-   :children
-   :attrs
-
-   ;;; attribute accessing utilility
-   :attrs-alist
-   :make-attrs
-   :copy-attrs
-   :attr
-   :delete-attr
-
-   ;;; element slots
-   :element-tag
-   :element-attrs
-   :element-children
-   :user-element-expand-to
-
-   ;;; the h macro for avoiding import all builtin html element functions
-   :h
-
-   ;;; escape utility
-   :*escape-html*
-   :escape-string
-   :utf8-html-escape-char-p
-   :ascii-html-escape-char-p
-   :attr-value-escape-char-p
-
-   ;;; helper for generate html string
-   :element-string
-   :elem-str))
diff --git a/src/util.lisp b/src/util.lisp
index 168316e..5082721 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -1,4 +1,22 @@
-(in-package :piccolo)
+(uiop:define-package #:piccolo/util
+  (:use #:cl)
+  (:export
+   ;;; list utility
+   #:plist-alist
+   #:alist-plist
+
+   ;;; escape utility
+   #:*escape-html*
+   #:utf8-html-escape-char-p
+   #:ascii-html-escape-char-p
+   #:attr-value-escape-char-p
+   #:escape-string
+   #:escape-attrs-alist
+   #:escape-children
+
+   ;;; syntax tree utility
+   #:modify-first-leaves))
+(in-package #:piccolo/util)
 
 (defun plist-alist (plist)
   (loop for (k v) on plist by #'cddr
@@ -10,30 +28,16 @@
                   (cdr kv)))
           alist))
 
-(defun %%modify-first-leaves (tree test result)
-  (if tree
-      (cons (let ((first-node (first tree)))
-              (cond
-                ((listp first-node)
-                 (%%modify-first-leaves first-node test result))
-                ((funcall test first-node)
-                 (funcall result first-node))
-                (t first-node)))
-            (mapcar (lambda (node)
-                      (if (listp node)
-                          (%%modify-first-leaves node test result)
-                          node))
-                    (rest tree)))))
-
-(defmacro modify-first-leaves (tree test result)
-  `(%%modify-first-leaves
-    ,tree
-    (lambda (x)
-      (declare (ignorable x))
-      ,test)
-    (lambda (x)
-      (declare (ignorable x))
-      ,result)))
+(defvar *escape-html* :utf8
+  "Specify the escape option when generate html, can be :UTF8, :ASCII, :ATTR or NIL.
+If :UTF8, escape only #\<, #\> and #\& in body, and \" in attribute keys. #\' will
+in attribute keys will not be escaped since piccolo will always use double quote for
+attribute keys.
+If :ASCII, besides what escaped in :UTF8, also escape all non-ascii characters.
+If :ATTR, only #\" in attribute values will be escaped.
+If NIL, nothing is escaped and programmer is responsible to escape elements properly.
+When given :ASCII and :ATTR, it's possible to insert html text as a children, e.g.
+(div :id \"container\" \"Some <b>text</b>\")")
 
 (defun utf8-html-escape-char-p (char)
   (find char "<>&"))
@@ -78,26 +82,17 @@
                 child))
           children))
 
-(defun split-attrs-and-children (attrs-and-children)
-  (cond
-    ((attrs-p (first attrs-and-children))
-     (values (first attrs-and-children) (flatten (rest attrs-and-children))))
-    ((alistp (first attrs-and-children))
-     (values (make-attrs :alist (first attrs-and-children))
-             (flatten (rest attrs-and-children))))
-    ((listp (first attrs-and-children)) ;plist
-     (values (make-attrs :alist (plist-alist (first attrs-and-children)))
-             (flatten (rest attrs-and-children))))
-    ((hash-table-p (first attrs-and-children))
-     (values (make-attrs :alist (hash-alist (first attrs-and-children)))
-             (flatten (rest attrs-and-children))))
-    ((keywordp (first attrs-and-children)) ;inline-plist
-     (loop for thing on attrs-and-children by #'cddr
-           for (k v) = thing
-           when (and (keywordp k) v)
-           collect (cons k v) into attrs
-           when (not (keywordp k))
-           return (values (make-attrs :alist attrs) (flatten thing))
-           finally (return (values (make-attrs :alist attrs) nil))))
-    (t
-     (values (make-attrs :alist nil) (flatten attrs-and-children)))))
+(defun modify-first-leaves (tree test result)
+  (if tree
+      (cons (let ((first-node (first tree)))
+              (cond
+                ((listp first-node)
+                 (modify-first-leaves first-node test result))
+                ((funcall test first-node)
+                 (funcall result first-node))
+                (t first-node)))
+            (mapcar (lambda (node)
+                      (if (listp node)
+                          (modify-first-leaves node test result)
+                          node))
+                    (rest tree)))))