diff options
| -rw-r--r-- | qkbox/toot.scm | 90 |
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 |