[Bese-devel] questions

[Friedrich Dominicus]

"Marco Baringer" <mb at bese.it> writes:

>
> no, it falls into the "think of a good way and help marco implement
> it". i'd really really like to see ucw have a nice form api
> (validation, marshalling and java script alerting are good starting
> points), i just can't seem to come up with it. this would be as good a
> time as any to start stealing ideas from other libs.
>
> in the mean time we could setup an initialize-instance method
> which passed initargs to slots which were know to be form elements. or
> even better we could create a form-class (a subclass of
> standard-component-class) and all the bells and whistles we want. we'd
> just need to come up with a short list of what a form class sholud
> look like and rework the form components (i'd be more than happy to
> put time into this).

Well I have asked similiar stuff before and was looking for a
"somehwat" nice solution. However what I thought and think about this
is to have the backend (application) and the frontend (UCW-views)
synced. I've now come up with something along this lines:

(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-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))
  (print "in update-from-view"  *error-output*)

  (unless (slot-value controller 'db-obj)
    (print "in unless " *error-output*)
    ;; (inspect (db-obj (view-obj controller)))
    (setf (slot-value controller 'db-obj) (db-obj (view-obj controller))))
    
      ;; (inspect controller)
    ;; view should steer the database object usually
    (let* ((db-obj (slot-value controller 'db-obj))
           (view (view-obj controller))
           (other (some-objects db-obj)))
      (setf (tag db-obj) (read-client-value 
                          (tag view))
            (description db-obj) (read-client-value 
                                  (description view))
            (val other) (read-client-value 
                         (other view)))

      (clsql:update-records-from-instance db-obj)
      (print "in update-from-view before inspect" *error-output*)
      ;; (inspect controller)
      ;; (setf (slot-value controller 'db-obj) db-obj))
      (slot-value controller 'db-obj)))
          

   
   
   




(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")))
      (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 ()
 ;; connect to database
  (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))
  ;; g(inspect text)
  (<:p "view data: "
       (<:as-is (view-text text)))
  (<:p "database data: "
       (<:as-is (db-text text))))

(defmethod init-view ((view example-view))
  (let ((db-obj (db-obj view)))
    
    (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))
  
   
    

(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
                                   :view-obj (cells:c-in (init-view view)))))
    ;;(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))
  (print "in save-and-show-data" *error-output*)
  ;; (inspect (view-obj controller))
  ;; (inspect (db-obj 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))))

Well I agree it's ugly at the moment but the idea  was is to formulate
an algorithm which keeps front and backend objects in sync. I have
started to look and use Kenny tiltons Cells for it. What is still
inelegant is that I have to manual code the filling of the view
slots. 

The nice thing about the code above it that you implement the update
logic once and from there one it "just" works. 

I would think a sort of "connect-slots" or the like would be
"good" to have. 
Maybe one then could write something like:
(connect-slots view backend :initialize-function #'init-func
                            :steer-function #'steer-func
                            :slots '(a b c)) ; maybe not needed if you
have the init-fun and steer-func stuff. 

or maybe 
(connect-slots view backend :sync '((a #'init-slot-a #'steer-slot-a)
                                    (b #'init-slot-b #'steer-slot-b)))


The other way (not yet checked and tested) may be to break out the Present/Accept model
from CLIM. 


Regards
Friedrich