Add blog page

src/components/article.lisp

@@ -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: "
+         (and published-at
-         (|time| :datetime (datetime revised-at)
+              (hsx
-                 (asctime revised-at))
+               (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))
+                   ")")))))))))

src/lib/cache.lisp

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

src/lib/cms.lisp

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

src/routes/api/revalidate.lisp

@@ -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-about-cache*
-                #:get-works)
+                #:*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|)))
+         (api (getf body :|api|))
-    (cond ((string= api "about") (clear-cache 'get-about))
+         (id (getf body :|id|))
-          ((string= api "works") (clear-cache 'get-works)))
+         (old-draft-key (accesses body :|contents| :|old| :|draftKey|))
-    '(:|message| "ok")))
+         (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")))

src/routes/blog.lisp

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

src/routes/blog/<id>.lisp

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

src/routes/blog/index.lisp

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

src/routes/not-found.lisp

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