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

ENH enforce deadline bounds in action trees

This commit is contained in:
Nathan Dwarshuis 2022-05-03 23:04:26 -04:00
parent 6fea9ebb17
commit 666d18f01f
1 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -701,6 +701,14 @@ used for optimization."
,done-form* ,done-form*
,open-form*))))) ,open-form*)))))
(defun org-x-dag-action-dead-after-parent-p (ancestry deadline)
(let ((this (-some->> deadline
(org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime)))
(parent (plist-get ancestry :parent-deadline)))
(when (and this parent)
(< parent this))))
(defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss) (defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss)
(cl-flet (cl-flet
((new-proj ((new-proj
@ -741,6 +749,8 @@ used for optimization."
(either :left "Projects cannot be scheduled")) (either :left "Projects cannot be scheduled"))
((and child-bss (plist-get node-data :effort)) ((and child-bss (plist-get node-data :effort))
(either :left "Projects cannot have 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) ((equal it-todo org-x-kw-todo)
(org-x-dag-bs-action-rankfold-children child-bss task-default (org-x-dag-bs-action-rankfold-children child-bss task-default
(lambda (acc next) (lambda (acc next)
@ -905,6 +915,8 @@ used for optimization."
(either :left "Sub-iterators with children cannot be deadlined")) (either :left "Sub-iterators with children cannot be deadlined"))
((org-x-dag-node-data-is-iterator-p node-data) ((org-x-dag-node-data-is-iterator-p node-data)
(either :left "Iterators cannot be nested")) (either :left "Iterators cannot be nested"))
((org-x-dag-action-dead-after-parent-p ancestry dead)
(either :left "Sub-iterator deadline must not start after parent"))
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(org-x-dag-bs-action-subiter-todo-fold child-bss (org-x-dag-bs-action-subiter-todo-fold child-bss
"sub-iterator" :si-active "sub-iterator" :si-active
@ -918,8 +930,8 @@ used for optimization."
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime (org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime
"iterators" :iter-complete) "iterators" :iter-complete)
(cond (cond
((and child-bss (-some->> it-planning (org-ml-get-property :scheduled))) (it-planning
(either :left "Iterators cannot be scheduled")) (either :left "Iterators cannot be scheduled or deadlined"))
;; TODO also check for timeshift and archive props ;; TODO also check for timeshift and archive props
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(org-x-dag-bs-action-subiter-todo-fold child-bss (org-x-dag-bs-action-subiter-todo-fold child-bss
@ -1020,10 +1032,20 @@ used for optimization."
deep)))) deep))))
(defun org-x-dag-bs-action-new-ancestry (node-meta parent-ancestry) (defun org-x-dag-bs-action-new-ancestry (node-meta parent-ancestry)
(-let (((&plist :canceled-parent-p c :held-parent-p h) parent-ancestry) (-let* (((&plist :canceled-parent-p c :held-parent-p h :parent-deadline d)
((&plist :todo) node-meta)) parent-ancestry)
((&plist :todo :planning) node-meta)
(deadline (-some->> planning
(org-ml-get-property :deadline)
(org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime))))
(list :canceled-parent-p (or c (equal todo org-x-kw-canc)) (list :canceled-parent-p (or c (equal todo org-x-kw-canc))
:held-parent-p (or h (equal todo org-x-kw-hold))))) :held-parent-p (or h (equal todo org-x-kw-hold))
:parent-deadline (cond
((not d) deadline)
((not deadline) d)
((< deadline d) deadline)
(t d)))))
(defun org-x-dag-bs-action-subiter (tree ancestry) (defun org-x-dag-bs-action-subiter (tree ancestry)
(org-x-dag-bs-with-children-1 (org-x-dag-bs-with-children-1