(in-package :kira)

(defclass message (node thread-mixin)
  ((recipient :accessor recipient :initarg :recipient :initform nil)
   (read-by :initarg :read-by :initform nil)))

(defmethod read-by ((person person) (message message))
  (containsp (slot-value message 'read-by) person))

(defmethod read-by ((person person) (node node))
  t)

(defmethod (setf read-by) (value (person person) (message message))
  (if value
      (add-to (slot-value message 'read-by) person)
      (remove-from (slot-value message 'read-by) person)))

(defmethod recipient ((node thread-mixin))
  (whereas ((in-reply-to (in-reply-to node)))
    (creator in-reply-to)))

(defhandler :before ((message message))
  (with-transaction ()
    (setf (read-by *person* message) t)))

(defmethod render-in-style ((message message) (style (eql 'view)))
  (html
   (render message)
   (:fieldset
    "Reply"
    ((:standard-form :action (:uri-to message 'create :type 'message))
     (render-editor 'message)
     (:p (submit-button nil "Send Reply"))))))

(defmethod render-in-style ((message message) (style (eql 'content)))
  (html
   ((:div :class "box")
    ((:div :class "header")
     (:when (title message)
       (:b (render-title message))
       " / ")
     (render-link (creator message))
     (:whereas ((recipient (recipient message)))
       " to " (render-link recipient))
     " on " (render-date (creation-time message)))
    ((:div :class "content")
     (render-in-style message 'html))
    ((:div :class "footer")
     (render-link message 'edit)
     (:whereas ((in-reply-to (in-reply-to message)))
       " | " (:a (:uri-to in-reply-to) "In-Reply-To"))))))

(defmethod render-in-style ((message message) (style (eql 'html)))
  (render-markup (body message) :excerptp nil))

(defmethod render-editor :before ((message message))
  (html (:field "To" (render-link (recipient message)))))

(defmethod link-back ((recipient person) (message message))
  (setf (recipient message) recipient))

(defmethod link-back :after ((node thread-mixin) (message message))
  (setf (recipient message) (creator node)
	(title message) (format nil "Re:~@[ ~a~]" (title node))))

(define-update-methods ((message message))
  (update-instance (recipient message) message)
  (update-collection (sent-items (creator message)) message))

(define-update-methods instance ((person person) (message message))
  (update-collection (inbox person) message))

(define-update-methods instance ((group group) (message message))
  (update-instances (people group) message))

(defmethod text ((message message) (symbol (eql 'realize)))
  "Send")

(defhandler ((person person) inbox)
  (:title "Inbox")
  ((:table :class "lines")
   (:tr
    (:th "From")
    (:th "Title")
    (:th "Received"))
   (do-collection (message (inbox person) :n 10 :descending t)
     ((:tr :class (:unless (read-by person message) "new"))
      (:td (render-title (creator message)))
      (:td (render-link message))
      (:td (render-date (creation-time message))))))
  (:p (:b (render-title person 'inbox))
      " | " (render-link person 'sent)))

(defhandler ((person person) sent)
  (:title "Sent Items")
  ((:table :class "lines")
   (:tr
    (:th "To")
    (:th "Title")
    (:th "Sent"))
   (do-collection (message (sent-items person) :n 10 :descending t)
     (:tr
      (:td (render-title (recipient message)))
      (:td (render-link message))
      (:td (render-date (creation-time message))))))
  (:p (render-link person 'inbox)
      " | " (:b (render-title person 'sent))))

(defun send-notifications (node)
  (when (typep node 'message)
    (whereas ((recipient (recipient node)))
      (let ((subject (html-output "Message from " (render-title (creator node))))
	    (body (uri-to nil nil t node)))
	(flet ((send-notification (person)
		 (when (and (not (eq person *person*)) (send-notifications-p person))
		   (whereas ((email (email person)))
		     (send-mail email subject body)))))
	  (typecase recipient
	    (person
	     (send-notification recipient))
	    (group
	     (do-collection (person (people recipient))
	       (send-notification person)))))))))

(defmethod track ((message message))
  ())