From 39889715754e1eaa7fb7b329b4dafa81c8c96bff Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 19 Apr 2022 23:52:55 -0400
Subject: [PATCH] ENH make dlp error on linked to uncommitted actions

---
 local/lib/org-x/org-x-dag.el | 49 ++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 21 deletions(-)

diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el
index 1a30a0c..f1936f2 100644
--- a/local/lib/org-x/org-x-dag.el
+++ b/local/lib/org-x/org-x-dag.el
@@ -1397,7 +1397,18 @@ used for optimization."
         (->> (--mapcat (nth 1) res)
              (-uniq)
              ;; TODO ':planned' might not be the best name for these
-             (org-x-dag-ht-add-links id htbl :planned))))
+             (org-x-dag-ht-add-links id htbl :planned)))
+       (get-planned-ht
+        (htbl id)
+        (--mapcat (org-x-dag-ht-get-maybe ht-e it :planned) c))
+       (get-sched
+        (id)
+        (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id)
+          (org-ml-get-property :scheduled)
+          (org-ml-timestamp-get-start-time)))
+       (to-valid
+        (id key planning-ids)
+        (either :right `(,id ,key ,planning-ids))))
     (-let* (((&alist :lifetime ht-l
                      :endpoint ht-e
                      :survival ht-s
@@ -1407,37 +1418,33 @@ used for optimization."
              ns)
             (get-planned
              (lambda (id)
-               (let* ((c (org-x-dag-ht-get-maybe ht-a id :committed))
-                      ;; TODO this is lame
-                      (e (--mapcat (org-x-dag-ht-get-maybe ht-e it :planned) c))
-                      (l (--mapcat (org-x-dag-ht-get-maybe ht-l it :planned) c)))
-                 (-union e l))))
-            (is-valid-action
+               (let* ((c (org-x-dag-ht-get-maybe ht-a id :committed)))
+                 (-union (get-planned-ht ht-e c) (get-planned-ht ht-l c)))))
+            (is-scheduled-action
              (lambda (adjlist id)
-               (-if-let (sched (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id)
-                                 (org-ml-get-property :scheduled)
-                                 (org-ml-timestamp-get-start-time)))
-                   ;; ASSUME if the node's timestamp does not coincide with the
-                   ;; actual day in the plan it will be reflected in the buffer
-                   ;; status
+               (-if-let (sched (get-sched id))
+                   ;; ASSUME if the node's timestamp does not coincide with
+                   ;; the actual day in the plan it will be reflected in the
+                   ;; buffer status
                    (-let (((_ time) (org-x-dag-datetime-split sched)))
                      (if time
                          (either :left "Linked to action with HH:MM timestamp")
                        (if (org-x-dag-ht-get-maybe ht-a id :survivalp)
-                           ;; ASSUME (for now) that if survival flag is t
-                           ;; then there will be at least one goal (which
-                           ;; means this action is committed)
-                           (let ((s (org-x-dag-ht-get-maybe ht-a id :committed)))
-                             (either :right `(,id :survival ,s)))
+                           (to-valid id survival c)
                          (-if-let (q (funcall get-planned id))
-                             (either :right `(,id :quarterly ,q))
+                             (to-valid id :quarterly q)
                            (->> "Linked to scheduled action that isn't on QTP"
                                 (either :left))))))
                  (-if-let (w (->> (funcall get-planned id)
                                   (--mapcat (org-x-dag-ht-get-maybe ht-q it :planned))))
-                     (either :right `(,id :weekly ,w))
+                     (to-valid id :weekly w)
                    (->> "Linked to unscheduled action that isn't on WKP"
-                        (either :left)))))))
+                        (either :left))))))
+            (is-valid-action
+             (lambda (adjlist id)
+               (-if-let (c (org-x-dag-ht-get-maybe ht-a id :committed))
+                   (is-scheduled-action adjlist id)
+                 (either :left "Linked to uncommitted action")))))
       (org-x-dag-ns-with-valid ns adjlist :daily links
         `((:action ,is-valid-action))
         (lambda (id this-h res)