(define-attributes (policy)
  (policy-type-code code-select :category 3 :label "Policy Type")
  (agent-id ajax-fkey :label "Agent")
  (company-id lol::ajax-foreign-key :label "Company")
  (insured-id lol::ajax-foreign-key :label "Insured")
  (policy-number t :label "Policy Number")
  (effective-date t :label "Effective ")
  (expiry-date t :label "Expires")
  (deductible t :label "Deductible $")
  (:viewer maxwell-viewer 
	   :attributes (policy-number 
			effective-date 
			expiry-date 
			policy-type-code 
			agent-id
			company-id
			deductable) 
	   :global-properties (:editablep nil)
	   :editablep nil)
  (:editor maxwell-object-presentation 
	   :attributes (policy-number 
			effective-date 
			expiry-date 
			policy-type-code 
			agent-id
			company-id
			deductable) 
	   :global-properties (:editablep t)
	   :editablep t)
  (:one-line mewa:mewa-one-line-presentation 
	     :attributes (policy-number effective-date expiry-date policy-type-code) 
	     :global-properties (:editablep nil)
	     :editablep nil))

<table  style="border: 1px solid #666666;" align="center" cellpadding="0" cellspacing="0">
<tr><td style="padding: 8px; font-weight: bold; text-align: center; background-color: #EEEEEE;">
<form method="get" action="http://usseek.com/system/search.cgi"> 
Search <select name="mode"> 
 <option value="internet" selected="1">the web</option> 
 <option value="images" >images</option> 
 </select> 
for <input type="text" name="string" value="" style="width: 250px;"> 
in: 
<select name="language"> 
 <option value="lang_de">German</option> 
 <option value="lang_da">Danish</option> 
 <option value="lang_en" selected>English</option> 
 <option value="lang_es">Spanish</option> 
 <option value="lang_fr">French</option> 
 <option value="lang_it">Italian</option> 
 <option value="lang_no">Norwegian</option> 
 <option value="lang_sv">Swedish</option> 
 <option value="lang_cs">Czech</option> 
 <option value="lang_nl">Dutch</option> 
 <option value="lang_pl">Polish</option> 
 <option value="lang_ru">Russian</option> 
 <option value="lang_fi">Finnish</option> 
 </select>
<input type="submit" value="Search">
</form>
</td></tr>
</table>  	

;;;; * 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")))

(in-package :maxwell-web-gui)

;;;; * A simple User component

;;;; ** The database tables .

;;;; Postgresql is the only way to go.
;;;; (actually, LoL will work with any lisp data type,
;;;; but one has to set up the meta-model manually)

;;;; the only flaw is that "user" is a
;;;; reserverd word in sql, and the generator
;;;; is not very smart.

;;;; you'll want to remove the #+(or) if you plan
;;;; to create the tables in lisp.

#+ (or)
(clsql:execute-command "
DROP TABLE app_user;
CREATE TABLE app_user ( 
 app_user_id SERIAL PRIMARY KEY,
 username TEXT,
 password TEXT,
 person_id INTEGER REFERENCES person(person_id)
);")


#+(or) (clsql:execute-command "
CREATE TABLE app_resource (
 app_resource_id SERIAL PRIMARY KEY,
 description TEXT,
 code TEXT
);")

#+ (or) (clsql:execute-command "
CREATE TABLE app_user_app_resource (
 app_user_app_resource_id SERIAL PRIMARY KEY,
 app_user_id INTEGER REFERENCES app_user(app_user_id),
 app_resource_id INTEGER REFERENCES app_resource(app_resource_id)
);")


;;;; This is a macro that seta up a meta-model,
;;;; a clsql view-class and sets
;;;; the default mewa attributes.
;;;; when developing at the REPL, you can use
;;;; it to redefine your view classes.
;;;; When compiling an app, it is better to use
;;;; LOL:DEFINE-VIEWS-FOR-DATABASE 

;;;; (lol:define-view-for-table "app_user")
;;;; (lol:define-view-for-table "app_user_app_resource")


(define-attributes (app-user)
  (person-id ajax-fkey)
  (username t :label "User Name")
  (:one-line mewa-one-line-presentation
	     :attributes (username person-id)
	     :global-properties (:editablep nil))
  (:creator maxwell-editor
	   :attributes
	   ((username :label "Please enter a User Name. This is the name this person will use to login.")
	    (password :label "Enter a password for this user.")
	    (person-id :label "Select the person or company associated with this login."))))


;;;; ** User Resource Component.
(define-attributes (app-user-app-resource)
  (app-resource-id ajax-fkey)
  (:editor t :attributes ((app-user-id :editablep nil :label "User")
			  (app-resource-id :label "Select a Resource")))
  (:one-line t :attributes ((app-resource-id :editablep nil))))


#+(or)
(mapcar #'meta-model:sync-instance
	(mapcar #'(lambda (init-args)
		    (apply #'make-instance 'app-resource init-args))
		'((:description "User Manager" :code "USER")
		  (:description "Recent Changes" :code "RECENT"))))


;;;; Fist thing we need is to add some users.
(defaction create-user ((c component))
  (let ((new-user (make-instance 'app-user)))
    (lol:call-view (new-user :creator))))


;;;; We'd like to be able to view them as well.
(defaction view-user ((c component) user)
  (lol:call-view (user :viewer)))

(defun list-users ()
  (clsql:select 'app-user :flatp t))

(defcomponent user-manager ()
  ())

(defmethod render-on ((res response) (self user-manager))
  (<:h2 (<:as-html "User Manager"))  
  (<ucw:a :action (create-user self) (<:as-html "Create User"))
  (<:h3 (<:as-html "All Users :"))
  (<:ul
   (arnesi:dolist* (u (list-users))
     (<:li (<ucw:a :action (view-user self u)
		   (lol:present-view (u :one-line)))))))