ENH make dlp error on linked to uncommitted actions
This commit is contained in:
parent
5bd754e9d1
commit
3988971575
|
@ -1397,7 +1397,18 @@ used for optimization."
|
||||||
(->> (--mapcat (nth 1) res)
|
(->> (--mapcat (nth 1) res)
|
||||||
(-uniq)
|
(-uniq)
|
||||||
;; TODO ':planned' might not be the best name for these
|
;; 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
|
(-let* (((&alist :lifetime ht-l
|
||||||
:endpoint ht-e
|
:endpoint ht-e
|
||||||
:survival ht-s
|
:survival ht-s
|
||||||
|
@ -1407,37 +1418,33 @@ used for optimization."
|
||||||
ns)
|
ns)
|
||||||
(get-planned
|
(get-planned
|
||||||
(lambda (id)
|
(lambda (id)
|
||||||
(let* ((c (org-x-dag-ht-get-maybe ht-a id :committed))
|
(let* ((c (org-x-dag-ht-get-maybe ht-a id :committed)))
|
||||||
;; TODO this is lame
|
(-union (get-planned-ht ht-e c) (get-planned-ht ht-l c)))))
|
||||||
(e (--mapcat (org-x-dag-ht-get-maybe ht-e it :planned) c))
|
(is-scheduled-action
|
||||||
(l (--mapcat (org-x-dag-ht-get-maybe ht-l it :planned) c)))
|
|
||||||
(-union e l))))
|
|
||||||
(is-valid-action
|
|
||||||
(lambda (adjlist id)
|
(lambda (adjlist id)
|
||||||
(-if-let (sched (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id)
|
(-if-let (sched (get-sched id))
|
||||||
(org-ml-get-property :scheduled)
|
;; ASSUME if the node's timestamp does not coincide with
|
||||||
(org-ml-timestamp-get-start-time)))
|
;; the actual day in the plan it will be reflected in the
|
||||||
;; ASSUME if the node's timestamp does not coincide with the
|
;; buffer status
|
||||||
;; actual day in the plan it will be reflected in the buffer
|
|
||||||
;; status
|
|
||||||
(-let (((_ time) (org-x-dag-datetime-split sched)))
|
(-let (((_ time) (org-x-dag-datetime-split sched)))
|
||||||
(if time
|
(if time
|
||||||
(either :left "Linked to action with HH:MM timestamp")
|
(either :left "Linked to action with HH:MM timestamp")
|
||||||
(if (org-x-dag-ht-get-maybe ht-a id :survivalp)
|
(if (org-x-dag-ht-get-maybe ht-a id :survivalp)
|
||||||
;; ASSUME (for now) that if survival flag is t
|
(to-valid id survival c)
|
||||||
;; 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)))
|
|
||||||
(-if-let (q (funcall get-planned id))
|
(-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"
|
(->> "Linked to scheduled action that isn't on QTP"
|
||||||
(either :left))))))
|
(either :left))))))
|
||||||
(-if-let (w (->> (funcall get-planned id)
|
(-if-let (w (->> (funcall get-planned id)
|
||||||
(--mapcat (org-x-dag-ht-get-maybe ht-q it :planned))))
|
(--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"
|
(->> "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
|
(org-x-dag-ns-with-valid ns adjlist :daily links
|
||||||
`((:action ,is-valid-action))
|
`((:action ,is-valid-action))
|
||||||
(lambda (id this-h res)
|
(lambda (id this-h res)
|
||||||
|
|
Loading…
Reference in New Issue