(in-package :kira)

(defclass event (post geo-mixin recipient-mixin)
  ((start-time :accessor start-time :initarg :start-time :initform nil)
   (end-time :accessor end-time :initarg :end-time :initform nil)
   (phone :accessor phone :initarg :phone :initform nil)
   (rsvps :accessor rsvps :initarg :rsvps :initform nil)))

(defcollection events ((entity events-mixin))
  (cached-collection entity 'events :start *now*))

(defclass rsvp (post)
  ((status :accessor rsvp-status :initarg :status :initform t)
   (guests :accessor guests :initarg :guests :initform 0)))

(defhandler ((entity events-mixin) :events)
  (:title "Events")
  (:p (render-link entity 'create :type 'event))
  (:collection (events entity)))

(defmethod render-in-style ((event event) (style (eql 'li)))
  (html (render-date (start-time event)) ": " (render-link event))
  (whereas ((owner (owner event)))
    (unless (eq *section* owner)
      (html " " (:small "(" (render-link owner) ")")))))

(defmethod render-in-style ((event event) (style (eql 'meta)))
  (html
   ((:table :class "meta")
    (:whereas ((start-time (start-time event)))
      (:th/d
       "Start:"
       (render-date-time start-time)))
    (:whereas ((end-time (end-time event)))
      (:th/d
       "End:"
       (render-date-time end-time)))
    (:th/d
     "Attendance:"
     (multiple-value-bind (yes no) (attendance event)
       (html
	yes " attending"
	(:when (plusp no) ", " no " not attending")
	" [" (:b (render-link event 'rsvp)) "]")))
    (:whereas ((phone (phone event)))
      (:th/d
       "Phone:"
       (render-inline-markup phone)))
    (:when (email event)
      (:th/d
       "E-mail:"
       (render-contact-link event)))
    (:whereas ((location (location event)))
      (:th/d
       "Location:"
       (render-location location))))))

(defmethod render-editor ((event event))
  (html
   (:let ((groups (groups *person*))
	  (group (specified-section event)))
     (:if (containsp groups group)
	  (:fieldset "Group" (collection-field "group" group groups))
	  (:field "Group" (render-link group))))
   (:fieldset
    "Date/Time"
    ((:table :class "fields")
     (:tr
      (:th "Start:")
      (:td (date-time-field 'start-time event :onchange "sync_date(this.form)")))
     (:tr
      (:td " ")
      (:td (:tt "YYYY-MM-DD")))
     (:tr
      (:th "End:")
      (:td (date-time-field 'end-time event)))
     (:tr
      (:td " ")
      (:td (:tt "YYYY-MM-DD")))))
   (:fieldset "Image" (file-field 'image event))
   (:fieldset "Location" (textarea 'location event :height 8))
   (:fieldset
    "Description"
    (:field "Title" (text-field 'title event))
    (:field "Body" (markup-field 'body event)))
   (:fieldset
    "Contact"
    (:field "Phone" (text-field 'phone event :size 30))
    (:field "E-mail" (text-field 'email event :size 30)))))

(defmethod render-in-style :before ((rsvp rsvp) (style (eql 'header)))
  (html
   (:small
    "[RSVP: "
    (:if (rsvp-status rsvp)
	 ((:b :class "positive") "Yes")
	 ((:b :class "negative") "No"))
    (:whereas ((guests (guests rsvp)))
      (:when (plusp guests)
	(:format " (+~d guest~:p)" guests)))
    "] ")))

(defhandler :before ((event event) rsvp)
  (whereas ((rsvp (get-value (rsvps event) *person*)))
    (redirect rsvp 'edit)))

(defhandler ((event event) rsvp)
  (:title "RSVP")
  (render event)
  ((:standard-form :action (:uri-to event 'create :type 'rsvp))
   (render-editor 'rsvp)
   (:p (submit-button nil "RSVP"))))

(defmethod render-editor ((rsvp rsvp))
  (html
   (:fieldset
    "RSVP"
    (radio-button 'rsvp-status rsvp "Attending with" :option t)
    " " (text-field 'guests rsvp :size 5 :maxlength t) " guests" (:br)
    (radio-button 'rsvp-status rsvp "Can't be there" :option nil))
   (:field
    "Optional comment"
    (markup-field 'body rsvp))))

(define-feed ((entity events-mixin) :events)
  (:collection (events entity)))

(defun attendance (event)
  (let ((yes 0)
	(no 0))
    (do-collection (rsvp (rsvps event))
      (if (rsvp-status rsvp)
	  (incf yes (1+ (guests rsvp)))
	  (incf no)))
    (values yes
	    no)))

(defmethod initialize-instance-from-query progn ((event event))
  (let ((dt (make-date-time
	     :year (date-time-year *now*)
	     :month (date-time-month *now*)
	     :day (date-time-day *now*)
	     :hour 18
	     :utc-p nil)))
    (setf (start-time event) dt
	  (end-time event) dt)))

(defmethod update-instance-from-query progn ((event event))
  (setf-accessors-from-query
   event
   (start-time date-time)
   (end-time date-time)
   phone))

(defmethod watched-slots append ((event event))
  '(start-time))

(define-update-methods instance ((entity events-mixin) (event event))
  (update-map (events entity) (start-time event) event :unique nil))

(defmethod update-instance-from-query progn ((rsvp rsvp))
  (setf-accessors-from-query
   rsvp
   (rsvp-status boolean)
   (guests integer)))

(define-update-methods ((rsvp rsvp))
  (whereas ((event (in-reply-to rsvp)))
    (update-map (rsvps event) (creator rsvp) rsvp)))

(defmethod text ((rsvp rsvp) (symbol (eql 'class)))
  "RSVP")