1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
;;; 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 webmention)
#: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)
#:use-module (oop goops)
#:export (render-comment-view
fetch-webmentions))
(define (format-comment webmention)
"Format `webmention', 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 (assoc-ref webmention "author"))
(author-name (assoc-ref author "name"))
(author-photo (assoc-ref author "photo"))
(author-url (assoc-ref author "url"))
(content (assoc-ref webmention "content"))
(content-text (assoc-ref content "text"))
(published-time (assoc-ref webmention "published"))
(received-time (assoc-ref webmention "wm-received"))
(url (assoc-ref webmention "url"))
(time (if (eqv? 'null published-time) received-time published-time)))
`(li (@ (class "p-comment h-cite comment comment-source-webmention"))
(img (@ (class "comment-source-identifier")
(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")))))
(a (@ (class "p-name u-url")
(href ,author-url))
,author-name)
(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 ,url))
(time (@ (class "dt-published")
(datetime ,time))
,(date->string
(string->date time "~Y~m~d~H~M~S")
"~B ~e, ~Y at ~H:~M")))))))
(define (format-interaction webmention)
"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-photo (assoc-ref author "photo"))
(author-url (assoc-ref author "url")))
`(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"))))))
(div (@ (class "e-content p-name comment-content"))
(em
,(match (assoc-ref webmention "wm-property")
("repost-of" "Reposted this!")
("like-of" "Favorited this!")
(_ "[No Text Provided]"))))
(img (@ (class "comment-source-identifier")
(alt "Webmention logo")
(src "/static/image/webmention-logo.png"))))))
(define (render-comment-view response)
"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")))
(format-comment x)
(format-interaction x)))
(assoc-ref response "children"))))
(define (fetch-webmentions slug)
"Blocking call to webmention.io to retrieve a vector of all Webmentions for `slug'"
(define prefixes '("http://jakob.space/" "https://jakob.space/"
"http://jakob.space/blog/" "https://jakob.space/blog/"))
(let* ((target-queries (map (lambda (pre)
(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 "&"))))
(receive (response-status response-body)
(http-request url)
(call-with-input-string (bytevector->string response-body "UTF-8") json->scm))))
|
