diff options
| -rw-r--r-- | dynamic/capabilities/comments.scm | 13 | ||||
| -rw-r--r-- | haunt/jakob/builder/blog.scm | 3 | ||||
| -rw-r--r-- | haunt/jakob/utils/comments.scm | 98 | ||||
| -rw-r--r-- | haunt/static/css/style.css | 22 |
4 files changed, 127 insertions, 9 deletions
diff --git a/dynamic/capabilities/comments.scm b/dynamic/capabilities/comments.scm index fb965c9..945e382 100644 --- a/dynamic/capabilities/comments.scm +++ b/dynamic/capabilities/comments.scm @@ -35,16 +35,19 @@ This interface exists for dynamically generating the comment view from Haunt." (define (format-comment comment) (match comment - ((id name subject email comment reactions) + ((id name subject email comment url reactions) `((id . ,id) (name . ,name) (subject . ,subject) (email . ,email) (comment . ,comment) - (reactions . ,(with-input-from-string reactions read)))))) - (let* ((query "SELECT id, name, subject, email, comment, reactions + (url . ,url) + (reactions . ,(if reactions + (with-input-from-string reactions read) + '())))))) + (let* ((query "SELECT id, name, subject, email, comment, url, reactions FROM comments WHERE slug = $1 and approved IS NOT NULL") - (result (exec-query conn query (list (car slug))))) + (result (exec-query conn query (list slug)))) (map format-comment result))) (define (get-comments request body) @@ -60,7 +63,7 @@ This is a wrapper around `get-comments-by-slug'." (values '((content-type . (application/json))) (scm->json-string (list->vector - (get-comments-by-slug slug)))) + (get-comments-by-slug (car slug))))) (values (build-response #:code 400) (scm->json-string `((success . #f) diff --git a/haunt/jakob/builder/blog.scm b/haunt/jakob/builder/blog.scm index c9b01c8..76782dc 100644 --- a/haunt/jakob/builder/blog.scm +++ b/haunt/jakob/builder/blog.scm @@ -27,6 +27,7 @@ #:use-module (jakob utils sxml) #:use-module (jakob utils tags) #:use-module (jakob utils webmention) + #:use-module (jakob utils comments) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) @@ -85,7 +86,7 @@ (h2 ,(hyperlink "https://indieweb.org/Webmention" "Webmentions") " for this Page") (ul (@ (id "webmention-container")) - ,@(render-comment-view (fetch-webmentions (post-identifier post)))) + ,@(render-comment-view (fetch-comments (post-identifier post)))) (form (@ (action "https://webmention.io/jakob.space/webmention") (method "post")) diff --git a/haunt/jakob/utils/comments.scm b/haunt/jakob/utils/comments.scm new file mode 100644 index 0000000..a1deea7 --- /dev/null +++ b/haunt/jakob/utils/comments.scm @@ -0,0 +1,98 @@ +;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (jakob utils comments) + ;; #:use-module (dynamic capabilities comments) + #:use-module (dynamic util) + #:use-module (hashing md5) + #:use-module (ice-9 receive) + #:use-module (ice-9 iconv) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-43) + #:use-module (json) + #:use-module (web client) + #:use-module (web response) + #:export (render-comment-view fetch-comments)) + +(define (gravatar-url email) + (format #f "https://www.gravatar.com/avatar/~a" (md5->string (md5 (string->bytevector (string-trim-both (string-downcase email)) "utf8"))))) +;; (chain email +;; (string-downcase _) +;; (string-trim-both _) +;; (string->bytevector _ "utf8") +;; (md5 _)) + +(define (format-comment comment) + "Format `comment', an alist, as SXML for a comment-type interaction" + (define (strip uri) + "Attempt to remove any sort of protocol specification from `uri'" + (let* ((needle "://") + (index (string-contains uri needle))) + (if index + (strip (substring uri (+ index (string-length needle)))) + uri))) + (let* ((author-name (assoc-ref comment 'name)) + (author-url (assoc-ref comment 'url)) + (author-photo (gravatar-url (assoc-ref comment 'email))) + (publish-datetime (assoc-ref comment 'published)) + (content-text (assoc-ref comment 'comment)) + (content-reactions (assoc-ref comment 'reactions))) + `(li (@ (class "p-comment h-cite comment comment-source-internal")) + (img (@ (class "comment-source-identifier") + (alt "Icon for comments posted on jakob.space") + (src "/static/image/lambda.svg"))) + (div (@ (class "p-author h-card author")) + (img (@ (class "u-photo") (src ,author-photo))) + (span (@ (class author-name)) ,author-name) + ,@(if author-url + `((a (@ (class "author-url") + (href ,author-url)) + "(" ,(strip author-url) ")")) + `())) + (div (@ (class "e-content p-name comment-content")) + ,content-text) + (div (@ (class "metaline")) + (a (@ (class "u-url") + (href ,author-url)) + (time (@ (class "dt-published") + (datetime ,publish-datetime)) + ,(date->string + (string->date publish-datetime "~Y~m~d~H~M~S") + "~B ~e, ~Y at ~H:~M")))) + (ul (@ (class "comment-reactions")) + ,@(map (match-lambda + ((emote . count) + `(li ,(format "~a (~a)" emote count)))) + content-reactions))))) + +(define (render-comment-view response) + "Render `response', the output of `fetch-webmentions', as SXML" + (map format-comment response)) + +(define (fetch-comments slug) + "Blocking call to webmention.io to retrieve a vector of all Webmentions for `slug'" + (get-comments-by-slug slug) + ;; (list '((id . 1) + ;; (published . "20220514122120") + ;; (name . "Jakob") + ;; (subject . "Test") + ;; (email . "jakob@memeware.net") + ;; (comment . "Test") + ;; (url . "jakob.space") + ;; (reactions . (("🎖️" . 2))))) + ) +;; dynamic diff --git a/haunt/static/css/style.css b/haunt/static/css/style.css index 4b682d2..0b32082 100644 --- a/haunt/static/css/style.css +++ b/haunt/static/css/style.css @@ -159,7 +159,11 @@ figure > figcaption { display: inline; } -/* Webmention. */ +/* Comments & Webmention. */ + +.author-name { + padding-right: 8px; +} #webmention { border-top: 2px solid #d2d6dd; @@ -202,13 +206,25 @@ ul#webmention-container div.p-author * { padding-right: 1rem; } +ul#webmention-container ul.comment-reactions { + margin-top: 8px; +} + +ul#webmention-container ul.comment-reactions li { + border-radius: 4px; + border: 1px solid #d2d6dd; + display: inline; + list-style-type: none; + padding: 4px; +} + /* Webmention (or comment) source indicator. */ -ul#webmention-container .comment-source-webmention { +ul#webmention-container .comment { position: relative; } -ul#webmention-container .comment-source-webmention .comment-source-identifier { +ul#webmention-container .comment .comment-source-identifier { position: absolute; top: 0; right: 0; |