paku/website
1
0
Fork 0
Code Issues4 Pull requests Projects Releases Packages Wiki Activity Actions

Add blog page

Browse source
This commit is contained in:
Akira Tempaku 2025-05-25 14:53:40 +09:00
parent 922a249ead
commit efcb6087b3
Signed by: paku
GPG key ID: 5B4E8402BCC50607
8 changed files with 133 additions and 30 deletions

26
src/components/article.lisp
View file

@ -7,7 +7,11 @@
(:export #:~article))
(in-package #:website/components/article)
(defcomp ~article (&key title content revised-at draft-p)
(defcomp ~article (&key title
content
published-at
revised-at
draft-p)
(hsx
(<>
(and draft-p (hsx (p :class "text-lg text-pink-500" "Draft Mode")))
@ -15,7 +19,19 @@
(h1 title)
(raw! content)
(p :class "text-right"
"(Last updated: "
(|time| :datetime (datetime revised-at)
(asctime revised-at))
")")))))
(and published-at
(hsx
(span
"(Published: "
(|time| :datetime (datetime published-at)
(asctime published-at))
")")))
(and revised-at
(hsx
(<>
(br)
(span
"(Last updated: "
(|time| :datetime (datetime revised-at)
(asctime revised-at))
")")))))))))

6
src/lib/cache.lisp
View file

@ -2,9 +2,11 @@
(:use #:cl)
(:import-from #:function-cache
#:defcached
#:clear-cache)
#:clear-cache
#:clear-cache-partial-arguments)
(:export #:memorize
#:clear-cache))
#:clear-cache
#:clear-cache-partial-artuments))
(in-package #:website/lib/cache)
(defmacro memorize (name)

6
src/lib/cms.lisp
View file

@ -9,9 +9,13 @@
(:import-from #:website/lib/cache
#:memorize)
(:export #:get-about
#:*get-about-cache*
#:get-works
#:*get-works-cache*
#:get-blog-list
#:get-blog-detail))
#:*get-blog-list-cache*
#:get-blog-detail
#:*get-blog-detail-cache*))
(in-package #:website/lib/cms)
(setf microcms:*service-domain* (microcms-service-domain))

42
src/routes/api/revalidate.lisp
View file

@ -1,15 +1,19 @@
(defpackage #:website/routes/api/revalidate
(:use #:cl
#:jingle)
#:jingle
#:access)
(:import-from #:website/lib/env
#:microcms-webhook-key)
(:import-from #:website/helper
#:get-request-body-plist)
(:import-from #:website/lib/cms
#:get-about
#:get-works)
#:*get-about-cache*
#:*get-works-cache*
#:*get-blog-list-cache*
#:*get-blog-detail-cache*)
(:import-from #:website/lib/cache
#:clear-cache)
#:clear-cache
#:clear-cache-partial-arguments)
(:export #:handle-post))
(in-package #:website/routes/api/revalidate)
@ -20,7 +24,29 @@
(set-response-status :unauthorized)
(return-from handle-post '(:|message| "Invalid token")))
(let* ((body (get-request-body-plist))
(api (getf body :|api|)))
(cond ((string= api "about") (clear-cache 'get-about))
((string= api "works") (clear-cache 'get-works)))
'(:|message| "ok")))
(api (getf body :|api|))
(id (getf body :|id|))
(old-draft-key (accesses body :|contents| :|old| :|draftKey|))
(new-draft-key (accesses body :|contents| :|new| :|draftKey|)))
(cond ((string= api "about")
(if new-draft-key
(clear-cache-partial-arguments *get-about-cache*
(list :query (list :draft-key new-draft-key)))
(clear-cache *get-about-cache*)))
((string= api "works")
(if new-draft-key
(clear-cache-partial-arguments *get-works-cache*
(list :query (list :draft-key new-draft-key)))
(clear-cache *get-works-cache*)))
((string= api "blog")
(unless new-draft-key
(clear-cache *get-blog-list-cache*)
(clear-cache-partial-arguments *get-blog-detail-cache*
(list id :query (list :draft-key old-draft-key))))
(clear-cache-partial-arguments *get-blog-detail-cache*
(list id :query (list :draft-key new-draft-key)))))
(list :|api| api
:|id| id
:|old-draft-key| old-draft-key
:|new-draft-key| new-draft-key
:|message| "ok")))

14
src/routes/blog.lisp
View file

@ -1,14 +0,0 @@
(defpackage #:website/routes/blog
(:use #:cl
#:hsx
#:jingle)
(:export #:handle-get))
(in-package #:website/routes/blog)
(defparameter *metadata*
(list :title "blog"))
(defun handle-get (params)
(declare (ignore params))
(setf (context :metadata) *metadata*)
(hsx (p "coming soon")))

30
src/routes/blog/<id>.lisp Normal file
View file

@ -0,0 +1,30 @@
(defpackage #:website/routes/blog/<id>
(:use #:cl
#:hsx
#:jingle)
(:import-from #:website/lib/cms
#:get-blog-detail)
(:import-from #:website/routes/not-found
#:handle-not-found)
(:import-from #:website/components/article
#:~article)
(:export #:handle-get))
(in-package #:website/routes/blog/<id>)
(defun handle-get (params)
(with-request-params ((id :id nil)
(draft-key "draft-key" nil)) params
(setf (context :no-cache) draft-key)
(let ((blog (get-blog-detail id :query (list :draft-key draft-key))))
(unless blog
(return-from handle-get (handle-not-found)))
(setf (context :metadata) (list :title (getf blog :title)
:description (getf blog :description)
:type "article"))
(hsx
(~article
:title (getf blog :title)
:content (getf blog :content)
:published-at (getf blog :published-at)
:revised-at (getf blog :revised-at)
:draft-p draft-key)))))

38
src/routes/blog/index.lisp Normal file
View file

@ -0,0 +1,38 @@
(defpackage #:website/routes/blog/index
(:use #:cl
#:hsx
#:jingle)
(:import-from #:website/lib/cms
#:get-blog-list)
(:import-from #:website/lib/time
#:asctime)
(:export #:handle-get))
(in-package #:website/routes/blog/index)
(defparameter *metadata*
(list :title "blog"))
(defun handle-get (params)
(declare (ignore params))
(setf (context :metadata) *metadata*)
(let ((blogs (getf (get-blog-list :query '(:fields "id,title,publishedAt"
:limit 100))
:contents)))
(hsx
(section
(h1 :class "font-bold text-4xl mb-8"
"Blog")
(ul :preload "mouseover" :class "flex flex-col gap-y-2"
(loop
:for item :in blogs :collect
(hsx
(li
(a
:class "hover:text-pink-500"
:href (format nil "/blog/~a" (getf item :id))
(span :class "font-bold"
"･ " (getf item :title))
(span :class "text-sm text-gray-400 ml-2"
"(" (asctime (getf item :published-at)) ")"))))))
;TODO: pagenation
))))

1
src/routes/not-found.lisp
View file

@ -13,6 +13,7 @@
:error t))
(defun handle-not-found ()
(set-response-status :not-found)
(setf (context :metadata) *metadata*)
(if (api-request-p)
'(:|message| "404 Not Found")