Improve view package

src/routes/about.lisp

@@ -1,7 +1,7 @@
 (defpackage #:hp/routes/about
   (:use #:cl)
   (:local-nicknames (#:pi #:piccolo))
-  (:local-nicknames (#:view #:hp/view))
+  (:local-nicknames (#:view #:hp/view/*))
   (:export #:handle-get))
 (in-package #:hp/routes/about)
 

src/routes/index.lisp

@@ -1,7 +1,7 @@
 (defpackage #:hp/routes/index
   (:use #:cl)
   (:local-nicknames (#:pi #:piccolo))
-  (:local-nicknames (#:view #:hp/view))
+  (:local-nicknames (#:view #:hp/view/*))
   (:export #:handle-get))
 (in-package #:hp/routes/index)
 

src/routes/not-found.lisp

@@ -2,7 +2,7 @@
   (:use #:cl)
   (:local-nicknames (#:jg #:jingle))
   (:local-nicknames (#:pi #:piccolo))
-  (:local-nicknames (#:view #:hp/view))
+  (:local-nicknames (#:view #:hp/view/*))
   (:export #:handle-not-found))
 (in-package #:hp/routes/not-found)
 

src/view.lisp

@@ -1,56 +0,0 @@
-(defpackage #:hp/view
-  (:use #:cl)
-  (:local-nicknames (#:jg #:jingle))
-  (:local-nicknames (#:pi #:piccolo))
-  (:local-nicknames (#:re #:cl-ppcre))
-  (:export #:render))
-(in-package #:hp/view)
-
-(defun detect-data-cmps (page-str)
-  (remove-duplicates (cl-ppcre:all-matches-as-strings "(?<=data-cmp=\")[^\"]*(?=\")"
-                                                      page-str)
-                     :test #'string=))
-
-(defun data-cmps->style-hrefs (data-cmps)
-  (mapcar (lambda (cmp-name)
-            (concatenate 'string "/styles/" cmp-name ".css"))
-          data-cmps))
-
-(pi:define-element on-demand-stylesheets (hrefs)
-  (pi:h
-    (<> '()
-      (mapcar (lambda (href)
-                (link :rel "stylesheet" :type "text/css" :href href))
-              hrefs))))
-
-(pi:define-element document (title description style-hrefs)
-  (pi:h
-    (html :lang "ja"
-      (head
-        (meta :charset "UTF-8")
-        (script :src "/scripts/htmx.js")
-        (script :src "/scripts/htmx-ext/head-support.js")
-        (script :src "/scripts/alpine.js" :defer t)
-        (link :rel "stylesheet" :type "text/css" :href "/styles/ress.css")
-        (link :rel "stylesheet" :type "text/css" :href "/styles/global.css")
-        (link :rel "preconnect" :href "https://fonts.googleapis.com")
-        (link :rel "preconnect" :href "https://fonts.gstatic.com" :crossorigin t)
-        (link 
-          :rel "stylesheet"
-          :href "https://fonts.googleapis.com/css2?family=Noto+Sans+JP:wght@400;700&display=swap")
-        (title (format nil "~@[~a - ~]skyizwhite.dev" title))
-        (meta
-          :name "description"
-          :content (or description "pakuの個人サイト"))
-        (on-demand-stylesheets :hrefs style-hrefs))
-      (body :hx-ext "head-support"
-        (main pi:children)))))
-
-(defun render (page &key status metadata)
-  (jg:with-html-response
-    (and status (jg:set-response-status status))
-    (let* ((page-str (pi:elem-str page))
-           (style-hrefs (data-cmps->style-hrefs (detect-data-cmps page-str))))
-      (pi:elem-str
-       (document `(,@metadata :style-hrefs ,style-hrefs)
-         page)))))

src/view/optimizer.lisp

@@ -0,0 +1,18 @@
+(defpackage #:hp/view/optimizer
+  (:use #:cl)
+  (:local-nicknames (#:re #:cl-ppcre))
+  (:export #:collect-style-links))
+(in-package #:hp/view/optimizer)
+
+(defun detect-components (page-str)
+  (remove-duplicates (re:all-matches-as-strings "(?<=data-cmp=\")[^\"]*(?=\")"
+                                                page-str)
+                     :test #'string=))
+
+(defun components->stylesheets (data-cmps)
+  (mapcar (lambda (cmp-name)
+            (concatenate 'string "/styles/" cmp-name ".css"))
+          data-cmps))
+
+(defun collect-style-links (page-str)
+  (components->stylesheets (detect-components page-str)))

src/view/renderer.lisp

@@ -0,0 +1,59 @@
+(defpackage #:hp/view/renderer
+  (:use #:cl)
+  (:local-nicknames (#:jg #:jingle))
+  (:local-nicknames (#:pi #:piccolo))
+  (:local-nicknames (#:opt #:hp/view/optimizer))
+  (:export #:render
+           #:partial-render))
+(in-package #:hp/view/renderer)
+
+(pi:define-element stylesheets (hrefs)
+  (pi:h
+    (<> '()
+      (mapcar (lambda (href)
+                (link :rel "stylesheet" :type "text/css" :href href))
+              hrefs))))
+
+(pi:define-element document (title description)
+  (let* ((children-str (pi:elem-str pi:children))
+         (style-links (opt:collect-style-links children-str)))
+    (pi:h
+      (html :lang "ja"
+        (head
+          (meta :charset "UTF-8")
+          (script :src "/scripts/htmx.js")
+          (script :src "/scripts/htmx-ext/head-support.js")
+          (script :src "/scripts/alpine.js" :defer t)
+          (link :rel "stylesheet" :type "text/css" :href "/styles/ress.css")
+          (link :rel "stylesheet" :type "text/css" :href "/styles/global.css")
+          (link :rel "preconnect" :href "https://fonts.googleapis.com")
+          (link :rel "preconnect" :href "https://fonts.gstatic.com" :crossorigin t)
+          (link 
+            :rel "stylesheet"
+            :href "https://fonts.googleapis.com/css2?family=Noto+Sans+JP:wght@400;700&display=swap")
+          (title (format nil "~@[~a - ~]skyizwhite.dev" title))
+          (meta
+            :name "description"
+            :content (or description "pakuの個人サイト"))
+          (stylesheets :hrefs style-links))
+        (body :hx-ext "head-support"
+          (main pi:children))))))
+
+(pi:define-element assets-provider ()
+  (let* ((child-str (pi:elem-str pi:children))
+         (style-links (opt:collect-style-links child-str)))
+    (pi:h
+      (<>
+        (head :hx-head "append"
+          (stylesheets :hrefs style-links))
+        pi:children))))
+
+(defun render (page &key status metadata)
+  (jg:with-html-response
+    (and status (jg:set-response-status status))
+    (pi:elem-str (document metadata page))))
+
+(defun partial-render (component &key status)
+  (jg:with-html-response
+    (and status (jg:set-response-status status))
+    (pi:elem-str (assets-provider component))))