(define *field-lists* (make-parameter '()))

; Record Type Definitions
(define object-user-fields '(name
			      type
			      description
			      image))

(define object-auto-fields '(node-id
			      seqno
			      version
			      created
			      last-modified
			      created-by-node-id
			      created-by-seqno
			      last-modified-by-node-id
			      last-modified-by-seqno))

(define object-rtd (make-record-type
		 'object
		 `(,@object-user-fields ,@object-auto-fields)))


(define make-object (record-constructor object-rtd object-user-fields))

(*field-lists* (cons `(,object-rtd . (,@object-user-fields ,@object-auto-fields))
		     (*field-lists*)))



; Methods to convert records to SSQL
(define (INSERT table-name rtd record)
  (let ((field-list (or (alist-ref rtd (*field-lists*)) '())))
    `(insert (into ,table-name)
	     (columns ,@field-list)
	     (values #(,@(map (lambda (field)
				((record-accessor rtd field) record))
			      field-list))))))


(define (field-setter rtd object)
  (let ((set (cut record-modifier rtd <>)))
    (lambda (field value)
      ((set field) object value))))

; define procedures to manipulate the objects table.
(define (object-create instance)
  (let ((set (field-setter object-rtd instance))
	(now (current-seconds))
	(node-id (get-node-id))
	(seqno (get-seqno))
	(user-node-id (user-node-id (current-user)))
	(user-seqno (user-seqno (current-user))))
    (set 'node-id node-id)
    (set 'seqno seqno)
    (set 'version 0)
    (set 'created now)
    (set 'last-modified now)
    (set 'created-by-node-id user-node-id)
    (set 'created-by-seqno   user-seqno)
    (set 'last-modified-by-node-id user-node-id)
    (set 'last-modified-by-seqno   user-seqno)
    (printf "creating object ~A:~A\n" node-id seqno)
    (INSERT "objects" object-rtd instance)
  ))

(define (object-read id)
  (printf "reading  object ~A\n" id))

(define (object-update id)
  (printf "updating object ~A\n" id))

(define (object-delete id)
  (printf "deleting object ~A\n" id))


(define (state dispatch-table)
    (lambda (verb . params)
      (or (and-let* ((proc (alist-ref verb dispatch-table)))
		    (apply proc params))
	  (abort (conc "Not a valid verb for this type of object: " verb)))))


; for now: the objects procedures are for a table, not a domain object!
;   the difference is around DB transactions and who sends the queries.
(define object (state `((create . ,object-create)
			(read   . ,object-read)
			(update . ,object-update)
			(delete . ,object-delete))))
(define (hub-make name description image)
 (make-object name 'hub description image))

(define (hub-create id)
  (printf "creating ~A\n" id)
  (object-create id))


(define hub (state `((make   . ,hub-make)
		     (create . ,object-create))))