From e34974ee4fb88e6832161874d29b373db2153c38 Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.org>
Date: Sun, 27 Aug 2023 19:39:07 -0400
Subject: [comments] Elide long poster URLs

---
 haunt/jakob/utils.scm          | 13 ++++++++++++-
 haunt/jakob/utils/comments.scm | 11 +++++++----
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/haunt/jakob/utils.scm b/haunt/jakob/utils.scm
index a41d21a..a104510 100644
--- a/haunt/jakob/utils.scm
+++ b/haunt/jakob/utils.scm
@@ -24,7 +24,9 @@
             date->string*
             intersperse
             first-paragraph
-            description-from-post))
+            description-from-post
+
+            elide-string))
 
 (define (maybe-list . args)
   "Create a list of all ARGS that are neither #f nor unspecified."
@@ -93,3 +95,12 @@ is of an odd length and every second element is DELIM."
   (let* ((sxml (first-paragraph post))
          (extracted (collect-strings (first-elem sxml) (list))))
     (string-join (map string-trim-both (reverse extracted)) " ")))
+
+(define (elide-string s len)
+  "Return S elided to be at most LEN characters"
+  (when (< len 3) (error "LEN cannot be smaller than 3"))
+  (if (<= (string-length s) len)
+      s
+      (string-append (string-take s (floor/ (- len 3) 2))
+                     "..."
+                     (string-take-right s (ceiling/ (- len 3) 2)))))
diff --git a/haunt/jakob/utils/comments.scm b/haunt/jakob/utils/comments.scm
index 0d65e8d..4ec3718 100644
--- a/haunt/jakob/utils/comments.scm
+++ b/haunt/jakob/utils/comments.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 receive)
   #:use-module (jakob dynamic capabilities common)
   #:use-module (jakob dynamic util)
+  #:use-module (jakob utils)
   #:use-module (json)
   #:use-module (oop goops)
   #:use-module (srfi srfi-9)
@@ -92,10 +93,12 @@
         (safe-markdown->sxml
          (internal-comment-comment comment))))
   (define (comment-url comment)
-    ((if (webmention? comment)
-         webmention-url
-         internal-comment-url)
-     comment))
+    (define text
+      ((if (webmention? comment)
+           webmention-url
+           internal-comment-url)
+       comment))
+    (elide-string text 32))
   (define (comment-publish-time comment)
     ((if (webmention? comment)
          webmention-publish-time
-- 
cgit v1.3