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

Refactor cache control

Browse source
This commit is contained in:
Akira Tempaku 2025-05-25 19:41:59 +09:00
parent bdbcf416f0
commit f6929c47cd
Signed by: paku
GPG key ID: 5B4E8402BCC50607
7 changed files with 64 additions and 67 deletions

17
src/lib/cache.lisp
View file

@ -1,17 +0,0 @@
(defpackage #:website/lib/cache
(:use #:cl)
(:import-from #:function-cache
#:defcached
#:clear-cache
#:clear-cache-partial-arguments)
(:export #:memorize
#:clear-cache
#:clear-cache-partial-artuments))
(in-package #:website/lib/cache)
(defmacro memorize (name)
(let ((origin (gensym)))
`(progn
(setf (fdefinition ',origin) (fdefinition ',name))
(defcached ,name (&rest args)
(apply #',origin args)))))

64
src/lib/cms.lisp
View file

@ -3,30 +3,62 @@
(:import-from #:microcms
#:define-list-client
#:define-object-client)
(:import-from #:function-cache
#:defcached
#:clear-cache
#:clear-cache-partial-arguments)
(:import-from #:website/lib/env
#:microcms-service-domain
#:microcms-api-key)
(:import-from #:website/lib/cache
#:memorize)
(:export #:get-about
#:*get-about-cache*
#:get-works
#:*get-works-cache*
#:get-blog-list
#:*get-blog-list-cache*
#:get-blog-detail
#:*get-blog-detail-cache*))
(:export #:fetch-about
#:fetch-works
#:fetch-blog-list
#:fetch-blog-detail
#:clear-about-cache
#:clear-works-cache
#:clear-blog-list-cache
#:clear-blog-detail-cache))
(in-package #:website/lib/cms)
(setf microcms:*service-domain* (microcms-service-domain))
(setf microcms:*api-key* (microcms-api-key))
(define-object-client about)
(memorize get-about)
(define-object-client works)
(memorize get-works)
(define-list-client blog)
(memorize get-blog-list)
(memorize get-blog-detail)
(defcached fetch-about (&key draft-key)
(get-about :query (list :draft-key draft-key)))
(defcached fetch-works (&key draft-key)
(get-works :query (list :draft-key draft-key)))
(defcached fetch-blog-list (&key page)
;TODO: pagenation
(declare (ignore page))
(getf (get-blog-list :query '(:fields "id,title,publishedAt"
:limit 100))
:contents))
(defcached fetch-blog-detail (id &key draft-key)
(get-blog-detail id :query (list :draft-key draft-key)))
(defun clear-about-cache (new-draft-key)
(if new-draft-key
(clear-cache-partial-arguments *fetch-about-cache* `(:draft-key ,new-draft-key))
(clear-cache *fetch-about-cache*)))
(defun clear-works-cache (new-draft-key)
(if new-draft-key
(clear-cache-partial-arguments *fetch-works-cache* `(:draft-key ,new-draft-key))
(clear-cache *fetch-works-cache*)))
(defun clear-blog-cache (id old-draft-key new-draft-key)
(labels ((clear-detail-cache (id draft-key)
(clear-cache-partial-arguments *fetch-blog-detail-cache*
`(,id :draft-key ,draft-key))))
(unless new-draft-key
(clear-cache *fetch-blog-list-cache*)
(clear-detail-cache id old-draft-key))
(clear-detail-cache id new-draft-key)))

4
src/routes/about.lisp
View file

@ -3,7 +3,7 @@
#:hsx
#:jingle)
(:import-from #:website/lib/cms
#:get-about)
#:fetch-about)
(:import-from #:website/components/article
#:~article)
(:export #:handle-get))
@ -16,7 +16,7 @@
(setf (context :metadata) *metadata*)
(with-request-params ((draft-key "draft-key" nil)) params
(setf (context :no-cache) draft-key)
(let ((about (get-about :query (list :draft-key draft-key))))
(let ((about (fetch-about :draft-key draft-key)))
(~article
:title "About"
:content (getf about :content)

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

@ -7,13 +7,9 @@
(:import-from #:website/helper
#:get-request-body-plist)
(:import-from #:website/lib/cms
#:*get-about-cache*
#:*get-works-cache*
#:*get-blog-list-cache*
#:*get-blog-detail-cache*)
(:import-from #:website/lib/cache
#:clear-cache
#:clear-cache-partial-arguments)
#:clear-about-cache
#:clear-works-cache
#:clear-blog-cache)
(:export #:handle-post))
(in-package #:website/routes/api/revalidate)
@ -28,23 +24,11 @@
(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)))))
(cond ((string= api "about") (clear-about-cache new-draft-key))
((string= api "works") (clear-works-cache new-draft-key))
((string= api "blog") (clear-blog-cache id old-draft-key new-draft-key))
(t (set-response-status :bad-request)
(return-from handle-post '(:|message| "Unknown API"))))
(list :|api| api
:|id| id
:|old-draft-key| old-draft-key

4
src/routes/blog/<id>.lisp
View file

@ -3,7 +3,7 @@
#:hsx
#:jingle)
(:import-from #:website/lib/cms
#:get-blog-detail)
#:fetch-blog-detail)
(:import-from #:website/routes/not-found
#:handle-not-found)
(:import-from #:website/components/article
@ -15,7 +15,7 @@
(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))))
(let ((blog (fetch-blog-detail id :draft-key draft-key)))
(unless blog
(return-from handle-get (handle-not-found)))
(setf (context :metadata) (list :title (getf blog :title)

6
src/routes/blog/index.lisp
View file

@ -3,7 +3,7 @@
#:hsx
#:jingle)
(:import-from #:website/lib/cms
#:get-blog-list)
#:fetch-blog-list)
(:import-from #:website/lib/time
#:asctime)
(:export #:handle-get))
@ -15,9 +15,7 @@
(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)))
(let ((blogs (fetch-blog-list :page 1)))
(hsx
(section
(h1 :class "font-bold text-4xl mb-8"

4
src/routes/works.lisp
View file

@ -3,7 +3,7 @@
#:hsx
#:jingle)
(:import-from #:website/lib/cms
#:get-works)
#:fetch-works)
(:import-from #:website/components/article
#:~article)
(:export #:handle-get))
@ -16,7 +16,7 @@
(setf (context :metadata) *metadata*)
(with-request-params ((draft-key "draft-key" nil)) params
(setf (context :no-cache) draft-key)
(let ((works (get-works :query (list :draft-key draft-key))))
(let ((works (fetch-works :draft-key draft-key)))
(~article
:title "Works"
:content (getf works :content)