From 81db0eb7de821aadbfe5392a02a6b1b3468aafdd Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Fri, 17 Jul 2020 08:36:07 +0900 Subject: toot: Split into modules. --- toot.scm | 233 +++++---------------------------------------------------------- 1 file changed, 17 insertions(+), 216 deletions(-) (limited to 'toot.scm') diff --git a/toot.scm b/toot.scm index 663b00e..1e709c7 100644 --- a/toot.scm +++ b/toot.scm @@ -17,6 +17,13 @@ ;;; along with Toot. If not, see . (define-module (toot) + #:use-module (toot utils) + #:use-module (toot statuses) + #:use-module (toot accounts) + #:use-module (toot notifications) + #:use-module (toot emojis) + #:use-module (toot attachments) + #:use-module (toot config) #:use-module (ice-9 format) #:use-module (web response) #:use-module (web client) @@ -60,51 +67,10 @@ ;; streaming streaming-user streaming-public - - ;; status - status? - status-id - status-emojis - status-reblog - status-account - status-content - status-public? - status-sensitive? - status-visibility - status-spoiler-text - status-creation-time - status-in-reply-to-id - status-in-reply-to-account-id - display-status - ;; notification - notification? - notification-id - notification-type - notification-status - notification-account - notification-creation-time - display-notification - - ;; emoji - emoji? - emoji-shortcode - emoji-static-url - emoji-visible-in-picker? - - ;; account - account? - account-id - account-acct - account-emojis - account-display-name - account-avatar-static - )) - -(define-syntax-rule (and/nil test expr) - (if test - expr - '())) + ;; display + display-status + display-notification)) (define mastodon-host (make-parameter (getenv "MASTODON_HOST"))) @@ -115,14 +81,6 @@ (define display-image? (make-parameter #f)) -(define (created-at-string->date str) - (time-utc->date - (date->time-utc - (string->date str "~Y-~m-~dT~H:~M:~S.~N~z")))) - -(define (creation-time->string date) - (date->string date "~4")) - (define* (post text #:key spoiler-text @@ -172,57 +130,6 @@ `((media_ids . ,(list->vector (map number->string media-ids)))))) #:authorization? #t)) -(define-record-type - (make-status json) - status? - (json status-json)) - -(set-record-type-printer! - (lambda (status port) - (format port - "#" - (status-id status)))) - -(define-record-type - (make-account json) - account? - (json account-json)) - -(set-record-type-printer! - (lambda (account port) - (format port "#" - (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* (display-notification notification #:key (port (current-output-port))) (let ((account (notification-account notification)) (status (notification-status notification)) @@ -237,9 +144,6 @@ (creation-time->string time)) (display-status (notification-status notification)))) -(define (status-public? status) - (eq? 'public (status-visibility status))) - (define (account-to-string account) (format #f "~{~a~} <~a> (account-id: ~s)" (insert-emoji-picts (account-emojis account) @@ -318,24 +222,6 @@ (scale status-pict 0.5))))) (else status-pict)))) -(define (status-id status) - (assoc-ref (status-json status) "id")) - -(define (status-account status) - (make-account (assoc-ref (status-json status) "account"))) - -(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-sensitive? status) - (assoc-ref (status-json status) "sensitive")) - -(define (status-content status) - (assoc-ref (status-json status) "content")) - (define (sanitize x) (string-delete (char-set #\x202d #\x202e) x)) @@ -373,43 +259,6 @@ (append-map flatten x)) (else (list x)))) -(define (status-visibility status) - (string->symbol (assoc-ref (status-json status) "visibility"))) - -(define (status-spoiler-text status) - (let ((s (assoc-ref (status-json status) "spoiler_text"))) - (if (zero? (string-length s)) - #f - s))) - -(define-record-type - (make-emoji json) - emoji? - (json emoji-json)) - -(define (emojis->regexp emojis) - (string-append ":(" - (string-join (map (compose regexp-quote emoji-shortcode) emojis) - "|") - "):")) - -(define (status-emojis status) - (map make-emoji (vector->list (assoc-ref (status-json status) "emojis")))) - -(define-record-type - (make-attachment json) - attachment? - (json attachment-json)) - -(define (attachment-type attachment) - (string->symbol (assoc-ref (attachment-json attachment) "type"))) - -(define (attachment-preview-url attachment) - (assoc-ref (attachment-json attachment) "preview_url")) - -(define (attachment-url attachment) - (assoc-ref (attachment-json attachment) "url")) - (define (fetch-attachment-preview-pict attachment) (fetch-pict (attachment-preview-url attachment) #:height> 128)) @@ -417,35 +266,6 @@ (define (fetch-attachment-pict attachment) (fetch-pict (attachment-url attachment))) -(define (status-media-attachments status) - (let ((v (assoc-ref (status-json status) "media_attachments"))) - (map make-attachment (vector->list v)))) - -(define (status-in-reply-to-id status) - (let ((id (assoc-ref (status-json status) "in_reply_to_id"))) - (if (eq? 'null id) - #f - id))) - -(define (status-in-reply-to-account-id status) - (let ((id (assoc-ref (status-json status) "in_reply_to_account_id"))) - (if (eq? 'null id) - #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")) - -(define (emoji-shortcode emoji) - (assoc-ref (emoji-json emoji) "shortcode")) - -(define (emoji-visible-in-picker? emoji) - (assoc-ref (emoji-json emoji) "visible_in_picker")) - (define emoji-cache (make-hash-table)) (define (fetch-emoji-pict emoji) @@ -470,7 +290,7 @@ (let ((shortcode (match:substring mat 1))) (cons* (match:prefix mat) (cond - ((emojis-ref emojis shortcode) + ((emoji-find emojis shortcode) => (lambda (emoji) (or (and (display-image?) @@ -481,25 +301,6 @@ (list s)))) (list x)))) -(define (emojis-ref emojis shortcode) - (find (lambda (emoji) (equal? shortcode (emoji-shortcode emoji))) - emojis)) - -(define (account-id account) - (assoc-ref (account-json account) "id")) - -(define (account-avatar-static account) - (assoc-ref (account-json account) "avatar_static")) - -(define (account-acct account) - (assoc-ref (account-json account) "acct")) - -(define (account-display-name account) - (assoc-ref (account-json account) "display_name")) - -(define (account-emojis account) - (map make-emoji (vector->list (assoc-ref (account-json account) "emojis")))) - (define avatar-static-cache (make-hash-table)) (define* (fetch-pict url #:key resize height>) @@ -553,7 +354,7 @@ (receive (res body) (get-/api/v1/statuses/:id id #:authorization? authorization?) (case (response-code res) - ((200) (make-status body)) + ((200) (status-from-json body)) (else (error "fetch-status: failed" res body))))) @@ -572,7 +373,7 @@ #:local? local?) (case (response-code res) ((200) - (map make-status (vector->list body))) + (map status-from-json (vector->list body))) ((206) (error "fetch-home-timeline: Home feed is regenerating")) (else @@ -589,7 +390,7 @@ #:only-media? only-media?) (case (response-code res) ((200) - (map make-status (vector->list body))) + (map status-from-json (vector->list body))) (else (error "fetch-public-timeline: failed" res body))))) @@ -713,7 +514,7 @@ (receive (res body) (get-/api/v1/accounts/:id id) (case (response-code res) - ((200) (make-account body)) + ((200) (account-from-json body)) ((401) (error "fetch-account: Unauthorized" id)) ((404) @@ -827,7 +628,7 @@ (case event ((update) (handler event - (make-status + (status-from-json (json-string->scm data))) (loop #f)) ((delete) @@ -835,7 +636,7 @@ (loop #f)) ((notification) (handler event - (make-notification + (notification-from-json (json-string->scm data))) (loop #f)) (else -- cgit v1.2.3