slack-room.el

;;; slack-room.el --- slack generic room interface    -*- lexical-binding: t; -*-

;; Copyright (C) 2015  南優也

;; Author: 南優也 <yuyaminami@minamiyuunari-no-MacBook-Pro.local>
;; Keywords:

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(require 'eieio)
(require 'slack-request)
(require 'slack-message)

(defvar slack-current-room-id)
(defvar slack-current-team-id)
(defvar slack-buffer-function)
(defconst slack-room-pins-list-url "https://slack.com/api/pins.list")

(defclass slack-room ()
  ((name :initarg :name :type string)
   (id :initarg :id)
   (created :initarg :created)
   (has-pins :initarg :has_pins)
   (last-read :initarg :last_read :type string :initform "0")
   (latest :initarg :latest)
   (oldest :initarg :oldest)
   (unread-count :initarg :unread_count)
   (unread-count-display :initarg :unread_count_display :initform 0 :type integer)
   (messages :initarg :messages :initform ())
   (team-id :initarg :team-id)))

(defgeneric slack-room-name (room))
(defgeneric slack-room-history (room team &optional oldest after-success sync))
(defgeneric slack-room-update-mark-url (room))

(defun slack-room-create (payload team class)
  (cl-labels
      ((prepare (p)
                (plist-put p :members
                           (append (plist-get p :members) nil))
                (plist-put p :latest
                           (slack-message-create (plist-get p :latest)))
                (plist-put p :team-id (oref team id))
                p))
    (let ((attributes (slack-collect-slots class (prepare payload))))
      (apply #'make-instance class attributes))))

(defmethod slack-room-subscribedp ((_room slack-room) _team)
  nil)

(defmethod slack-room-buffer-name ((room slack-room))
  (concat "*Slack*"
          " : "
          (slack-room-name-with-team-name room)))

(cl-defmacro slack-room-request-update (room team url latest after-success sync)
  `(cl-labels
       ((on-request-update
         (&key data &allow-other-keys)
         (slack-request-handle-error
          (data "slack-room-request-update")
          (let* ((datum (plist-get data :messages))
                 (messages
                  (cl-loop for data across datum
                           collect (slack-message-create data :room ,room))))
            (if ,latest
                (slack-room-set-prev-messages ,room messages)
              (slack-room-set-messages ,room messages)
              (slack-room-update-last-read
               room
               (make-instance 'slack-message :ts "0")))
            (if (and ,after-success
                     (functionp ,after-success))
                (funcall ,after-success))))))
     (slack-request
      ,url
      ,team
      :params (list (cons "channel" (oref ,room id))
                    (if ,latest
                        (cons "latest" ,latest)))
      :success #'on-request-update
      :sync (if ,sync t nil))))

(cl-defun slack-room-make-buffer-with-room (room team &key update)
  (with-slots (messages latest) room
    (if (or update (< (length messages) 1))
        (slack-room-history room team))
    (funcall slack-buffer-function
             (slack-buffer-create room team))))

(cl-defmacro slack-select-from-list ((alist prompt) &body body)
  "Bind candidates from selected."
  (let ((key (cl-gensym)))
    `(let* ((,key (let ((completion-ignore-case t))
                    (completing-read (format "%s" ,prompt)
                                     ,alist nil t)))
            (selected (cdr (cl-assoc ,key ,alist :test #'string=))))
       ,@body
       selected)))

(defun slack-room-select (rooms)
  (let* ((alist (slack-room-names
                 rooms
                 #'(lambda (rs)
                     (cl-remove-if #'(lambda (r)
                                       (or (not (slack-room-member-p r))
                                           (slack-room-archived-p r)
                                           (not (slack-room-open-p r))))
                                   rs)))))
    (slack-select-from-list
     (alist "Select Channel: ")
     (slack-room-make-buffer-with-room
      selected
      (slack-team-find (oref selected team-id))
      :update nil))))

(cl-defun slack-room-list-update (url success team &key (sync t))
  (slack-request
   url
   team
   :success success
   :sync sync))

(defun slack-room-update-messages ()
  (interactive)
  (unless (and (boundp 'slack-current-room-id)
               (boundp 'slack-current-team-id))
    (error "Call From Slack Room Buffer"))
  (let* ((team (slack-team-find slack-current-team-id))
         (room (slack-room-find slack-current-room-id team))
         (cur-point (point)))
    (slack-room-history room team)
    (slack-buffer-create
     room team :insert-func
     #'(lambda (room team)
         (slack-buffer-widen
          (let ((inhibit-read-only t))
            (delete-region (point-min) (marker-position lui-output-marker))))
         (slack-buffer-insert-previous-link room)
         (slack-buffer-insert-messages room team)
         (goto-char cur-point)))))

(defmethod slack-room-render-prev-messages ((room slack-room) team
                                            oldest ts)
  (slack-buffer-create
   room team
   :insert-func
   #'(lambda (room team)
       (slack-buffer-widen
        (let ((inhibit-read-only t)
              (loading-message-end
               (slack-buffer-ts-eq (point-min) (point-max) oldest)))
          (delete-region (point-min) loading-message-end)
          (slack-buffer-insert-prev-messages room team oldest)))
       (slack-buffer-goto ts))))

(defmethod slack-room-prev-link-info ((room slack-room))
  (with-slots (oldest) room
    (if oldest
        (oref oldest ts))))

(defun slack-room-load-prev-messages ()
  (interactive)
  (let* ((cur-point (point))
         (ts (get-text-property (next-single-property-change cur-point 'ts)
                                'ts))
         (oldest (ignore-errors (get-text-property 0 'oldest
                                                   (thing-at-point 'line))))
         (current-team (slack-team-find slack-current-team-id))
         (current-room (slack-room-find slack-current-room-id
                                        current-team)))
    (slack-room-history current-room
                        current-team
                        oldest
                        #'(lambda ()
                            (slack-room-render-prev-messages current-room
                                                             current-team
                                                             oldest ts)))))

(defun slack-room-find-message (room ts)
  (cl-find-if #'(lambda (m) (string= ts (oref m ts)))
              (oref room messages)
              :from-end t))

(defmethod slack-room-name-with-team-name ((room slack-room))
  (with-slots (team-id name) room
    (let ((team (slack-team-find team-id)))
      (format "%s - %s" (oref team name) name))))

(defmacro slack-room-names (rooms &optional filter)
  `(cl-labels
       ((latest-ts (room)
                   (with-slots (latest) room
                     (if latest (oref latest ts) "0")))
        (unread-count (room)
                      (with-slots (unread-count-display) room
                        (if (< 0 unread-count-display)
                            (concat "("
                                    (number-to-string unread-count-display)
                                    ")")
                          "")))
        (sort-rooms (rooms)
                    (nreverse
                     (cl-sort rooms #'string<
                              :key #'(lambda (name-with-room) (latest-ts (cdr name-with-room))))))
        (build-label (room)
                     (concat (im-presence room)
                             (format "%s %s"
                                     (slack-room-name-with-team-name room)
                                     (unread-count room))))
        (im-presence (room)
                     (if (object-of-class-p room 'slack-im)
                         (slack-im-user-presence room)
                       "  "))
        (build-cons (room)
                    (cons (build-label room) room)))
     (sort-rooms
      (cl-loop for room in (if ,filter
                               (funcall ,filter ,rooms)
                             ,rooms)
               collect (cons (build-label room) room)))))

(defmethod slack-room-name ((room slack-room))
  (oref room name))

(defmethod slack-room-update-last-read ((room slack-room) msg)
  (with-slots (ts) msg
    (oset room last-read ts)))

(defmethod slack-room-latest-messages ((room slack-room) messages)
  (with-slots (last-read) room
    (cl-remove-if #'(lambda (m)
                      (or (string< (oref m ts) last-read)
                          (string= (oref m ts) last-read)))
                  messages)))

(defun slack-room-sort-messages (messages)
  (cl-sort messages
           #'string<
           :key #'(lambda (m) (oref m ts))))

(defmethod slack-room-sorted-messages ((room slack-room))
  (with-slots (messages) room
    (slack-room-sort-messages (copy-sequence messages))))

(defmethod slack-room-set-prev-messages ((room slack-room) prev-messages)
  (slack-room-set-messages
   room
   (cl-delete-duplicates (append (oref room messages)
                                 prev-messages)
                         :test #'slack-message-equal)))

(defmethod slack-room-set-messages ((room slack-room) m)
  (let ((sorted (slack-room-sort-messages m)))
    (oset room oldest (car sorted))
    (oset room messages sorted)
    (oset room latest (car (last sorted)))))

(defmethod slack-room-prev-messages ((room slack-room) from)
  (with-slots (messages) room
    (cl-remove-if #'(lambda (m)
                      (or (string< from (oref m ts))
                          (string= from (oref m ts))))
                  (slack-room-sort-messages (copy-sequence messages)))))

(defmethod slack-room-update-mark ((room slack-room) team msg)
  (cl-labels ((on-update-mark (&key data &allow-other-keys)
                              (slack-request-handle-error
                               (data "slack-room-update-mark"))))
    (with-slots (ts) msg
      (with-slots (id) room
        (slack-request
         (slack-room-update-mark-url room)
         team
         :type "POST"
         :params (list (cons "channel"  id)
                       (cons "ts"  ts))
         :success #'on-update-mark
         :sync nil)))))

(defun slack-room-pins-list ()
  (interactive)
  (unless (and (bound-and-true-p slack-current-room-id)
               (bound-and-true-p slack-current-team-id))
    (error "Call from slack room buffer"))
  (let* ((team (slack-team-find slack-current-team-id))
         (room (slack-room-find slack-current-room-id
                                team))
         (channel (oref room id)))
    (cl-labels ((on-pins-list (&key data &allow-other-keys)
                              (slack-request-handle-error
                               (data "slack-room-pins-list")
                               (slack-room-on-pins-list
                                (plist-get data :items)
                                room team))))
      (slack-request
       slack-room-pins-list-url
       team
       :params (list (cons "channel" channel))
       :success #'on-pins-list
       :sync nil))))

(defun slack-room-on-pins-list (items room team)
  (cl-labels ((buffer-name (room)
                           (concat "*Slack - Pinned Items*"
                                   " : "
                                   (slack-room-name-with-team-name room))))
    (let* ((messages (mapcar #'slack-message-create
                             (mapcar #'(lambda (i)
                                         (plist-get i :message))
                                     items)))
           (buf-header (propertize "Pinned Items"
                                   'face '(:underline
                                           t
                                           :weight bold))))
      (funcall slack-buffer-function
               (slack-buffer-create-info
                (buffer-name room)
                #'(lambda ()
                    (insert buf-header)
                    (insert "\n\n")
                    (mapc #'(lambda (m) (insert
                                         (slack-message-to-string m)))
                          messages)))
               team))))

(defun slack-select-rooms ()
  (interactive)
  (let ((team (slack-team-select)))
    (slack-room-select
     (cl-loop for team in (list team)
              append (with-slots (groups ims channels) team
                       (append ims groups channels))))))

(defun slack-create-room (url team success)
  (slack-request
   url
   team
   :type "POST"
   :params (list (cons "name" (read-from-minibuffer "Name: ")))
   :success success
   :sync nil))

(defun slack-room-rename (url room-alist-func)
  (cl-labels
      ((on-rename-success (&key data &allow-other-keys)
                          (slack-request-handle-error
                           (data "slack-room-rename"))))
    (let* ((team (slack-team-select))
           (room-alist (funcall room-alist-func team))
           (room (slack-select-from-list
                  (room-alist "Select Channel: ")))
           (name (read-from-minibuffer "New Name: ")))
      (slack-request
       url
       team
       :params (list (cons "channel" (oref room id))
                     (cons "name" name))
       :success #'on-rename-success
       :sync nil))))

(defmacro slack-current-room-or-select (room-alist-func)
  `(if (and (boundp 'slack-current-room-id)
            (boundp 'slack-current-team-id))
       (slack-room-find slack-current-room-id
                        (slack-team-find slack-current-team-id))
     (let* ((room-alist (funcall ,room-alist-func)))
       (slack-select-from-list
        (room-alist "Select Channel: ")))))

(defmacro slack-room-invite (url room-alist-func)
  `(cl-labels
       ((on-group-invite (&key data &allow-other-keys)
                         (slack-request-handle-error
                          (data "slack-room-invite")
                          (if (plist-get data :already_in_group)
                              (message "User already in group")
                            (message "Invited!")))))
     (let* ((team (slack-team-select))
            (room (slack-current-room-or-select
                   #'(lambda ()
                       (funcall ,room-alist-func team
                                #'(lambda (rooms)
                                    (cl-remove-if #'slack-room-archived-p
                                                  rooms))))))
            (user-id (plist-get (slack-select-from-list
                                 ((slack-user-names team)
                                  "Select User: ")) :id)))
       (slack-request
        ,url
        team
        :params (list (cons "channel" (oref room id))
                      (cons "user" user-id))
        :success #'on-group-invite
        :sync nil))))

(defmethod slack-room-member-p ((_room slack-room))
  t)

(defmethod slack-room-archived-p ((_room slack-room))
  nil)

(defmethod slack-room-open-p ((_room slack-room))
  t)

(defmethod slack-room-equal-p ((room slack-room) other)
  (with-slots (id) room
    (with-slots ((other-id id)) other
      (string= id other-id))))

(defun slack-room-deleted (id team)
  (let ((room (slack-room-find id team)))
    (cond
     ((object-of-class-p room 'slack-channel)
      (with-slots (channels) team
        (setq channels (cl-delete-if #'(lambda (c) (slack-room-equal-p room c))
                                     channels)))
      (message "Channel: %s deleted"
               (slack-room-name-with-team-name room))))))

(cl-defun slack-room-request-with-id (url id team success)
  (slack-request
   url
   team
   :params (list (cons "channel" id))
   :success success
   :sync nil))

(defmethod slack-room-history ((room slack-room) team
                               &optional
                               oldest
                               after-success
                               async)
  (slack-room-request-update room
                             team
                             (slack-room-history-url room)
                             oldest
                             after-success
                             (if async nil t)))

(defmethod slack-room-inc-unread-count ((room slack-room))
  (cl-incf (oref room unread-count-display)))

(provide 'slack-room)
;;; slack-room.el ends here