ENH make iterator date logic simpler

local/lib/org-x/org-x-dag.el

@@ -155,7 +155,7 @@
                        (org-x-dag-datetime-to-date datetime1)))
 
 (defun org-x-dag-datetime-max (datetimes)
-  (-max-by #'org-x-dag-datetime< datetimes))
+  (-max-by #'org-x-dag-datetime> datetimes))
 
 (defun org-x-dag-date-max (datetimes)
   (-max-by #'org-x-dag-date< datetimes))
@@ -1001,7 +1001,8 @@ deadline (eg via epoch time) or if it has a repeater."
         ((or `(:si-task :task-complete ,_) `(:si-proj :proj-complete ,_)) t)
         (_ nil)))))
 
-(defun org-x-dag-bs-action-subiter-todo-fold (child-bss default trans-fun)
+(defun org-x-dag-bs-action-subiter-todo-fold
+    (child-bss default complete-default new-active-fun)
   (declare (indent 2))
   (cl-flet*
       ((fmt-left
@@ -1025,7 +1026,7 @@ deadline (eg via epoch time) or if it has a repeater."
           (org-x-dag-with-datetimes
            a b
            (lambda (a b)
-             (either :right (org-x-dag-pts-compare a b)))
+             (either :right (org-x-dag-datetime-compare a b)))
            (-const (either :left 'length))))))
        (comp2right
         (sched? comp)
@@ -1042,7 +1043,13 @@ deadline (eg via epoch time) or if it has a repeater."
        (sym-left-2
         (sched-sym dead-sym)
         (if (eq sched-sym dead-sym) (fmt-left-both (left2err sched-sym))
-          (fmt-left-2 (left2err sched-sym) (left2err dead-sym)))))
+          (fmt-left-2 (left2err sched-sym) (left2err dead-sym))))
+       (new-active
+        (ts-data child-scheds)
+        (->> (list :dead (plist-get ts-data :dead)
+                   :child-sched-dts child-scheds
+                   :leading-sched-dt (org-x-dag-datetime-max child-scheds))
+             (funcall new-active-fun))))
     (org-x-dag-bs-action-rankfold-children child-bss default
       (lambda (acc next)
         (pcase `(,acc ,next)
@@ -1083,18 +1090,20 @@ deadline (eg via epoch time) or if it has a repeater."
           (`(:si-proj :proj-active ,d) (plist-get d :child-scheds))
           (`(:si-task :task-active ,d) (-some-> (plist-get d :sched) (list)))
           (_ nil)))
-      trans-fun)))
+      (lambda (acc cs)
+        (pcase acc
+          ((or `(:si-task :task-complete ,_) `(:si-proj :proj-complete ,_))
+           complete-default)
+          (`(:si-proj :proj-active ,ts-data)
+           (new-active ts-data cs))
+          (`(:si-task :task-active ,ts-data)
+           (new-active ts-data cs))
+          (e (error "Invalid pattern: %s" e)))))))
 
 (defun org-x-dag-node-is-iterator-p (node)
   (org-x-dag-node-data-is-iterator-p (plist-get node :node-meta)))
 
 (defun org-x-dag-bs-action-subiter-inner (node-data ancestry child-bss)
-  (cl-flet
-      ((new-active-proj
-        (d s cs)
-        (->> (list :dead d :child-scheds cs :leading-sched s)
-             (list :si-proj :proj-active)
-             (either :right))))
   (org-x-dag-bs-action-with-closed node-data ancestry "sub-iterators"
     (if child-bss
         `(:si-proj :proj-complete ,it-comptime)
@@ -1128,31 +1137,17 @@ deadline (eg via epoch time) or if it has a repeater."
         (either :left "Deadlined sub-iterators cannot be ranged"))
        ((member it-todo (list org-x-kw-todo org-x-kw-wait))
         (org-x-dag-bs-action-subiter-todo-fold child-bss
-              `(:si-task :task-active (:sched ,sp :dead ,dp))
-            (lambda (acc cs)
-              (pcase acc
-                ((or `(:si-proj :proj-complete ,_)
-                     `(:si-task :task-complete ,_))
-                 (-> "Active sub-iterator must have at least one active child"
-                     (org-x-dag-left)))
-                (`(:si-proj :proj-active ,ts-data)
-                 (-let (((&plist :dead d :leading-sched s) ts-data))
-                   (new-active-proj d s cs)))
-                (`(:si-task :task-active ,ts-data)
-                 (-let (((&plist :dead d) ts-data)
-                        ((&plist :datetime s) (org-x-dag-pts-max cs)))
-                   (new-active-proj d s cs)))
-                (e (error "Invalid pattern: %s" e))))))
+            (->> (list :sched (plist-get sp :datetime)
+                       :dead (plist-get dp :datetime))
+                 (list :si-task :task-active))
+          (->> "Active sub-iterator must have at least one active child"
+               (either :left))
+          (lambda (data)
+            (either :right `(:si-proj :proj-active ,data)))))
        (t
-          (org-x-dag-bs-error-kw "Sub-iterator" it-todo)))))))
+        (org-x-dag-bs-error-kw "Sub-iterator" it-todo))))))
 
 (defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss)
-  (cl-flet
-      ((new-active-iter
-        (d s cs)
-        (->> (list :dead d :child-scheds cs :leading-sched s)
-             (list :iter-nonempty :nonempty-active)
-             (either :right))))
   (org-x-dag-bs-action-with-closed node-data ancestry "iterators"
     `(:iter-empty :empty-complete ,it-comptime)
     (org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime "iterators"
@@ -1163,22 +1158,13 @@ deadline (eg via epoch time) or if it has a repeater."
       (either :left "Iterators cannot be scheduled or deadlined"))
      ;; TODO also check for timeshift and archive props
      ((equal it-todo org-x-kw-todo)
-        (org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty :empty-active)
-          (lambda (acc cs)
-            (pcase acc
-              ((or `(:si-task :task-complete ,_)
-                   `(:si-proj :proj-complete ,_))
-               (either :right '(:iter-nonempty :nonempty-complete)))
-              (`(:si-task :task-active ,ts-data)
-               (-let* (((&plist :dead d) ts-data)
-                       ((&plist :datetime s) (org-x-dag-pts-max cs)))
-                 (new-active-iter d s cs)))
-              (`(:si-proj :proj-active ,ts-data)
-               (-let (((&plist :dead d :leading-sched s) ts-data))
-                 (new-active-iter d s cs)))
-              (e (error "Invalid pattern: %s" e))))))
+      (org-x-dag-bs-action-subiter-todo-fold child-bss
+          '(:iter-empty :empty-active)
+        (either :right '(:iter-nonempty :nonempty-complete))
+        (lambda (data)
+          (either :right `(:iter-nonempty :nonempty-active ,data)))))
      (t
-        (org-x-dag-bs-error-kw "Iterator" it-todo))))))
+      (org-x-dag-bs-error-kw "Iterator" it-todo)))))
 
 (defun org-x-dag-bs-epg-inner (node ancestry child-bss)
   (let ((is-complete

local/lib/org-x/test/org-x-dag-test.el

@@ -42,6 +42,10 @@
   (->> (org-ml-from-string 'timestamp s)
        (org-x-dag-partition-timestamp)))
 
+(defun timestamp-to-datetime (s)
+  (->> (org-ml-from-string 'timestamp s)
+       (org-ml-timestamp-get-start-time)))
+
 (buttercup-define-matcher :to-be-left-with (a x)
   (cl-destructuring-bind
       ((a-expr . a) (x-expr . x))
@@ -280,13 +284,13 @@
 
     (describe "Iterators"
       (it "Active non-empty"
-        (let ((s0 (partition-timestamp "<2022-06-07 Tue>"))
-              (s1 (partition-timestamp "<2022-06-14 Tue>"))
-              (s2 (partition-timestamp "<2022-06-21 Tue>")))
+        (let ((s0 (timestamp-to-datetime "<2022-06-07 Tue>"))
+              (s1 (timestamp-to-datetime "<2022-06-14 Tue>"))
+              (s2 (timestamp-to-datetime "<2022-06-21 Tue>")))
           (expect "2711e9b9-f765-415d-930f-b7ff16b3140b" :id-to-be-action
                   nil nil nil :sp-iter '(:iter-nonempty :nonempty-active)
-                  (list :child-scheds `(,s0 ,s1 ,s2)
-                        :leading-sched (plist-get s2 :datetime)
+                  (list :child-sched-dts `(,s0 ,s1 ,s2)
+                        :leading-sched-dt s2
                         :dead nil)))))))
 
 (provide 'org-x-dag-test)