Support for OGP and favicon

haunt.scm

@@ -32,59 +32,89 @@
 (define (post-slug/tojoqk post)
   (post-ref post 'id))
 
+(define* (post-url post #:optional prefix)
+  (string-append "/"
+                 (if prefix
+                     (string-append prefix "/")
+                     "")
+                 (post-slug/tojoqk post)
+                 ".html"))
+
 (define (theme/tojoqk)
   (theme
    #:layout
-   (lambda (site title sxml)
-     `((doctype "html")
-       (head
-        (meta (@ (charset "utf-8")))
-        (link (@ (rel "stylesheet") (href "/static/css/blog.css")))
-        (title
-         ,(string-append title " -- TojoQK")))
-       (body
-        (div (@ (class "world"))
-             (nav (@ (class "nav-bar"))
-                  (ul (@ (class "nav-list"))
-                      (li (@ (class "nav-logo"))
-                          (a (@ (href "/")) "TojoQK"))
-                      (li (@ (class "nav-item"))
-                          (a (@ (href "/about-me.html")) "About me"))
-                      (li (@ (class "nav-item"))
-                          (a (@ (href "/contact.html")) "Contact"))))
-             (article (@ (class "main"))
-                      ,sxml)))))
+   (lambda (site title obj)
+     (let ((og (car obj))
+           (sxml (cdr obj)))
+       `((doctype "html")
+         (head
+          (@ (lang "ja")
+             (prefix "og: http://ogp.me/ns#"))
+          (meta (@ (charset "utf-8")))
+          (link (@ (rel "stylesheet") (href "/static/css/blog.css")))
+          (link (@ (rel "icon") (type "image/png") (href "/static/image/QK-16x16.png") (sizes "16x16")))
+          (link (@ (rel "icon") (type "image/png") (href "/static/image/QK-32x32.png") (sizes "32x32")))
+          (link (@ (rel "icon") (type "image/png") (href "/static/image/QK-16x16.png") (sizes "16x16")))
+          (meta (@ (property "og:title") (content ,(assoc-ref og 'title))))
+          (meta (@ (property "og:type") (content ,(assoc-ref og 'type))))
+          (meta (@ (property "og:url") (content ,(assoc-ref og 'url))))
+          ,@(cond
+             ((assoc-ref og 'description)
+              => (lambda (description)
+                   (list
+                    `(meta (@ (property "og:description") (content ,description))))))
+             (else '()))
+          (meta (@ (property "og:site_name") (content  "TojoQK")))
+          (meta (@ (property "og:image")
+                   (content
+                    ,(or (assoc-ref og 'image) "/static/image/TojoQK.png"))))
+          (title
+           ,(string-append title " -- TojoQK")))
+         (body
+          (div (@ (class "world"))
+               (nav (@ (class "nav-bar"))
+                    (ul (@ (class "nav-list"))
+                        (li (@ (class "nav-logo"))
+                            (a (@ (href "/")) "TojoQK"))
+                        (li (@ (class "nav-item"))
+                            (a (@ (href "/about-me.html")) "About me"))
+                        (li (@ (class "nav-item"))
+                            (a (@ (href "/contact.html")) "Contact"))))
+               (article (@ (class "main"))
+                        ,sxml))))))
    #:collection-template
    (lambda (site title posts prefix)
-     (define (post-url post)
-       (string-append "/"
-                      (if prefix
-                          (string-append prefix "/")
-                          "")
-                      (post-slug/tojoqk post)
-                      ".html"))
-     `((h1 "最近の投稿")
-       (ul (@ (class "post-list"))
-           ,@(map (lambda (post)
-                    (let ((url (post-url post)))
-                      `(li (a (@ (href ,url))
-                              ,(string-append (post-ref post 'title)
-                                              " -- "
-                                              (date->string/tojoqk (post-date post)))))))
-                  posts))))
+     (cons
+      `((title . ,title)
+        (type . "website")
+        (url . "/"))
+      `((h1 "最近の投稿")
+        (ul (@ (class "post-list"))
+            ,@(map (lambda (post)
+                     (let ((url (post-url post)))
+                       `(li (a (@ (href ,url))
+                               ,(string-append (post-ref post 'title)
+                                               " -- "
+                                               (date->string/tojoqk (post-date post)))))))
+                   posts)))))
    #:post-template
    (lambda (post)
-     `((div (h1 (@ (class "post-title"))
-                (a (@ (href "")) ,(post-ref post 'title)))
-            (div (@ (class "post-date"))
-                 ,(date->string/tojoqk (post-date post)) "に投稿しました。"
-                 ,(cond
-                   ((post-ref post 'updated)
-                    => (lambda (updated)
-                         `("最終更新日時は" ,(date->string/tojoqk updated) "です。")))
-                   (else ""))))
-       (div ,(post-sxml post))
-       (a (@ (href "/")) "投稿の一覧")))))
+     (cons
+      `((title . ,(post-ref post 'title))
+        (type . "article")
+        (url . ,(post-url post))
+        (description . ,(post-ref post 'description)))
+      `((div (h1 (@ (class "post-title"))
+                 (a (@ (href "")) ,(post-ref post 'title)))
+             (div (@ (class "post-date"))
+                  ,(date->string/tojoqk (post-date post)) "に投稿しました。"
+                  ,(cond
+                    ((post-ref post 'updated)
+                     => (lambda (updated)
+                          `("最終更新日時は" ,(date->string/tojoqk updated) "です。")))
+                    (else ""))))
+        (div ,(post-sxml post))
+        (a (@ (href "/")) "投稿の一覧"))))))
 
 (define (blog/tojoqk)
   (blog #:theme (theme/tojoqk)

posts/hello-world.sxml

@@ -3,6 +3,7 @@
 `((title . "こんにちは、世界!")
   (id . "hello-world")
   (date . ,(string->date* "2020-02-18 09:00"))
+  (description . "Webサイト「TojoQK」への最初の投稿です。")
   (content
    (h2 "はじめまして")
    (p "ブログを始めてみました。有益なことを書く予定はありません。")