diff options
| -rw-r--r-- | haunt/jakob/builder/blog.scm | 12 | ||||
| -rw-r--r-- | haunt/jakob/utils/webmention.scm | 43 |
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)))) |