Refactor cache control

src/lib/cache.lisp

@@ -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)))))

src/lib/cms.lisp

@@ -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
+  (:export #:fetch-about
-                #:memorize)
+           #:fetch-works
-  (:export #:get-about
+           #:fetch-blog-list
-           #:*get-about-cache*
+           #:fetch-blog-detail
-           #:get-works
+           #:clear-about-cache
-           #:*get-works-cache*
+           #:clear-works-cache
-           #:get-blog-list
+           #:clear-blog-list-cache
-           #:*get-blog-list-cache*
+           #:clear-blog-detail-cache))
-           #:get-blog-detail
-           #:*get-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)))
+

src/routes/about.lisp

@@ -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)

src/routes/api/revalidate.lisp

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

src/routes/blog/<id>.lisp

@@ -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)

src/routes/blog/index.lisp

@@ -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"
+  (let ((blogs (fetch-blog-list :page 1)))
-                                             :limit 100))
-                     :contents)))
     (hsx
      (section
        (h1 :class "font-bold text-4xl mb-8"

src/routes/works.lisp

@@ -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)