diff options
Diffstat (limited to 'qkbox')
| -rw-r--r-- | qkbox/toot.scm | 91 |
1 files changed, 44 insertions, 47 deletions
diff --git a/qkbox/toot.scm b/qkbox/toot.scm index e433df8..d4c30a4 100644 --- a/qkbox/toot.scm +++ b/qkbox/toot.scm @@ -38,6 +38,11 @@ #:use-module ((sxml xpath) #:select (sxpath))) +(define-syntax-rule (and/nil test expr) + (if test + expr + '())) + (define current-mastodon-host (make-parameter (getenv "MASTODON_HOST"))) @@ -73,29 +78,24 @@ 'POST "/api/v1/statuses" #:json - `(,@(if status - `((status . ,(if (string? status) - status - (format #f "~y" status)))) - '()) - ,@(if spoiler-text - `((spoiler_text . ,spoiler-text)) - '()) - ,@(if visibility - (case visibility - ((public unlisted private direct) - `((visibility . ,visibility))) - (else - (error "post: invalid visibility (must be one of: public unlisted private direct)"))) - '()) - ,@(if sensitive? `((sensitive . (if sensitive? #t #f))) - '()) - ,@(if reply-to - `((in_reply_to_id . ,reply-to)) - '()) - ,@(if media-ids - `((media_ids . ,(list->vector (map number->string media-ids)))) - '())) + `(,@(and/nil status + `((status . ,(if (string? status) + status + (format #f "~y" status))))) + ,@(and/nil spoiler-text + `((spoiler_text . ,spoiler-text))) + ,@(and/nil visibility + (case visibility + ((public unlisted private direct) + `((visibility . ,visibility))) + (else + (error "post: invalid visibility (must be one of: public unlisted private direct)")))) + ,@(and/nil sensitive? + `((sensitive . (if sensitive? #t #f)))) + ,@(and/nil reply-to + `((in_reply_to_id . ,reply-to))) + ,@(and/nil media-ids + `((media_ids . ,(list->vector (map number->string media-ids)))))) #:authorization? #t)) (define-record-type <status> @@ -228,12 +228,11 @@ (put-bytevector in body) (close in)) (let ((pict (and (zero? (apply system* "convert" - `(,@(if resize - `("-resize" - ,(format #f "~d!x~d!" - (car resize) - (cadr resize))) - '()) + `(,@(and/nil resize + `("-resize" + ,(format #f "~d!x~d!" + (car resize) + (cadr resize)))) ,(string-append tmp "[0]") ,(string-append "png:" tmp)))) (pict-from-file tmp)))) @@ -282,11 +281,11 @@ 'GET "/api/v1/timelines/home" #:json - `(,@(if max-id `((max_id . ,max-id)) '()) - ,@(if since-id `((since_id . ,since-id)) '()) - ,@(if min-id `((min_id . ,min-id)) '()) - ,@(if limit `((limit . ,limit)) '()) - ,@(if local? `((local . ,local?)) '())) + `(,@(and/nil max-id `((max_id . ,max-id))) + ,@(and/nil since-id `((since_id . ,since-id))) + ,@(and/nil min-id `((min_id . ,min-id))) + ,@(and/nil limit `((limit . ,limit))) + ,@(and/nil local? `((local . ,local?)))) #:authorization? #t)) (define-public (favourite id) @@ -352,13 +351,13 @@ path) #:method method #:headers `(,@headers - ,@(if authorization? - `((authorization - ,(string->symbol - (string-append - "Bearer " - (current-mastodon-access-token))))) - '())) + ,@(and/nil + authorization? + `((authorization + ,(string->symbol + (string-append + "Bearer " + (current-mastodon-access-token))))))) #:decode-body? #f #:body body) (values res body))) @@ -369,12 +368,10 @@ authorization?) (receive (res body) (raw-request method path - #:body (if json - (scm->json-string json) - #f) - #:headers (if json - '((content-type application/json)) - '()) + #:body (and json + (scm->json-string json)) + #:headers (and/nil json + '((content-type application/json))) #:authorization? authorization?) (if (= 200 (response-code res)) (values res (json-string->scm (utf8->string body))) |