ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH make dlp error on linked to uncommitted actions

This commit is contained in:
Nathan Dwarshuis 2022-04-19 23:52:55 -04:00
parent 5bd754e9d1
commit 3988971575
1 changed files with 28 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
local/lib/org-x/org-x-dag.el
View File

@ -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)