Rename do-cursor -> do-for-dao, and make it work in all RDBMS (wi…

…thout CURSOR).
fukamachi · Aug 9, 2024 · c0d07b1 · c0d07b1
1 parent a0fb9dd
commit c0d07b1
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 12 deletions.
diff --git 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
@@ -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))