(in-package :kira)

(define-canonical-uri ((person person))
  (let ((name (login-name person)))
    (if name
	(make-instance 'uri :path (list :absolute name))
	(call-next-method))))

(defun person (name)
  (let* ((map (next-in-uri *root*))
	 (person (or (get-value map name)
		     (get-value map (remove-extra-spaces name :space #\- :predicate (complement #'safe-char-p))))))
    (when (typep person 'person)
      person)))

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

(defhandler ((entity people-mixin) :people)
  (:title "People")
  (:list (people entity) :style (typecase entity (root 'joined) (t 'li))))

(defmethod render-in-style ((person person) (style (eql 'joined)))
  (html (render-link person) " " (:small (render-date (creation-time person)))))

(defhandler ((person person))
  (:title
   (let ((real-name (real-name person))
	 (login-name (login-name person)))
     (cond (real-name (render-text real-name))
	   (login-name (render-text login-name))
	   (t (call-next-method)))))
  (:if (blog person)
       (:collection (blog person))
       (render-markup (bio person))))

(defmethod render-sidebar ((person person) (view t))
  (html
   (render-avatar person)
   ((:panel :case-preserving t)
    (:uri person)
    (render-markup (sidebar person)))
   (:panel
    (:ul
     (:li (rss-link person))
     (:li (render-link person 'create :type 'message))))
   (:whereas ((groups (groups person)))
     (:panel
      (:uri person :groups)
      (:list groups)))))

(defhandler ((person person) :about)
  (:title "About")
  (render-markup (bio person)))

(defhandler ((person person) :groups)
  (:title "Groups")
  (:list (groups person)))

(defhandler ((person person) :track)
  (:title "Track")
  ((:table :class "lines")
   (:tr
    (:th "Type")
    (:th "Title")
    (:th "Date"))
   (do-collection (node (nodes person) :n 30 :descending t)
     (:tr
      (:td (:text node 'class))
      (:td (render-link node))
      (:td (render-date (creation-time node)))))))

(defhandler ((person person) drafts)
  (:title "Drafts")
  (render-editables (drafts person))
  (:p (:b (render-title person 'drafts))
      " | " (render-link person 'deleted)))

(defhandler ((person person) deleted)
  (:title "Deleted Items")
  (render-editables (deleted-items person))
  (:p (render-link person 'drafts)
      " | " (:b (render-title person 'deleted))))

(defun render-editables (collection)
  (html
   ((:table :class "lines")
    (:tr
     (:th "Type")
     (:th "Title")
     (:th "Edit")
     (:th "Created"))
    (do-collection (node collection :n 30)
      (:tr
       (:td (:text node 'class))
       (:td (render-link node))
       (:td (render-link node 'edit))
       (:td (render-date (creation-time node))))))))

(defmethod render-editor ((person person))
  (html
   (:fieldset "Photo" (file-field 'image person))
   (:field "E-mail" (text-field 'email person :size 30))
   (:field "Real name" (text-field 'real-name person :size 30))
   (:field "Location" (text-field 'location person))
   (:field "Birthday (YYYY-MM-DD)" (date-field 'birthday person))
   (:field "Bio" (markup-field 'bio person))
   (:field "Sidebar" (markup-field 'sidebar person))
   (:fieldset
    "Preferences"
    (:p (checkbox 'send-notifications-p person "Receive E-mail notifications of private messages"))
    (:p (menu-field 'preferred-editor person '((:fckeditor "FCKeditor") (nil "Plain text editor")))))))

(defhandler ((person person) edit-profile)
  (:title "Edit Profile")
  (:standard-form
   (render-editor person)
   (:p (submit-button nil "Save"))))

(defhandler :post ((person person) edit-profile)
  (update-instance-from-query person)
  (alert "Edited profile.")
  (redirect person))

(defmethod update-instance-from-query progn ((person person))
  (setf-accessors-from-query
   person
   bio
   sidebar
   real-name
   (birthday date)
   (send-notifications-p boolean)
   (preferred-editor keyword)))

(defmethod node-access-p or ((person person) (action t))
  (eq person *person*))

(define-update-methods ((person person))
  (update-collection (people *root*) person)
  (update-map (next-in-uri *root*) (login-name person) person))

(define-canonical-uri ((reader reader))
  (merge-uris "reader" (canonical-uri (creator reader)) :directory t))

(defmethod preferred-editor ((person null))
  nil)

(defun alerts (&optional clear (person *person*))
  (whereas ((alerts (and person (slot-value person 'alerts))))
    (prog1 alerts
      (when clear
	(with-transaction ()
	  (setf (slot-value person 'alerts) '()))))))

(defun add-alert (alert &optional (person *person*))
  (when person
    (with-transaction ()
      (setf (slot-value person 'alerts)
	    (nconc (slot-value person 'alerts)
		   (list alert))))))

(defun render-account-menu ()
  (if *person*
      (html
       ((:p :class "first") "You are logged in as " (render-link *person*) ".")
       (:ul (:li (render-link *person* 'edit-profile))
	    (:li (render-link *person* 'inbox))
	    (:li (render-link 'create :type 'blog-entry))
	    (:li (render-link *person* 'drafts))
	    (:li (render-link *person* 'files))
	    (:li (render-link 'logout)))
       ((:p :class "last") "Groups: " (:links (groups *person*))))
      (render-login-form)))