From 0c9f642ddd3c7a5bc77f88a88a6a0f5ebc43a6af Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Mon, 13 Jul 2020 02:45:58 +0900 Subject: qkbox: toot: Add notification record. --- qkbox/toot.scm | 40 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) diff --git a/qkbox/toot.scm b/qkbox/toot.scm index a917bef..8241794 100644 --- a/qkbox/toot.scm +++ b/qkbox/toot.scm @@ -29,6 +29,7 @@ #:use-module (ice-9 optargs) #:use-module (srfi srfi-9) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-9 gnu) #:use-module (pict) #:use-module ((htmlprag) @@ -36,7 +37,8 @@ #:use-module ((sxml fold) #:select (foldt)) #:use-module ((sxml xpath) - #:select (sxpath))) + #:select (sxpath)) + #:use-module (rnrs io ports)) (define-syntax-rule (and/nil test expr) (if test @@ -49,6 +51,9 @@ (define current-mastodon-access-token (make-parameter (getenv "MASTODON_ACCESS_TOKEN"))) +(define (created-at-string->date str) + (string->date str "~Y-~m-~dT~H:~M~S.~NZ")) + (define*-public (post text #:key spoiler-text @@ -120,6 +125,35 @@ (account-id account) (account-acct account)))) +(define-record-type + (make-notification json) + notification? + (json notification-json)) + +(define (notification-id notification) + (assoc-ref (notification-json notification) + "id")) + +(define (notification-status notification) + (make-status + (assoc-ref (notification-json notification) + "status"))) + +(define (notification-account notification) + (make-account + (assoc-ref (notification-json notification) + "account"))) + +(define (notification-type notification) + (string->symbol + (assoc-ref (notification-json notification) + "type"))) + +(define (notification-creation-time notification) + (created-at-string->date + (assoc-ref (notification-json notification) + "created_at"))) + (define-public (status-public? status) (eq? 'public (status-visibility status))) @@ -311,6 +345,10 @@ #f id))) +(define (status-creation-time status) + (created-at-string->date (assoc-ref (status-json status) + "created_at"))) + (define (emoji-static-url emoji) (assoc-ref (emoji-json emoji) "static_url")) -- cgit v1.2.3