diff options
| -rw-r--r-- | jakob/builder/blog.scm | 6 | ||||
| -rw-r--r-- | jakob/utils/comments.scm | 108 |
2 files changed, 47 insertions, 67 deletions
diff --git a/jakob/builder/blog.scm b/jakob/builder/blog.scm index f38266b..dc903dd 100644 --- a/jakob/builder/blog.scm +++ b/jakob/builder/blog.scm @@ -105,10 +105,8 @@ (define (comments-section post) `(section (@ (class "comments-section") (aria-labelledby "comments-heading")) - (h3 (@ (id "comments-heading") - (class "module-title")) - ;; TODO: Need dynamiccount of comments - "Comments (2)") + ,@(render-comment-view (fetch-comments (post-identifier post)) + (fetch-webmentions (post-identifier post))) (div (@ (class "comment-form-module")) (h4 (@ (class "module-title")) "Leave a Comment") diff --git a/jakob/utils/comments.scm b/jakob/utils/comments.scm index 95b3f99..2779e67 100644 --- a/jakob/utils/comments.scm +++ b/jakob/utils/comments.scm @@ -65,7 +65,7 @@ (url webmention-url) (publish-time webmention-publish-time)) -(define (format-comment comment) +(define* (format-comment comment #:key (reply? #f)) "Format `comment', an alist, as SXML for a comment-type interaction" (define (strip uri) "Attempt to remove any sort of protocol specification from `uri'" @@ -81,7 +81,7 @@ ((and (internal-comment? comment) (internal-comment-email comment)) (gravatar-url (internal-comment-email comment))) - (else "/static/image/default-icon.png"))) + (else "/static/image/bonus/icons-24/user.png"))) (define (comment-name comment) ((if (webmention? comment) webmention-name @@ -111,61 +111,40 @@ (if (webmention? comment) '() (internal-comment-reactions comment))) - `(li (@ (class "p-comment h-cite comment comment-source-internal")) - ,(if (webmention? comment) - `(img (@ (class "comment-source-identifier") - (alt "Icon for comments posted externally and syndicated by Webmention") - (src "/static/image/webmention-logo.png"))) - (match (internal-comment-originating-network comment) - ("tor" `(img (@ (class "comment-source-identifier") - (alt "Icon for comments posted on jakob.space via Tor; -The Tor logo belongs to The Tor Project, Inc. and is licensed under the CC BY 3.0 US") - (src "/static/image/tor.svg")))) - ("i2p" `(img (@ (class "comment-source-identifier") - (alt "Icon for comments posted on jakob.space via I2P; -The I2P logo belongs to The I2P Project, and is licensed under the CC BY 4.0") - (src "/static/image/i2p.svg")))) - (_ `(img (@ (class "comment-source-identifier") - (alt "Icon for comments posted on jakob.space") - (src "/static/image/trident.svg")))))) - (div (@ (class "p-author h-card author")) - (img (@ (class "u-photo") (src ,(comment-photo comment))))) - (div (@ (class "metaline")) - (span (@ (class author-name)) ,(comment-name comment)) - ,@(if (and (comment-url comment) - (not (string= "" (comment-url comment)))) - `(" • " - (a (@ (class "author-url") - (href ,(comment-url comment))) - "(" ,(elide-string (strip (comment-url comment)) 32) ")")) - `()) - " • " - (time (@ (class "dt-published") - (datetime ,(comment-publish-time comment))) - ,(date->string (comment-publish-time comment) "~B ~e, ~Y at ~H:~M"))) - (div (@ (class "e-content p-name comment-content")) - ,@(comment-content comment)) - (ul (@ (class "comment-reactions")) - ,@(map (match-lambda - ((emote . count) - `(li ,(format #f "~a (~a)" emote count)))) - (comment-reactions comment))) - ,(when (internal-comment? comment) - `(p (@ (class "comment-additional-actions") - (hidden #t)) - (a (@ (class "comment-reply-button") - (href "#webmention-form") - (data-reply-to-id ,(internal-comment-id comment))) - "reply") - " - " - (a (@ (class "comment-react-button") - (href "#webmention-form") - (data-reply-to-id ,(internal-comment-id comment))) - "react"))) - ,(when (and (internal-comment? comment) - (positive? (length (internal-comment-replies comment)))) - `(ul (@ (class "webmention-container")) - ,@(map format-comment (internal-comment-replies comment)))))) + `(article (@ (class "comment-block")) + (header (@ (class "comment-meta")) + (img (@ (class "comment-avatar") + (src ,(comment-photo comment)) + (alt "User Icon"))) + (div (@ (class "comment-info")) + (strong ,(comment-name comment)) + ;; (span (@ (class "subject"))) + (br) + ,@(if (and (comment-url comment) + (not (string= "" (comment-url comment))) + (not (string= "http://" (comment-url comment))) + (not (string= "https://" (comment-url comment)))) + `((span (a (@ (href ,(comment-url comment))) + ,(comment-url comment)))) + '()) + (br) + (time (@ (class "date-stamp") + (datetime ,(date->string (comment-publish-time comment) "~Y-~m-~d"))) + ,(date->string (comment-publish-time comment) "~B ~e, ~Y at ~H:~M")))) + (div (@ (class "comment-body")) + ,@(comment-content comment)) + (footer (@ (class "comment-reactions")) + ,@(map (match-lambda + ((emote . count) + `(span (@ (class "reaction")) ,(format #f "~a ~a" emote count)))) + (comment-reactions comment))) + ,@(if (and (not reply?) + (internal-comment? comment) + (positive? (length (internal-comment-replies comment)))) + (map (lambda (comment) + (format-comment comment #:reply? #t)) + (internal-comment-replies comment)) + '()))) (define (wm-not-null? value) (and value @@ -236,12 +215,15 @@ The I2P logo belongs to The I2P Project, and is licensed under the CC BY 4.0") internal-comment-publish-time) x)) (define (date>? a b) (time>? (date->time-utc a) (date->time-utc b))) - (let ((webmentions - (map alist->webmention - (filter (lambda (x) (string= (assoc-ref x "wm-property") "in-reply-to")) - (vector->list (assoc-ref webmentions-response "children")))))) - (map format-comment (sort (append comments-response webmentions) - (lambda (a b) (date>? (publish-time a) (publish-time b))))))) + (let* ((webmentions + (map alist->webmention + (filter (lambda (x) (string= (assoc-ref x "wm-property") "in-reply-to")) + (vector->list (assoc-ref webmentions-response "children"))))) + (all-comments (sort (append comments-response webmentions) + (lambda (a b) (date>? (publish-time a) (publish-time b)))))) + `((h3 (@ (id "comments-heading") (class "module-title")) + ,(format #f "Comments (~a)" (length all-comments))) + ,(map format-comment all-comments)))) (define (fetch-comments slug) "Blocking call to webmention.io to retrieve a vector of all Webmentions for `slug'" |