(in-package :it.bese.ucw-user)

;;;; The simple person "database"

(defclass person ()
  ((first-name :accessor first-name :initarg :first-name)
   (last-name  :accessor last-name  :initarg :last-name)
   (dob :accessor dob :initarg :dob)
   (friends :accessor friends :initarg :friends :initform '())
   (best-friend :accessor best-friend :initform nil)
   (children :accessor children :initform nil)
   (address :accessor address :initform nil)))

(defparameter *people*
  (flet ((person (first-name last-name dob)
	   (make-instance 'person :first-name first-name
			          :last-name last-name
				  :dob dob)))
    (list (person "Alice" "Almond" (make-time :year 1900))
	  (person "Bob" "Billy" (make-time :year 1950))
	  (person "Carol" "Clive" (make-time :year 1970)))))

(defmethod age ((p person))
  (if (and (slot-boundp p 'dob) (dob p))
      (- (nth-value 0 (time-ymd (time+ (make-time :year 1900 :day 1 :month 1)
				       (time-difference (get-time) (dob p)))))
	 1900)
      "n/a"))

(defclass address ()
  ((street :initform "")
   (city :initform "")
   (state :initform "")
   (country :initform "")
   (postal-code :initform "")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; finally, here are our presentations:

;;;; The first presentation, and the one we almost always have, is for
;;;; editing all the details regarding a person. Most of the slots of
;;;; the presentation are tied to acutal slots in person instances,
;;;; the only exception here is age, which is a derived slot.

(defpresentation person-editor (object-presentation)
  ((string :label "First Name" :slot-name 'first-name :max-length 30)
   (string :label "Last Name" :slot-name 'last-name :max-length 30)
   (integer :label "Age" :getter #'age :editablep nil)
   (date :label "Date of Birth" :slot-name 'dob)
   (some-of :label "Friends" :slot-name 'friends
	    :presentation 'person-friend-select)
   (one-of :label "Best Friend" :slot-name 'best-friend
	   :presentation 'person-best-friend-select)
   (an-object :label "Address" :slot-name 'address
	      :presentation 'address-editor)
   (some-objects :label "Children" :slot-name 'children
		 :presentation 'person-editor)))

(defmethod/cc make-new-instance ((e person-editor) instance)
  (let ((p (make-instance 'person :last-name (last-name instance))))
    (push p *people*)
    p))

(defpresentation address-editor (inline-object-presentation)
  ((string :label "Street" :slot-name 'street)
   (string :label "City" :slot-name 'city)
   (string :label "State" :slot-name 'state)
   (string :label "Country" :slot-name 'country)
   (string :label "Postal Code" :slot-name 'postal-code)))

(defaction create-an-object ((address-editor address-editor) instance)
  (declare (ignore instance))
  (make-instance 'address))

;;;; since we have some relations whose target is a person we also
;;;; need a way to present people inside a drop down box:

(defpresentation person-select (one-line-presentation)
  ((string :slot-name 'first-name :editablep nil :label "First Name")
   (string :slot-name 'last-name :editablep nil :label "Last Name")))

(defmethod get-foreign-instances :around ((p person-select) instance)
  (declare (ignore instance))
  (sort (copy-list (call-next-method)) #'string< :key #'last-name))

(defmethod get-foreign-instances ((p person-select) instance)
  (declare (ignore instance))
  *people*)

;;;; the person-friend-select is just like person-select but excludes
;;;; the current person.

(defpresentation person-friend-select (person-select)
  ())

(defmethod get-foreign-instances ((p person-friend-select) instance)
  (set-difference *people* (cons instance (friends instance))))

;;;; the best-friend relation only shows a sub set of the people
;;;; (those who are already firends). It's slots are the same, only
;;;; the get-all-instances method is different.

(defpresentation person-best-friend-select (person-select)
  ())

(defmethod get-foreign-instances ((p person-best-friend-select) instance)
  (friends instance))

;;;; this presentation is used when generically listing people and
;;;; when listing the results of people searches

(defpresentation person-listing (list-presentation)
  ((string :label "First Name" :slot-name 'first-name  :editablep nil)
   (string :label "Last Name"  :slot-name 'last-name :editablep nil)
   (integer :label "Age"       :getter #'age :editablep nil))
  :editablep t
  :deleteablep t)

(defmethod get-all-instances ((person-listing person-listing))
  (sort (copy-list *people*) #'string< :key #'last-name))

(defaction edit-from-listing ((person-listing person-listing) (person person) index)
  (declare (ignore index))
  (present-object person :using person-editor))

;;;; we allow people to be deleted from the listing:

(defaction delete-from-listing ((listing person-listing) object index)
  ;;;; since we can't have duplicates in *people* we can safely ignore
  ;;;; the ITEM orgument
  (declare (ignore index))
  (setf *people* (delete object *people*)))

;;;; we use this action, which uses the person-editor presentation, to
;;;; create new people.

(defaction create-person ((c component) &key (last-name "") (first-name ""))
  (let ((new-person (present-object (make-instance 'person :last-name last-name
						   :first-name first-name)
				    :using person-editor)))
    (when new-person
      (push new-person *people*))
    new-person))

;;;; we use this action whenever we want to edit and existing person

(defaction edit-person ((c component) last-name)
  (let ((target (find last-name *people* :test #'string= :key #'last-name)))
    (if target
	(present-object target :using person-editor)
        (when (option-dialog ("No person named ~S found." last-name)
		(cons t (format nil "Create a new person named ~S." last-name))
		(cons nil "Ok, never mind."))
	  (create-person c :last-name last-name)))
    target))

;;;; this action, which simply calls our person-listing presentation,
;;;; could just as well be inlined into the various places where it's
;;;; used.

(defaction list-people ((c component))
  (present-collection person-listing))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;

(defcomponent person-search (ucw-presentations::presentation-search)
  ()
  (:default-initargs
   :search-presentation (make-instance 'person-editor)
   :list-presentation (make-instance 'person-listing)))

(defaction person-search ((c component))
  (call 'person-search))

(defaction edit-from-search ((person-search person-search) (person person) index)
  (declare (ignore index))
  (present-object person :using person-editor))

(defmethod get-all-instances ((s person-search)) *people*)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; the ucw components and classes for a minimal web app

(defcomponent presentations-example-window (simple-window-component)
  ((presentations-example :accessor example :component presentations-example)))

(defmethod render ((window presentations-example-window))
  (render (example window))
  (ok window))

(defcomponent presentations-example ()
  ((body :accessor body :component presentations-index)))

(defmethod render ((e presentations-example))
  (<ucw:form :action (refresh-component (body e))
    (render (body e))
    (<ucw:input :type "submit" :value "Ok." :action (ok (body e)))))

(defcomponent presentations-index ()
  ())

(defmethod render ((e presentations-index))
  (<:p "Welcome to the octane demo application.")
  (<:ul
   (<:li (<ucw:a :action (list-people e) "List") " all the people.")
   (<:li (<ucw:a :action (create-person e) "Create") " a new person.")
   (let ((last-name ""))
     (<:li "Edit the person with last name "
	   (<ucw:form :style "display: inline" :action (edit-person e last-name)
	     (<ucw:input :type "text" :accessor last-name)
	     (<:input :type "submit" :value "Ok."))))
   (<:li (<ucw:a :action (person-search e) "Search") " for a particular person.")))

(defaction ok ((index presentations-index) &optional value)
  (declare (ignore value))
  t)