Address correctness issues

2 files changed, 38 insertions, 17 deletions

diff --git a/haunt/jakob/builder/blog.scm b/haunt/jakob/builder/blog.scm
index 6cabd16..c9b01c8 100644
--- a/haunt/jakob/builder/blog.scm
+++ b/haunt/jakob/builder/blog.scm
@@ -85,7 +85,7 @@
       (h2 ,(hyperlink "https://indieweb.org/Webmention" "Webmentions")
           " for this Page")
       (ul (@ (id "webmention-container"))
-          ,@(render-comment-view (fetch-webmentions (post-slug post))))
+          ,@(render-comment-view (fetch-webmentions (post-identifier post))))
       (form
        (@ (action "https://webmention.io/jakob.space/webmention")
           (method "post"))
@@ -127,13 +127,17 @@
 ;; Subdirectory for permalink pages.
 (define %prefix "/blog")
 
-(define (post-uri post)
-  "Return the path of POST relative to the site's root."
+(define (post-identifier post)
+  "Return the 'slug' that identifies POST."
   (let* ((file-name (post-file-name post))
          (splice-start (1+ (string-rindex file-name (cut char=? <> #\/))))
          (splice-end (string-rindex file-name (cut char=? <> #\.)))
          (slug (substring file-name splice-start splice-end)))
-    (string-append %prefix "/" slug ".html")))
+    slug))
+
+(define (post-uri post)
+  "Return the path of POST relative to the site's root."
+  (string-append %prefix "/" (post-identifier post) ".html"))
 
 (define (post->page post)
   "Return a Haunt page for POST."
diff --git a/haunt/jakob/utils/webmention.scm b/haunt/jakob/utils/webmention.scm
index f30bb12..713ce39 100644
--- a/haunt/jakob/utils/webmention.scm
+++ b/haunt/jakob/utils/webmention.scm
@@ -27,6 +27,11 @@
   #:export (render-comment-view
             fetch-webmentions))
 
+(define (wm-not-null? value)
+  (and value
+       (not (eqv? 'null value))
+       (not (string= "" value))))
+
 (define (format-comment webmention)
   "Format `webmention', an alist, as SXML for a comment-type interaction"
   (define (strip uri)
@@ -38,8 +43,16 @@
           uri)))
   (let* ((author (assoc-ref webmention "author"))
          (author-name (assoc-ref author "name"))
-         (author-photo (assoc-ref author "photo"))
          (author-url (assoc-ref author "url"))
+         (author-url
+          (if (wm-not-null? author-url)
+              author-url
+              (assoc-ref webmention "wm-source")))
+         (author-photo (assoc-ref author "photo"))
+         (author-photo
+          (cond ((string-prefix? "https://lobste.rs/" author-url) "/static/image/lobsters.png")
+                ((wm-not-null? author-photo) author-photo)
+                (else "/static/image/default-icon.png")))
          (content (assoc-ref webmention "content"))
          (content-text (assoc-ref content "text"))
          (published-time (assoc-ref webmention "published"))
@@ -51,10 +64,7 @@
                  (alt "Webmention logo")
                  (src "/static/image/webmention-logo.png")))
          (div (@ (class "p-author h-card author"))
-              (img (@ (class "u-photo")
-                      (src ,(if (string-prefix? author-url "https://lobste.rs/")
-                                "/static/image/lobsters.png"
-                                (or author-photo "/static/image/default-icon.png")))))
+              (img (@ (class "u-photo") (src ,author-photo)))
               (a (@ (class "p-name u-url")
                     (href ,author-url))
                  ,author-name)
@@ -76,19 +86,26 @@
   "Format `webmention', an alist, as SXML for a rich interaction without content"
   (let* ((author (assoc-ref webmention "author"))
          (author-name (assoc-ref author "name"))
+         (author-url (assoc-ref author "url"))
+         (author-url
+          (if (wm-not-null? author-url)
+              author-url
+              (assoc-ref webmention "wm-source")))
          (author-photo (assoc-ref author "photo"))
-         (author-url (assoc-ref author "url")))
+         (author-photo
+          (cond ((string-prefix? "https://lobste.rs/" author-url) "/static/image/lobsters.png")
+                ((wm-not-null? author-photo) author-photo)
+                (else "/static/image/default-icon.png"))))
     `(li (@ (class "p-comment h-cite interaction comment-source-webmention"))
          (a (@ (href ,author-url))
-            (img (@ (class "u-photo")
-                    (src ,(if (string-prefix? author-url "https://lobste.rs/")
-                              "/static/image/lobsters.png"
-                              (or author-photo "/static/image/default-icon.png"))))))
+            (img (@ (class "u-photo") (src ,author-photo))))
          (div (@ (class "e-content p-name comment-content"))
               (em
                ,(match (assoc-ref webmention "wm-property")
                   ("repost-of" "Reposted this!")
                   ("like-of" "Favorited this!")
+                  ("bookmark-of" "Bookmarked this!")
+                  ("mention-of" "Mentioned this!")
                   (_ "[No Text Provided]"))))
          (img (@ (class "comment-source-identifier")
                  (alt "Webmention logo")
@@ -98,8 +115,8 @@
   "Render `response', the output of `fetch-webmentions', as SXML"
   (vector->list
    (vector-map (lambda (_ x)
-                 (if (and (assoc-ref x "wm-property")
-                          (member (assoc-ref x "wm-property") '("in-reply-to" "mention-of")))
+                 (if (and (assoc-ref x "content")
+                          (not (string= (assoc-ref x "wm-property") "repost-of")))
                      (format-comment x)
                      (format-interaction x)))
                (assoc-ref response "children"))))
@@ -112,7 +129,7 @@
                              (format #f "target[]=~a~a.html" pre slug))
                            prefixes))
          (url (format #f "https://webmention.io/api/mentions.jf2?per-page=200&page=0&~a"
-                     (string-join targets-queries "&"))))
+                     (string-join target-queries "&"))))
     (receive (response-status response-body)
         (http-request url)
       (call-with-input-string (bytevector->string response-body "UTF-8") json->scm))))