summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--qkbox/toot.scm90
1 files changed, 90 insertions, 0 deletions
diff --git a/qkbox/toot.scm b/qkbox/toot.scm
index cb01b15..f021b1b 100644
--- a/qkbox/toot.scm
+++ b/qkbox/toot.scm
@@ -5,6 +5,11 @@
#:use-module (json builder)
#:use-module (json parser)
#:use-module (rnrs bytevectors)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 receive)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (pict)
#:export (post
timeline
favourite
@@ -72,6 +77,91 @@
'()))
#:authorization? #t))
+(define-record-type <status>
+ (make-status json)
+ status?
+ (json status-json))
+
+(define (status-id status)
+ (assoc-ref (status-json status) "id"))
+
+(define (status-avatar-static status)
+ (assoc-ref (assoc-ref (status-json status) "account")
+ "avatar_static"))
+
+(define (status-acct status)
+ (assoc-ref (assoc-ref (status-json status) "account")
+ "acct"))
+
+(define (status-reblog status)
+ (let ((reblog/json (assoc-ref (status-json status) "reblog")))
+ (if (eq? reblog/json 'null)
+ #f
+ (make-status reblog/json))))
+
+(define (status-content status)
+ (assoc-ref (status-json status) "content") )
+
+(define (status-spoiler-text status)
+ (let ((s (assoc-ref (status-json status) "spoiler_text")))
+ (if (zero? (string-length s))
+ #f
+ s)))
+
+(define (status-media-attachments status)
+ (let ((v (assoc-ref (status-json status) "media_attachments")))
+ (if (zero? (vector-length v))
+ #f
+ (vector->list v))))
+
+(define avatar-static-hash (make-hash-table))
+
+(define* (avatar-static->pict url)
+ (cond
+ ((hash-ref avatar-static-hash url) => identity)
+ (else
+ (receive (res body)
+ (http-get url)
+ (let ((tmp (tmpnam)))
+ (let ((in (open tmp (logior O_WRONLY O_CREAT O_EXCL))))
+ (put-bytevector in body)
+ (close in))
+ (let ((pict (and (zero? (system* "convert" "-resize" "32!x32!"
+ tmp
+ (string-append "png:" tmp)))
+ (pict-from-file tmp))))
+ (delete-file tmp)
+ (hash-set! avatar-static-hash url pict)
+ pict))))))
+
+(set-record-type-printer! <status>
+ (lambda (status port)
+ (cond
+ ((status-reblog status) =>
+ (lambda (reblog)
+ (format port "#<~s ~s BT: ~s>"
+ (avatar-static->pict (status-avatar-static status))
+ (status-id status)
+ reblog)))
+ (else
+ (format port
+ "#<~s ~s ~a ~a>"
+ (avatar-static->pict (status-avatar-static status))
+ (status-id status)
+ (status-acct status)
+ (cond
+ ((status-spoiler-text status) =>
+ (lambda (spoiler-text)
+ (format #f "CW: ~s" spoiler-text)))
+ ((status-media-attachments status) =>
+ (lambda (media-attachments)
+ (format #f "MEDIA(~a) ~s"
+ (length media-attachments)
+ (status-content status))))
+ (else
+ (format #f "~s"
+ (status-content status)))))))))
+
(define* (timeline #:key max-id since-id min-id limit local?)
(define-values (res body)
(/api/v1/timelines/home #:max-id max-id