[Common Lisp] Twitter というよりむしろ CL-JSON

以前、Common Lisp で Twitter API をたたいて妙なアクセサを作ったりしたけど、CL-JSON にはもっと便利な機能があった。

• *json-symbols-package*
• *json-object-factory*
• *json-object-factory-add-key-value*
• *json-object-factory-return*

などを上手に設定してやれば、ちゃんと Lisp のオブジェクトを構築してくれる。下のコードの twitter-status は user スロットに twitter-user を持つが、そのへんもきちんとめんどうみてくれる。CL-JSON かしこい。

まだきちんと把握してないが、以下コードの断片。

(in-package :twittcl)
;; 文字コードは UTF-8 で
(setf drakma:*drakma-default-external-format* :utf-8)

;; ボディを文字列で取得するために、テキストとして判定される Content-Type を追加
(pushnew '("application" . "json") drakma:*text-content-types* :test #'equal)


(defclass* twitter-api ()
  ((user)
   (passwd)))

(defun authorization (twitter-api)
  (list (user-of twitter-api)
        (passwd-of twitter-api)))

(defun friends-timeline (twitter-api)
  "friends_timeline を取得する。"
  (multiple-value-bind (json http-status)
      (drakma:http-request "http://twitter.com/statuses/friends_timeline.json"
                           :basic-authorization (authorization twitter-api))
    (when (= 200 http-status)
      (decode-twitter-status json))))

(defun public-timeline (twitter-api)
  "public_timeline を取得する。"
  (json:decode-json-from-string
   (drakma:http-request "http://twitter.com/statuses/public_timeline.json"
                        :basic-authorization (authorization twitter-api))))


(defclass* twitter-user ()
  ((name)
   (screen-name)
   (description)
   (location)
   (profile-image-url)
   (url)
   (id)
   (followers-count)))

(defclass* twitter-status ()
  ((created-at)
   (id)
   (user)
   (text)
   (in-reply-to-status-id)
   (source)))

(defun decode-twitter-status-status (obj key value)
  (let ((slot (json::json-intern (substitute #\- #\_ key))))
    (when (null obj)
      (setf obj (if (eq 'name slot)
                  (make-instance 'twitter-user)
                  (make-instance 'twitter-status))))
    (when (slot-exists-p obj slot)
      (setf (slot-value obj slot) value)))
  obj)

(defun decode-twitter-status (json)
  (let ((json:*json-symbols-package* (find-package :twittcl))
        (json:*json-object-factory* #'(lambda () (list)))
        (json:*json-object-factory-add-key-value*
         'decode-twitter-status-status)
        (json:*json-object-factory-return* #'identity))
    (json:decode-json-from-string json)))