coleslaw/plugins/twitter.lisp

107 lines
3.9 KiB
Common Lisp

(:eval-when (:compile-toplevel :load-toplevel)
(ql:quickload :chirp))
(defpackage :coleslaw-twitter
(:use :cl)
(:import-from :coleslaw
:*config*
:deploy
:get-updated-files
:page-url
:plugin-conf-error)
(:export #:enable))
(in-package :coleslaw-twitter)
(defvar *tweet-format* '(:title "by" :author)
"Controls what the tweet annoucing the post looks like.")
(defvar *tweet-format-fn* nil "Function that expects an instance of
coleslaw:post and returns the tweet content.")
(defvar *tweet-format-dsl-mapping*
'((:title . coleslaw::post-title)
(:author . coleslaw::post-author)))
(define-condition malformed-tweet-format (error)
((item :initarg :item :reader item))
(:report
(lambda (condition stream)
(format stream "Malformed tweet format. Can't proccess: ~A"
(item condition)))))
(defun compile-tweet-format (tweet-format)
(multiple-value-bind
(fmt-ctrl-str accesors) (%compile-tweet-format tweet-format nil nil)
(let
((fmt-ctrl-str (format nil "~{~A~^ ~}" (reverse fmt-ctrl-str)))
(accesors (reverse accesors)))
(lambda (post)
(apply #'format nil fmt-ctrl-str
(loop
:for accesor :in accesors
:collect (funcall accesor post)))))))
(defun %compile-tweet-format (tweet-format fmt-ctrl-str accesors)
"Transform tweet-format into a format control string and a list of values."
(if (null tweet-format)
(values fmt-ctrl-str accesors)
(let ((next (car tweet-format)))
(cond
((keywordp next)
(if (assoc next *tweet-format-dsl-mapping*)
(%compile-tweet-format
(cdr tweet-format)
(cons "~A" fmt-ctrl-str)
(cons (cdr (assoc next *tweet-format-dsl-mapping*))
accesors))
(error 'malformed-tweet-format :item next)))
((stringp next)
(%compile-tweet-format (cdr tweet-format)
(cons next fmt-ctrl-str)
accesors))
(t (error 'malformed-tweet-format :item next))))))
(setf *tweet-format-fn* (compile-tweet-format *tweet-format*))
(defun enable (&key api-key api-secret access-token access-secret tweet-format)
(if (and api-key api-secret access-token access-secret)
(setf chirp:*oauth-api-key* api-key
chirp:*oauth-api-secret* api-secret
chirp:*oauth-access-token* access-token
chirp:*oauth-access-secret* access-secret)
(error 'plugin-conf-error :plugin "twitter"
:message "Credentials missing."))
;; fallback to chirp for credential erros
(chirp:account/verify-credentials)
(when tweet-format
(setf *tweet-format* tweet-format)))
(defmethod deploy :after (staging)
(declare (ignore staging))
(loop :for (state file) :in (get-updated-files)
:when (and (string= "A" state) (string= "post" (pathname-type file)))
:do (tweet-new-post file)))
(defun tweet-new-post (file)
"Retrieve content matching FILE from in memory DB and publish it."
(let ((post (coleslaw::find-content-by-path file)))
(chirp:statuses/update (%format-post 0 post))))
(defun %format-post (offset post)
"Guarantee that the tweet content is 140 chars at most. The 117 comes from
the spaxe needed for a space and the url."
(let* ((content-prefix (subseq (render-tweet post) 0 (- 117 offset)))
(content (format nil "~A ~A/~A" content-prefix
(coleslaw::domain *config*)
(page-url post)))
(content-length (chirp:compute-status-length content)))
(cond
((>= 140 content-length) content)
((< 140 content-length) (%format-post (1- offset) post)))))
(defun render-tweet (post)
"Sans the url, which is a must."
(funcall *tweet-format-fn* post))