diff --git a/src/core/dao.lisp b/src/core/dao.lisp index 0dc3803..8495744 100644 --- a/src/core/dao.lisp +++ b/src/core/dao.lisp @@ -62,7 +62,7 @@ #:recreate-table #:ensure-table-exists #:deftable - #:do-cursor)) + #:do-for-dao)) (in-package #:mito.dao) (defun foreign-value (obj slot) @@ -453,15 +453,22 @@ `((:conc-name ,(intern (format nil "~@:(~A-~)" name) (symbol-package name))))) ,@options)) -(defmacro do-cursor ((dao select &optional index) &body body) - (with-gensyms (main cursor) - `(flet ((,main () - (let* ((*want-cursor* t) - (,cursor ,select)) - (loop ,@(and index `(for ,index from 0)) - for ,dao = (fetch-dao-from-cursor ,cursor) - while ,dao - do (progn ,@body))))) +(defmacro do-for-dao ((dao select &optional index) &body body) + (with-gensyms (main main-body cursor) + `(labels ((,main-body () + ,@body) + (,main () + (let ((,cursor (let ((*want-cursor* t)) + ,select))) + (typecase ,cursor + (list (loop ,@(and index `(for ,index from 0)) + for ,dao in ,cursor + do (,main-body))) + (otherwise + (loop ,@(and index `(for ,index from 0)) + for ,dao = (fetch-dao-from-cursor ,cursor) + while ,dao + do (,main-body))))))) (if (dbi:in-transaction *connection*) (,main) (dbi:with-transaction *connection* diff --git a/t/dao.lisp b/t/dao.lisp index 744a266..460c14e 100644 --- a/t/dao.lisp +++ b/t/dao.lisp @@ -270,8 +270,8 @@ (ok (null (mito.dao::fetch-dao-from-cursor cursor))))) (let ((records '())) - (do-cursor (dao (mito.dao:select-dao 'user) i) - (push (cons i dao) records) + (do-for-dao (user (mito.dao:select-dao 'user) i) + (push (cons i user) records) (when (<= 1 i) (return))) (ok (= (length records) 2))