[cells-devel] my very first baby steps with cells

[Friedrich Dominicus]

I spend nearly the whole weekend on gettign a bit further. My code is
not this:

(in-package :qss.web)

;; (use-package :cells)
(eval-when (:compile-toplevel :execute)
(defparameter *example-app*
  (make-instance 'cookie-session-application
                 :url-prefix "/ucw/examples/"
                 :tal-generator (make-instance 'yaclml:file-system-generator
                                               :cachep t
                                               :root-directories (list *ucw-tal-root*))
                 :www-roots (list *ucw-tal-root*))))

;; (register-application *default-server* *example-app*)

(cells:defmodel controller (cells:model)
  ((view-obj :accessor view-obj :cell t
             :initarg :view-obj :initform (cells:c-in nil))
   (db-obj :accessor db-obj :initarg :db-obj :cell t 
           :initform (cells:c? (update-from-view cells:self)))))


(clsql:def-view-class example-app ()
  ((id :type integer :db-kind :key :accessor id :initarg :id)
   (tag :type string :accessor tag :initarg :tag)
   (description :type string :accessor description :initarg :description)
   (some-fk :type integer :accessor some-fk :initarg :some-fk)
   (some-objects :accessor some-objects
                  :db-kind :join
                  :db-info (:join-class other-class
                                        :retrieval :deferred
                                        :set nil
                                        :foreign-key example-id
                                        :home-key id))))


(clsql:def-view-class other-class ()
  ((example-id :type integer :accessor example-id :initarg :example-id)
   (val :type string :accessor val  :initarg :val)))



;; (clsql:create-view-from-class 'simple-db)


                               

(defmethod update-from-view ((controller controller))
  (with-accessors ((db-obj db-obj) (view-obj view-obj))
    controller
    (inspect controller)
    ;; view should steer the database object usually
    (let ((other (some-objects db-obj)))
      (setf (tag db-obj) (read-client-value (tag view-obj))
            (description db-obj) (read-client-value (description view-obj))
            (val other) (read-client-value (other view-obj)))
      (clsql:update-records-from-instance db-obj))
    (values)))
          

   
   
   




(defun populate-db ()
  (let ((other (make-instance 'other-class
                              :example-id 1
                              :val "some text")))
    (clsql:update-records-from-instance other)
    (let ((mobj (make-instance 'example-app
                               :id 1
                               :tag "some tag"
                               :description "this is the description"
                               :some-fk 1)))
      (setf (some-objects mobj) other)
      (clsql:update-records-from-instance mobj))))

;; (clsql:drop-view-from-class 'other-class)
;; (clsql:drop-view-from-class 'example-app)

;; 
;; (clsql:create-view-from-class 'example-app)
;; (clsql:create-view-from-class 'other-class)
;; (populate-db)


    
        


(defcomponent example-view (simple-window-component)
  ((db-obj :initarg :db-obj :reader db-obj)
   (tag :accessor tag :initarg :tag
        :component (text-field :size 20 :maxlength 20))
   (description :type string :accessor description :initarg :description
                :component (text-area-field :width 20 :height 10))
   (other :accessor other :component (text-field :size 20 :maxlength 20))))


(defun setup-db ()
        ;; open a connectoin to DB
  (clsql:enable-sql-reader-syntax))


;; (setup-db)

(defcomponent text (simple-window-component)
  ((view-text :initarg :view-text :reader view-text)
   (db-text :initarg :db-text :reader db-text)))
         
     

(defmethod render-on ((res response) (text text))
  (inspect text)
  (<:p "view data: "
       (<:as-is (view-text text)))
  (<:p "database data: "
       (<:as-is (db-text text))))

(defmethod initialize-vfd ((view example-view) (controller controller))
  (let ((db-obj (db-obj controller)))

    (setf (some-objects db-obj) (car (clsql:select 'other-class 
                                                  :where [= [example-id] 1]
                                                  :flatp t)))
    ;; (inspect db-obj)
    (clsql:update-records-from-instance db-obj)
    (setf (ucw::client-value (tag view)) (tag db-obj)
          (ucw::client-value (description view)) (description db-obj )
          (ucw::client-value (other view )) (val (some-objects db-obj ))
          (view-obj controller) view)
    (inspect controller)
  (values)))

  
   
    

(defmethod render-on ((res response) (view example-view))
  ;; this is not perfect but for the example it should be enough
  ;; (inspect view)
  (let ((controller (make-instance 'controller)))
    (setf (db-obj controller) (slot-value view 'db-obj))
    (initialize-vfd view controller)
    (inspect controller)
    (<ucw:form :action (save-and-show-data view controller)
               (<:table 
                (<:tr
                 (<:td "tag")
                 (<:td "Description")
                 (<:td "Other text"))
                (<:tr
                 (<:td (render-on res (tag view)))
                 (<:td (render-on res (description view)))
                 (<:td (render-on res (other view)))))
               (<:p (<:input :type "submit" :value "Accept")))))


  
(defaction save-and-show-data ((view example-view) (controller controller))
  (call 'text :view-text (format nil "tag = ~a, descripton = ~a, other-text = ~a~%"
                                 (read-client-value (tag (view-obj controller)))
                                 (read-client-value (description (view-obj controller)))
                                 (read-client-value (other (view-obj controller))))
        :db-text (format nil "tag = ~a, descripton = ~a, other-text = ~a~%"
                         (tag (db-obj controller))
                         (description (db-obj controller))
                         (val (some-objects (db-obj controller))))))

  
          
    

(defun init-cells ()
  (clsql:enable-sql-reader-syntax)
  (cells:cell-reset))



(defentry-point "index.ucw" (:application *example-app*) ()
  (init-cells)
  (call 'example-view :db-obj (car (clsql:select 'example-app 
                                                 :where [= [id] 1]
                                                 :flatp t
                                                 :refresh t)))

my problem update-from-view is not called I was thinking that 
   (db-obj :accessor db-obj :initarg :db-obj :cell t 
           :initform (cells:c? (update-from-view cells:self)))))

is reponsible for it. But of course I'm set'fing the db-obj slot also,
out come is that 
1) the view is initialized from the db-view
2) that the db-view won't get changed. 

I'm sure it could be done but I don't know how, could someone give me
a hand please?

Regards
Friedrich