From b30041c077d05e4d2916e081ed2dae5d206b0ab8 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Thu, 9 Jul 2020 04:58:07 +0900
Subject: guix: toot: Add <status> record.

---
 qkbox/toot.scm | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)

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
-- 
cgit v1.2.3