ADD test for project deadline

local/lib/either/either.el

@@ -36,16 +36,20 @@ left/right slot."
 
 ;; monad-y things
 
-(defmacro either>>= (either form)
+(defmacro either-as>>= (sym either form)
-  "Bind EITHER to FORM where the right slot is bound to 'it'."
+  "Bind EITHER to FORM where the right slot is bound to SYM."
-  (declare (indent 1))
+  (declare (indent 2))
   (let ((e (make-symbol "--either")))
     `(let ((,e ,either))
        (pcase ,e
          (`(:left ,_) ,e)
-         (`(:right ,it) ,form)
+         (`(:right ,,sym) ,form)
          (e (error "Learn to use monads, dummy; this isn't one: %s" e))))))
 
+(defmacro either>>= (either form)
+  "Bind EITHER to FORM where the right slot is bound to 'it'."
+  `(either-as>>= it ,either ,form))
+
 (defun either-foldM (fun init xs)
   "Mondically apply FUN to XS (a list).
 

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

@@ -851,7 +851,7 @@ deadline (eg via epoch time) or if it has a repeater."
             (< parent-epoch this-epoch))))))
 
 (defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss)
-  (cl-flet
+  (cl-flet*
       ((new-proj
         (status)
         (either :right `(:sp-proj ,status)))
@@ -861,45 +861,39 @@ deadline (eg via epoch time) or if it has a repeater."
        (is-next
         (task-data)
         (-let (((&plist :todo :sched) task-data))
-          (or sched (equal todo org-x-kw-next)))))
+          (or sched (equal todo org-x-kw-next))))
-    ;; rankings
+       (check-sched
-    ;; *-active > proj-wait > proj-held > (proj-stuck == iter-empty) > *-complete
+        (planning)
-    (org-x-dag-bs-action-with-closed node-data ancestry "projects"
+        (if-let (sched (-some->> planning (org-ml-get-property :scheduled)))
-      (if child-bss
+            (if child-bss (either :left "Projects cannot be scheduled")
-          `(:sp-proj :proj-complete ,it-comptime)
+              (let ((sp (org-x-dag-partition-timestamp sched)))
-        `(:sp-task :task-complete ,it-comptime))
+                (if (< 0 (plist-get sp :length))
-
+                    (->> "Tasks cannot have ranged scheduled timestamps"
-      (org-x-dag-bs-action-check-children child-bss
+                         (either :left))
-          (either :left "Completed projects cannot have active children")
+                  (either :right sp))))
-          (either :right `(:sp-proj :proj-complete ,it-comptime))
+          (either :right nil)))
-          `(:sp-task :task-complete ,it-comptime)
+       (check-dead
-        (lambda (local)
+        (planning)
-          (pcase local
+        (if-let (dead (-some->> planning (org-ml-get-property :deadline)))
-            (`(:sp-proj :proj-complete ,_) t)
+            (let ((dp (org-x-dag-partition-timestamp dead)))
-            (`(:sp-iter :iter-complete ,_) t)
-            (`(:sp-task :task-complete ,_) t)
-            (_ nil))))
-
-      (-let* (((sched dead) (-some->> it-planning
-                              (org-ml-get-properties '(:scheduled :deadline))))
-              (sp (-some-> sched (org-x-dag-partition-timestamp)))
-              (dp (-some-> dead (org-x-dag-partition-timestamp)))
-              (task-default (->> (list :todo it-todo :sched sp :dead dp)
-                                 (list :sp-task :task-active))))
               (cond
-         ((and child-bss (equal it-todo org-x-kw-hold))
+               ((< 0 (plist-get dp :length))
-          (new-proj :proj-held))
+                (either :left "Actions cannot have ranged deadlines"))
-         ((and child-bss sp)
+               ((and child-bss (plist-get dp :repeater))
-          (either :left "Projects cannot be scheduled"))
+                (either :left "Projects cannot have repeated deadlines"))
-         ((and sp (< 0 (plist-get sp :length)))
-          (either :left "Projects cannot have ranged scheduled timestamps"))
-         ((and dp (< 0 (plist-get dp :length)))
-          (either :left "Projects cannot have ranged deadline timestamps"))
-         ((and child-bss (plist-get node-data :effort))
-          (either :left "Projects cannot have effort"))
                ((org-x-dag-action-dead-after-parent-p ancestry dead)
                 (either :left "Action deadline cannot end after parent deadline"))
-         ((equal it-todo org-x-kw-todo)
+               (t
+                (either :right dp))))
+          (either :right nil)))
+       (check-todo
+        (todo task-default)
+        (cond
+         ((and child-bss (plist-get node-data :effort))
+          (either :left "Projects cannot have effort"))
+         ((and child-bss (equal todo org-x-kw-hold))
+          (new-proj :proj-held))
+         ((equal todo org-x-kw-todo)
           (org-x-dag-bs-action-rankfold-children child-bss task-default
             (lambda (acc next)
               (->> (pcase `(,acc ,next)
@@ -943,8 +937,8 @@ deadline (eg via epoch time) or if it has a repeater."
                      (`(,_ (:sp-task :task-active ,_)) t)
 
                      ;; any pair that makes it this far is completed in both,
-                     ;; which means neither takes precedence, which means choose
+                     ;; which means neither takes precedence, which means
-                     ;; the left one
+                     ;; choose the left one
                      (`(,_ ,_) nil))
                    (either :right)))
 
@@ -984,9 +978,36 @@ deadline (eg via epoch time) or if it has a repeater."
                     (t (org-x-dag-bs-error-kw "Task action" o)))))
                 (e (error "Pattern fail: %s" e))))))
          (child-bss
-          (org-x-dag-bs-error-kw "Project action" it-todo))
+          (org-x-dag-bs-error-kw "Project action" todo))
          (t
-          (either :right task-default)))))))
+          (either :right task-default)))))
+                    
+    ;; rankings
+    ;; *-active > proj-wait > proj-held > (proj-stuck == iter-empty) > *-complete
+    (org-x-dag-bs-action-with-closed node-data ancestry "projects"
+      (if child-bss
+          `(:sp-proj :proj-complete ,it-comptime)
+        `(:sp-task :task-complete ,it-comptime))
+
+      (org-x-dag-bs-action-check-children child-bss
+          (either :left "Completed projects cannot have active children")
+          (either :right `(:sp-proj :proj-complete ,it-comptime))
+          `(:sp-task :task-complete ,it-comptime)
+        (lambda (local)
+          (pcase local
+            (`(:sp-proj :proj-complete ,_) t)
+            (`(:sp-iter :iter-complete ,_) t)
+            (`(:sp-task :task-complete ,_) t)
+            (_ nil))))
+
+      (either-as>>= sp (check-sched it-planning)
+        (either-as>>= dp (check-dead it-planning)
+          ;; TODO it seems a bit odd that the only reason I need sp and dp here
+          ;; is to seed the sub-project task form; idk why this is weird but it
+          ;; smells like something could be optimized somewhere
+          (->> (list :todo it-todo :sched sp :dead dp)
+               (list :sp-task :task-active)
+               (check-todo it-todo)))))))
 
 (defun org-x-dag-node-data-is-iterator-p (node-data)
   (-let (((&plist :props) node-data))
@@ -1053,6 +1074,7 @@ deadline (eg via epoch time) or if it has a repeater."
         (ts-data child-scheds)
         (->> (list :dead (plist-get ts-data :dead)
                    :child-scheds child-scheds
+                   ;; TODO this can be an epoch and not a datetime
                    :leading-sched-dt (-> (org-x-dag-pts-max child-scheds)
                                          (plist-get :datetime)))
              (funcall new-active-fun))))

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

@@ -89,6 +89,20 @@ CLOSED: [2022-06-10 Fri 19:13]
 :ID:       a834a585-acd1-44e9-8e62-17793146d6ab
 :CREATED:  [2022-06-10 Fri 19:13]
 :END:
+** TODO this is a deadlined project
+DEADLINE: <2022-06-12 Sun>
+:PROPERTIES:
+:ID:       51798071-f860-48fb-b3d8-e526ce270290
+:CREATED:  [2022-06-12 Sun 18:09]
+:END:
+*** NEXT subtask
+:PROPERTIES:
+:ID:       fc1f3dda-a4b7-4b0d-b37c-fa67e112023a
+:CREATED:  [2022-06-12 Sun 18:10]
+:END:
+:LOGGING:
+- State "NEXT"       from "TODO"       [2022-06-12 Sun 18:10]
+:END:
 * iterators
 ** TODO this is an iterator
 :PROPERTIES:

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

@@ -46,6 +46,11 @@
   (->> (org-ml-from-string 'timestamp s)
        (org-ml-timestamp-get-start-time)))
 
+(defun timestamp-to-epoch (s)
+  (->> (org-ml-from-string 'timestamp s)
+       (org-ml-timestamp-get-start-time)
+       (org-ml-time-to-unixtime)))
+
 (buttercup-define-matcher :to-be-left-with (a x)
   (cl-destructuring-bind
       ((a-expr . a) (x-expr . x))
@@ -112,6 +117,14 @@
     (and (eq (org-ml-get-type a) (org-ml-get-type b))
          (plists-equal-p (get-useful-props a) (get-useful-props b)))))
 
+(defun pts-equal-p (a b)
+  (-let (((&plist :datetime da :repeater ra :warning wa :length la) a)
+         ((&plist :datetime db :repeater rb :warning wb :length lb) b))
+    (and (equal da db)
+         (equal ra rb)
+         (equal wa wb)
+         (equal la lb))))
+
 (defun plist-diff-msg (eq-funs expr a b)
   (-let (((a-diff b-diff common-diffs) (split-plists eq-funs a b)))
     (cond
@@ -173,12 +186,9 @@
     (let* ((ancestry (list :canceled-parent-p c
                            :held-parent-p h
                            :parent-deadline e))
-           (ancestry-eq-funs (list :parent-deadline #'element-equal-p))
+           (ancestry-eq-funs nil)
            (local-eq-funs (list :sched #'element-equal-p
-                                ;; TODO this is wrong
+                                :child-scheds #'pts-equal-p))
-                                :child-scheds (lambda (a b)
-                                                (seq-set-equal-p
-                                                 a b #'element-equal-p))))
            (f (->> (-partial #'status-diff-msg local-eq-funs test-expr y s d)
                    (-partial #'ancestry-diff-msg ancestry-eq-funs test-expr ancestry)
                    (-partial #'buffer-status-diff-msg test-expr :action)
@@ -280,7 +290,13 @@
       (it "Canceled"
         (expect "322af50a-f431-4940-8caf-cc5acdf5a555" :id-to-be-action
                 nil nil nil :sp-task '(:task-complete)
-                '(:canceledp t :epoch 1654903560))))
+                '(:canceledp t :epoch 1654903560)))
+
+      (it "Deadlined"
+        (let ((d (timestamp-to-epoch "<2022-06-12 Sun>")))
+          (expect "fc1f3dda-a4b7-4b0d-b37c-fa67e112023a" :id-to-be-action
+                  nil nil d :sp-task '(:task-active)
+                  '(:todo "NEXT" :sched nil :dead nil)))))
 
     (describe "Standalone Tasks"
       (it "Active"