From 56ffa88dbfb39d8d2ca6c232ecd5bfba2e354c95 Mon Sep 17 00:00:00 2001
From: paku <paku@skyizwhite.dev>
Date: Sun, 14 Apr 2024 00:18:48 +0900
Subject: [PATCH] Add on-demand styling feature
---
src/routes/about.lisp | 6 ++++--
src/routes/index.lisp | 2 +-
src/styles/pages/about.css | 8 ++++++++
src/styles/pages/index.css | 8 ++++++++
src/view.lisp | 29 ++++++++++++++++++++++++++---
5 files changed, 47 insertions(+), 6 deletions(-)
create mode 100644 src/styles/pages/about.css
create mode 100644 src/styles/pages/index.css
diff --git a/src/routes/about.lisp b/src/routes/about.lisp
index e159045..797285c 100644
--- a/src/routes/about.lisp
+++ b/src/routes/about.lisp
@@ -11,8 +11,10 @@
(pi:define-element page ()
(pi:h
- (section
- (h1 "About"))))
+ (section :data-cmp "pages/about"
+ (h1 "About")
+ (a :href "/" :hx-boost "true"
+ "top"))))
(defun on-get (params)
(declare (ignore params))
diff --git a/src/routes/index.lisp b/src/routes/index.lisp
index 4cd9fa8..59d0656 100644
--- a/src/routes/index.lisp
+++ b/src/routes/index.lisp
@@ -7,7 +7,7 @@
(pi:define-element page ()
(pi:h
- (section
+ (section :data-cmp "pages/index"
(h1 "Hello, World!")
(a :href "/about" :hx-boost "true"
"About"))))
diff --git a/src/styles/pages/about.css b/src/styles/pages/about.css
new file mode 100644
index 0000000..7f045cd
--- /dev/null
+++ b/src/styles/pages/about.css
@@ -0,0 +1,8 @@
+@scope ([data-cmp='pages/about']) {
+ :scope {
+ height: 100svh;
+ background-color: thistle;
+ display: grid;
+ place-content: center;
+ }
+}
diff --git a/src/styles/pages/index.css b/src/styles/pages/index.css
new file mode 100644
index 0000000..904a4a7
--- /dev/null
+++ b/src/styles/pages/index.css
@@ -0,0 +1,8 @@
+@scope ([data-cmp='pages/index']) {
+ :scope {
+ height: 100svh;
+ background-color: aliceblue;
+ display: grid;
+ place-content: center;
+ }
+}
diff --git a/src/view.lisp b/src/view.lisp
index 31f28e7..8719b37 100644
--- a/src/view.lisp
+++ b/src/view.lisp
@@ -2,10 +2,28 @@
(:use #:cl)
(:local-nicknames (#:jg #:jingle))
(:local-nicknames (#:pi #:piccolo))
+ (:local-nicknames (#:re #:cl-ppcre))
(:export #:render))
(in-package #:hp/view)
-(pi:define-element document (title description)
+(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
@@ -23,11 +41,16 @@
(title (format nil "~@[~a - ~]skyizwhite.dev" title))
(meta
:name "description"
- :content (or description "pakuの個人サイト")))
+ :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))
- (pi:elem-str (document metadata page))))
+ (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)))))