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

[Friedrich Dominicus]

I got it (probably ;-), would someone mind to comment on it?

(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))
  (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"
                               :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 ()

  (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 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 "other.ucw" (:application *example-app*) ()
  (init-cells)
  (call 'example-view :db-obj (car (clsql:select 'example-app 
                                                 :where [= [id] 1]
                                                 :flatp t
                                                 :refresh t)))


I this a decent use of 'cells and is it cells-ish? 

Regards
Friedrich