Merge pull request #345 from kilianmh/feat/define-dao-class

Feat: add define-dao-class

postmodern/package.lisp

@@ -8,6 +8,7 @@
   #+postmodern-use-mop
   (:export
    #:dao-class #:dao-exists-p #:dao-keys #:query-dao #:select-dao #:get-dao
+   #:define-dao-class
    #:fetch-defaults
    #:do-query-dao #:do-select-dao
    #:with-column-writers

postmodern/table.lisp

@@ -929,3 +929,26 @@ own queries to add them, in which case look to s-sql's create-table function."
                                            `(:default ,(column-default slot)))))
                    ,@(when (and (dao-keys table) (not (find-primary-key-column table)))
                        `((:primary-key ,@(dao-keys table)))))))
+
+(defmacro define-dao-class (name direct-superclasses direct-slots &rest options)
+  "Like defclass except two postmodern specific changes:
+1. The dao-class metaclass options is automatically added.
+2. If second value in a slot is not a keyword, it is assumed to be col-type.
+
+Example:
+(define-dao-class id-class ()
+  ((id integer :initarg :id :accessor test-id)
+   (email :col-type text :initarg :email :accessor email))
+  (:keys id))"
+  (flet ((expand-slot (rest)
+	   (let ((second
+		   (second rest)))
+	     (if (keywordp second)
+		 rest
+		 (cons (first rest)
+		       (append (list :col-type second)
+			       (cddr rest)))))))
+    (list* 'defclass name direct-superclasses
+	   (mapcar #'expand-slot direct-slots)
+	   (list :metaclass 'dao-class)
+	   options)))

postmodern/tests/test-dao.lisp

@@ -1570,3 +1570,31 @@ Note that you need to handle :NULLs."
       (fiveam:is (equal
                   (pomo::field-name-to-slot-name (find-class 'postmodern-tests::listy) "r-list")
                   'postmodern-tests::r-list)))
+
+(define-dao-class test-define-dao-class ()
+  ((id integer :initarg :id :accessor test-id)
+   (a :col-type text :initarg :a :accessor test-a))
+  (:table-name test-define-dao-class)
+  (:documentation "test-codumentation")
+  (:keys id))
+
+(test define-dao-class
+  (is (equal (macroexpand-1
+	      '(define-dao-class test-define-dao-class ()
+		((id integer :initarg :id :accessor test-id)
+		 (a :col-type text :initarg :a :accessor test-a))
+		(:table-name test-define-dao-class)
+		(:keys id)))
+	     '(defclass test-define-dao-class nil
+	       ((id :col-type integer :initarg :id :accessor test-id)
+		(a :col-type text :initarg :a :accessor test-a))
+	       (:metaclass dao-class) (:table-name test-define-dao-class)
+	       (:keys id))))
+  (let ((class
+	  (class-of (make-instance 'test-define-dao-class))))
+    (is (eq (pomo::find-col-type class 'id)
+	    'integer))
+    (is (eq (pomo::find-col-type class 'a)
+	    'text))
+    (is (equal (dao-keys class)
+	       (list 'id)))))