summaryrefslogtreecommitdiff
path: root/haunt/jakob/dynamic/capabilities/comments.scm
diff options
context:
space:
mode:
Diffstat (limited to 'haunt/jakob/dynamic/capabilities/comments.scm')
-rw-r--r--haunt/jakob/dynamic/capabilities/comments.scm30
1 files changed, 20 insertions, 10 deletions
diff --git a/haunt/jakob/dynamic/capabilities/comments.scm b/haunt/jakob/dynamic/capabilities/comments.scm
index 044852b..ee4172c 100644
--- a/haunt/jakob/dynamic/capabilities/comments.scm
+++ b/haunt/jakob/dynamic/capabilities/comments.scm
@@ -29,6 +29,7 @@
#:use-module (web uri)
#:export (get-comments
get-comments-by-slug
+
put-comment
put-reaction
@@ -44,15 +45,22 @@
(define conn (connect-to-postgres-paramstring "dbname=jakob_comments"))
-(define-json-type <internal-comment>
- (id)
- (name)
- (subject)
- (email)
- (comment)
- (url)
- (publish-time)
- (reactions))
+(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))
(define (get-comments-by-slug slug)
"Internal function for querying the approved comments on a post
@@ -76,6 +84,8 @@ This interface exists for dynamically generating the comment view from Haunt."
"API endpoint handler for querying for the comments on a particular post
This is a wrapper around `get-comments-by-slug'."
+ (define (normalize-record record)
+ (json-string->scm (internal-comment->json record)))
(let* ((query-string (uri-query (request-uri request)))
(params (if query-string
(decode-form query-string)
@@ -85,7 +95,7 @@ This is a wrapper around `get-comments-by-slug'."
(values '((content-type . (application/json)))
(scm->json-string
(list->vector
- (get-comments-by-slug (car slug)))))))
+ (map normalize-record (get-comments-by-slug (car slug))))))))