Implement Webmention outbox

2 files changed, 54 insertions, 0 deletions

diff --git a/haunt/haunt.scm b/haunt/haunt.scm
index 3f48a98..73c94f2 100644
--- a/haunt/haunt.scm
+++ b/haunt/haunt.scm
@@ -128,6 +128,7 @@
                        (sort-by-tag)
                        (static-page "About Me" "about")
                        (static-page "Projects" "projects")
+                       (static-page "Webmention Outbox" "outbox")
                        (static-page "JavaScript Web Labels" "weblabels")
                        (static-directory "css")
                        (static-directory "fonts")
diff --git a/haunt/outbox.scm b/haunt/outbox.scm
new file mode 100644
index 0000000..65be024
--- /dev/null
+++ b/haunt/outbox.scm
@@ -0,0 +1,53 @@
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.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/>.
+
+(use-modules (srfi srfi-19))
+
+(define %comments
+  `(("https://aaronparecki.com/2018/06/30/11/your-first-webmention"
+     "@aaronpk"
+     "<2019-05-11 Sat 17:07>"
+     (p (@ (class "e-content"))
+        "Hoo, this comments section is a bit of a mess. "
+        "Anyway, I'm just testing out Webmentions like everyone else. "
+        "Don't mind me...")
+     )))
+
+(define (h-card)
+  `(div (@ (class "u-author h-card"))
+        (img (@ (src "/images/favicon.png")
+                (class "u-photo")))
+        (a (@ (href "http://jakob.space")
+              (class "u-url p-name"))
+           (p "Jakob L. Kreuze"))))
+
+(define (comment target-uri target-handle date sxml)
+  (let ((date (string->date date "<~Y-~m-~d ~a ~H:~M>")))
+    `(li (@ (class "h-entry"))
+         ,(h-card)
+         (p "in reply to: " (a (@ (class "u-in-reply-to")
+                                  (href ,target-uri))
+                               ,target-handle))
+         ,sxml
+         (a (@ (href "http://jakob.space/outbox.html")
+               (class "u-url"))
+            (time (@ (class "dt-published")
+                     (datetime ,(date->string date "~Y-~m-~dT~H:~M:~S~z")))
+                  ,(date->string date "~c"))))))
+
+`((h2 "Webmention Outbox")
+  (ul (@ (id "webmention-container"))
+      ,@(map (lambda (args) (apply comment args)) %comments)))