blob: 2bca1a275559a8c3705da2b197157d75343c2ca9 (
plain)
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
|
;;; Copyright © 2019 - 2023 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 dynamic capabilities common)
#:use-module (jakob dynamic util)
#:use-module (json)
#:use-module (srfi srfi-19)
#:export (json->internal-comment
internal-comment->json
make-internal-comment
internal-comment?
internal-comment-id
internal-comment-name
internal-comment-subject
internal-comment-email
internal-comment-comment
internal-comment-url
internal-comment-publish-time
internal-comment-reactions
internal-comment-replies
internal-comment-originating-network
sort-comments))
(define-json-mapping <internal-comment>
make-internal-comment
internal-comment?
json->internal-comment <=> internal-comment->json
(id internal-comment-id)
(name internal-comment-name)
(subject internal-comment-subject)
(email internal-comment-email)
(comment internal-comment-comment)
(url internal-comment-url)
(publish-time
internal-comment-publish-time
"publish-time"
(lambda (x) (string->date x "~Y~m~d ~H~M~S.~N"))
(lambda (x) (date->string x "~Y-~m-~d ~H:~M:~S.~N")))
(reactions internal-comment-reactions)
(replies
internal-comment-replies
"replies"
(lambda (x) (map (lambda (comment)
(call-with-input-string (scm->json-string comment) json->internal-comment))
(vector->list x)))
(lambda (x) (list->vector (map (lambda (y)
(json-string->scm (internal-comment->json y)))
x))))
(originating-network internal-comment-originating-network))
(define (sort-comments comments)
"Sort COMMENTS, a list of `<internal-comment>' chronologically"
(sort comments (lambda (c1 c2)
(date<? (internal-comment-publish-time c1)
(internal-comment-publish-time c2)))))
|
