(in-package :kira)

(defvar *render-replies-p* nil
  "Also render the replies to a post that is being rendered.")

(defclass thread-mixin ()
  ((in-reply-to :accessor in-reply-to :initarg :in-reply-to :initform nil)
   (replies :initarg :replies :initform '())))

(defclass post (node thread-mixin)
  ((section :accessor specified-section :initarg :on-behalf-of :initarg :section :initform nil)))

(defun owner (node)
  (or (when (typep node 'post)
	(specified-section node))
      (creator node)))

(defmethod section ((post post))
  (let ((root (in-reply-to-root post)))
    (or (unless (eq root post)
	  (section root))
	(call-next-method))))

(defcollection replies ((post post))
  (cached-collection post 'replies :descending t))

(defcollection posts ((entity posts-mixin))
  (cached-collection entity 'posts :descending t))

(defmethod render-in-style ((post post) (style (eql 'li)))
  (html (render-link post) " " (:small "by " (render-title (creator post t)))))

(defmethod render-in-style ((post post) (style (eql 'html)))
  (render-avatar post :default nil)
  (render-in-style post 'lines)
  (when (render-markup (body post))
    (html (:p (:b (:a (:uri-to post) "read more »"))))))

(defmethod lines ((post post))
  '())

(defmethod render-in-style ((post post) (style (eql 'lines)))
  (whereas ((lines (lines post)))
    (html
     ((:ul :class "bracketed lines")
      (loop for (label . body) in lines do
	    (setf label (string-downcase label))
	    (html (:li "[" (:b label) "|" body "]")))))))

(defmethod render-in-style ((post post) (style (eql 'header)))
  (html
   (:when (title post)
     (:b (render-title post))
     " / ")
   (:whereas ((creator (creator post t)))
     (render-link creator)
     " on ")
   (render-date (posted-time post))))

(defmethod render-in-style ((post post) (style (eql 'footer)))
  (html
   (:a (:uri-to post) "Permanent Link")
   (:unless *render-replies-p*
     (:whereas ((replies (replies post)))
       " | " (:a (:uri-to post nil :# "comments")
		 (:format "~d Comment~:p" (count-comments replies)))))
   " | " (:a (:uri-to post 'comment) "Reply to This")
   (:whereas ((in-reply-to (in-reply-to post)))
     " | " (:a (:uri-to in-reply-to) "In-Reply-To"))
   (:when (uri-authorized-p post 'edit)
     " | " (render-link post 'edit))))

(defmethod render-in-style ((post post) (style (eql 'view)))
  (let ((root (in-reply-to-root post)))
    (if (eq post root)
	(html
	 (let ((*render-replies-p* nil)
	       (*excerptp* nil))
	   (render-in-style post 'content))
	 (:whereas ((replies (replies post)))
	   (:h3 (("a" :name "comments")) "Comments")
	   (:let ((*render-replies-p* t)
		  (*excerptp* t))
	     (:collection replies))))
	(html
	 ((:p :class "first")
	  (render-link root)
	  " | "
	  (:format "~d Comment~:p" (count-comments (replies root))))
	 (let ((*render-replies-p* t)
	       (*excerptp* nil))
	   (render-in-style post 'content))))))

(defmethod render-in-style ((post post) (style (eql 'content)))
  (html
   ((:div :class "box")
    ((:div :class "header") (render-in-style post 'header))
    (:when (method-exists nil #'render-in-style post 'meta)
      ((:div :class "meta") (render-in-style post 'meta)))
    ((:div :class "content") (render-in-style post 'html))
    ((:div :class "footer") (render-in-style post 'footer)))
   (:when *render-replies-p*
     (:whereas ((replies (replies post)))
       (:let ((*excerptp* t))
	 ((:collection :class "replies") replies))))))

(defhandler ((in-reply-to post) comment)
  (:title "Post Comment")
  (:authorized-p t)
  (let ((*excerptp* nil))
    (render-in-style in-reply-to 'content))
  ((:standard-form :action (:uri-to in-reply-to 'create :type 'post))
   (:fieldset
    "Reply"
    (:if *person*
	 (:progn
	   (markup-field "body" nil)
	   (:p (submit-button nil "Post")
	       " " (submit-button :draft "Save as Draft")))
	 (:progn
	   (:field "Your name" (text-field "creator" nil))
	   (:field "Comment" (markup-field "body" nil))
	   (render-challenge)
	   (:p (submit-button nil "Post")))))))

(define-update-methods ((post post))
  (update-instance (owner post) post))

(define-update-methods ((node thread-mixin))
  (whereas ((in-reply-to (in-reply-to node)))
    (update-collection (replies in-reply-to) node)))

(defmethod link-back ((section section) (post post))
  (setf (specified-section post) section))

(defmethod link-back ((in-reply-to thread-mixin) (node thread-mixin))
  (setf (in-reply-to node) in-reply-to))

(define-update-methods instance ((entity posts-mixin) (post post))
  (update-collection (posts entity) post))

(defun in-reply-to-root (post)
  (loop for parent = (in-reply-to post)
        while parent
        do (setf post parent)
        finally (return post)))

(defun count-comments (comments)
  (let ((count 0))
    (do-collection (comment comments)
      (incf count)
      (whereas ((replies (replies comment)))
	(incf count (count-comments replies))))
    count))

(defmethod render-in-style :after ((post post) (style (eql 'rss)))
  (xml
   (:let ((guid (guid post)))
     (:if guid
	  ((:guid "isPermaLink" "false") guid)
	  ((:guid "isPermaLink" "true") (:uri-to post))))
   ("pubDate" (print-rfc-822-time (posted-time post) *html-output*))
   (:description (escape (html-output (render-in-style post 'html)) +element-escapes+))))

(defmethod text ((post post) (symbol (eql 'realize)))
  "Post")

(defmethod text ((post post) (symbol (eql 'create)))
  (if (eq (class-of post) (find-class 'post))
      "Post"
      (call-next-method)))