;;;; * Utilities

(defmethod reorder-list ((list list) new-order)
  (loop for n in new-order
	collect (nth n list)))

(defun find-all-subclasses (class)
  (loop for class in (mopp:class-direct-subclasses class)
	collect class into classes
	finally (return
		  (nconc classes
			  (loop for class in classes
				nconc (find-all-subclasses class))))))

;;;; * Content Store
;;;; For the sake of keeping it simple,
;;;; we are going to store all the content in a single EQUAL hash-table.
;;;; this is somewhat naive, but will do for now.

(defclass content-store ()
  ((store :accessor store :initform (make-hash-table :test #'equalp))
   (place :accessor place :initform "content-store")))

(defvar *content* (make-instance 'content-store))


(defmethod find-content ((store content-store) name)
  (gethash name (store store)))

(defmethod (setf find-content)  (content (store content-store) name)
  (setf (gethash name (store store)) content))

(defmethod save-content ((store content-store))
  (cl-store:store store (place store)))

(defmethod restore-content ((store content-store))
  (cl-store:restore (place store)))

(defun content (name)
  (find-content *content* name))

(defun (setf content) (value name)
  (setf (find-content *content* name) value))

(defun store-content ()
  (save-content *content*))


;;;; 
;;;; ** Content Items

;;;; TODO: I'm missing a DEFCLASS/META macro and it shows.

(defclass content ()
  ((name :accessor name :initarg :name :initform nil))
  (:documentation "The superclass of all content items"))

(defmethod initialize-instance :around ((self content) &rest initargs)
  (let ((content (content (getf initargs :name))))
    (cond
      (content       
       (setf content (apply #'reinitialize-instance content initargs)))  
      (t
       (setf content (call-next-method))))
    (setf (content (name content)) content)
    content))
    
(defclass simple-content (content)
  ((title :accessor title :initarg :title :initform "")
   (show-title-p :accessor show-title-p :initarg :show-title-p :initform t)
   (body :accessor body :initarg :body :initform "")))

(lol:define-meta-model simple-content ()
  ((title :type string)
   (body :type string)
   (name :type string)
   (show-title-p :type boolean)))

(lol:set-default-attributes 'simple-content)

(defclass content-container (content)
  ((contents :accessor contents :initarg :contents)
   (title :accessor title :initarg :title :initform nil)))

(lol:define-meta-model content-container ()
  ((contents :type string)))

(lol:set-default-attributes 'content-container)

;;;; the lack of inheritance in the meta model shows here.
;;;; perhaps the next iteration should include that feature.

(defclass faq-container (content-container)
  ((show-title-p :accessor show-title-p :initarg :show-title-p :initform t)))

(lol:define-meta-model faq-container ()
  ((contents :type string)
   (title :type string)
   (show-title-p :type boolean)))

(lol:set-default-attributes 'faq-container)

(defclass faq-item (simple-content) ())

(lol:define-meta-model faq-item ()
  ((title :type string)
   (body :type string)
   (name :type string)
   (show-title-p :type boolean)))

(lol:set-default-attributes 'faq-item)

(lol:define-attributes (simple-content faq-item)
  (body mewa::text)
  (show-title-p mewa::mewa-boolean)
  (:one-line t :attributes (title))
  (:viewer content-viewer)
  (:editor
   content-editor
   :attributes (name title show-title-p (body :type dojo-editor))))

(lol:define-attributes (content-container faq-container)
  (:viewer content-list-presentation)
  (:listing sortable-list-editor)
  (:one-line t :attributes (title)))

(lol:define-attributes (faq-container)
  (:viewer faq-presentation))

(lol:define-attributes (faq-item)
  (:viewer faq-item-presentation))


;;;; ** Restore Content on Startup :
;;;; *** This should perhaps be moved to start.lisp
(let ((content (restore-content *content*)))
  (if content
      (setf *content* content)))


(defcomponent content-presentation (lol::mewa-viewer)
  ())

(defmethod editablep ((self content-presentation))
  (get-session-value :editablep))

(defmethod lol:present ((self content-presentation))
  (<:div :class "content" 
  (when (show-title-p (lol:instance self))
    (<:h2 (lol:present-slot-view self 'title)))
  (lol:present-slot-view self 'body)
  (when (editablep self)
    (<ucw:a :action (lol:call-view ((lol:instance self) :editor))
	    (<:as-html "edit")))))


(defcomponent sign-up-now-mixin (dojo-component)
  ()
  (:default-initargs
      :requires '("dojo.event.*")))

(defaction check-postal-code ((self component) postal-code)
  (call 'info-message :message "Feature not yet implemented"))

(defmethod render-on :wrapping ((res response) (self sign-up-now-mixin))
  (call-next-method)
  (let (postal-code)
    (<ucw:form
     :action (check-postal-code self postal-code)
	       (<:div :class "sign-up-now"
		      (<:h2 (<:as-html "Sign Up Now"))
		      (<ucw:text :accessor postal-code :value "Enter Postal Code" :id "postal-code")
		      (<ucw:script
		       `(dojo.event.connect dojo "loaded"
			 (lambda ()
			   (setf po (document.get-element-by-id "postal-code"))
			   (dojo.event.connect po "onfocus"
					       (lambda ()
						 (setf (slot-value po value) "")))
			   (dojo.event.connect po "onkeypress"
					       (submit-on-enter po)))))))))

(defcomponent charity-list-mixin () ())

(defmethod render-on :wrapping ((res response) (self charity-list-mixin))
  (call-next-method)
  (<:div :id "charity-list-footer"
	 (<:img :src "images/charities.jpg")
	 (<ucw:a :action (view-charites))))

(defcomponent content-viewer (content-presentation sign-up-now-mixin charity-list-mixin)
  ())

(defcomponent content-editor (content-presentation)
  ()
  (:default-initargs
      :global-properties '(:editablep t)))

(defmethod lol:present ((self content-editor))
  (<:div :style "border:1px solid black"
	 (<ucw:form :action (refresh-component self)
	 (<:as-html "Content Info: ")
	 (<:p (<:as-html "name :")
	      (lol:present-slot-view self 'name))
	 (<:p (<:as-html "title :")
	      (lol:present-slot-view self 'title))
	 (<:as-html "Show Title when Displaying?")
	 (lol:present-slot-view self 'show-title-p)
	 (<ucw:submit :value "Save Info" :action (refresh-component self))))

  (lol:present-slot-view self 'body)
  (when (editablep self)
    (<ucw:a :action (lol:call-view ((lol:instance self) :editor))
	    (<:as-html "edit"))))

(defcomponent content-list-presentation (content-presentation)
  ((presentation :accessor presentation :initarg :presentation :initform :one-line)))


;;;; ** list viewer
(defmethod contents ((self content-list-presentation ))
  (contents (lol:instance self)))

(defaction edit-list ((self content-list-presentation))
  (let ((saved (lol:call-view ((contents self)  'content-list-editor))))
    (when saved
      (setf (contents (lol::instance self)) saved))))

(defmethod lol:present ((self content-list-presentation))
  (<:ul (arnesi:dolist* (n (contents self))
	  (<:li (<ucw:a :action (display-content self n)
			(lol:present-view (n :one-line))))))
  (when (editablep self)
  (<ucw:a :action (edit-list self)
	  (<:as-html "edit" ))))

(defaction display-content ((self content-list-presentation) content)
  (lol:call-view (content :viewer (call-from self))))

(defmethod call-from ((self content-presentation))
  "Where to call from when displaying the content body"
  (content-area (ucw::parent self)))



(defcomponent content-finder (content-list-presentation)
  ())


(defmethod find-content-types ()
  (find-all-subclasses (find-class 'content)))
  
(defmethod render-on ((res response) (self content-finder))
  (<:h2 (<:as-html "Find Content"))
  (<:as-html "to add new content : ")
  
  (<ucw:form
   :action (refresh-component self)
   (<:ul
    (let ((type (find-class 'content))
	  (name "")
	  (title ""))
      (<:li (<:as-html "Select a type :") (<ucw:select
       :accessor type
       (arnesi:dolist* (class (find-content-types))
	 (<ucw:option :value class (<:as-html (class-name class))))))
      (<:li       (<:as-html "give it a name :")
		  (<ucw:input :accessor name))
      (<:li 
      (<:as-html "give it a Title :")
      (<ucw:input :accessor title))
      (<:li (<ucw:button :action (lol:call-view ((make-instance type :name name :title title)
						 :editor))
					      (<:as-html "Add Content"))))))

  
  (loop for value being the hash-values of (store *content*)
        using (hash-key key)
        do (let ((key key)
		 (value value))
	     (<:div :style "border-bottom:1px solid black"
		    (<:as-html "Name : " (name value))
		    (<:br)
		    (<ucw:a :action (answer value)
			    (<:as-html (title value)))))))


(defcomponent content-list-editor (sortable-list-editor content-presentation)
  ())

(defaction add-item ((self content-list-editor))
  (let ((c (call-component (call-from self) (make-instance 'content-finder))))
    (when c
      (setf (mewa::instances self)
	    (cons c (mewa::instances self))))))




(defcomponent faq-presentation-mixin ()
  ())

(defmethod lol:present :around ((self faq-presentation-mixin))
  (<:h2 (<:as-html "F.A.Q"))
  (<:h3 (<:as-html "Answers to some common questions about Sunrise Organics"))
  (<:div
   :class "faq"
   (call-next-method)))

(defcomponent faq-presentation (content-list-presentation
				sign-up-now-mixin
				charity-list-mixin
				faq-presentation-mixin)
  ())

(defcomponent faq-item-presentation (content-viewer
				     charity-list-mixin
				     faq-presentation-mixin)
  ())

(defmethod lol:present :around ((self faq-item-presentation))
  (call-next-method)
  (<ucw:a :class "back-link" :action (lol:call-view ((content "FAQ")))
	  (<:as-html "Return to Faq")))