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

ENH make buffer status trees accululate scheduled timestamps

This commit is contained in:
Nathan Dwarshuis 2022-06-05 12:27:12 -04:00
parent a74dd98e4d
commit 69237c720e
1 changed files with 27 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -933,18 +933,18 @@ deadline (eg via epoch time) or if it has a repeater."
(-when-let (p (alist-get org-x-prop-parent-type props nil nil #'equal)) (-when-let (p (alist-get org-x-prop-parent-type props nil nil #'equal))
(equal p org-x-prop-parent-type-iterator)))) (equal p org-x-prop-parent-type-iterator))))
(defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name) (defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name
(declare (indent 2)) success-fun
(let ((ret `(,(if child-bss :si-proj :si-task) ,comptime))) childless-fun)
(declare (indent 3))
(org-x-dag-bs-action-check-children child-bss (org-x-dag-bs-action-check-children child-bss
(either :left "Completed sub-iterators cannot have active children") (org-x-dag-left "Completed %s cannot have active children" type-name)
(either :right ret) (either :right (funcall success-fun comptime))
ret (funcall childless-fun comptime)
(lambda (local) (lambda (local)
(pcase local (pcase local
(`(:si-task :task-complete ,_) t) ((or `(:si-task :task-complete ,_) `(:si-proj :proj-complete ,_)) t)
(`(:si-proj :proj-complete ,_) t) (_ nil)))))
(_ nil))))))
(defun org-x-dag-bs-action-subiter-todo-fold (child-bss default trans-fun) (defun org-x-dag-bs-action-subiter-todo-fold (child-bss default trans-fun)
(declare (indent 2)) (declare (indent 2))
@ -985,13 +985,13 @@ deadline (eg via epoch time) or if it has a repeater."
(`(,_ ,_) (either :right nil)))) (`(,_ ,_) (either :right nil))))
(lambda (next) (lambda (next)
(pcase next (pcase next
((or (:si-task :task-active ,_) `(:si-proj :proj-active ,_)) t) ((or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)) t)
(_ nil))) (_ nil)))
(lambda (next) (lambda (next)
(pcase next (pcase next
(`(:si-proj :proj-active ,d) (plist-get d :child-scheds)) (`(:si-proj :proj-active ,d) (plist-get d :child-scheds))
(`(:si-task :task-active ,d) (list (plist-get d :sched))) (`(:si-task :task-active ,d) (list (plist-get d :sched)))
(,_ nil))) (_ nil)))
trans-fun)) trans-fun))
(defun org-x-dag-node-is-iterator-p (node) (defun org-x-dag-node-is-iterator-p (node)
@ -1009,16 +1009,10 @@ deadline (eg via epoch time) or if it has a repeater."
`(:si-proj :proj-complete ,it-comptime) `(:si-proj :proj-complete ,it-comptime)
`(:si-task :task-complete ,it-comptime)) `(:si-task :task-complete ,it-comptime))
(let ((ret `(:si-proj :proj-complete ,comptime))) (org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime
(org-x-dag-bs-action-check-children child-bss "sub-iterators"
(either :left "Completed sub-iterators cannot have active children") (lambda (c) `(:si-proj :proj-complete ,c))
(either :right ret) (lambda (c) `(:si-task :task-complete ,c)))
ret
(lambda (local)
(pcase local
(`(:si-task :task-complete ,_) t)
(`(:si-proj :proj-complete ,_) t)
(_ nil)))))
(-let (((sched dead) (-some->> it-planning (-let (((sched dead) (-some->> it-planning
(org-ml-get-properties '(:scheduled :deadline))))) (org-ml-get-properties '(:scheduled :deadline)))))
@ -1036,8 +1030,8 @@ deadline (eg via epoch time) or if it has a repeater."
`(:si-task :task-active (:sched ,sched :dead ,dead)) `(:si-task :task-active (:sched ,sched :dead ,dead))
(lambda (acc cs) (lambda (acc cs)
(pcase acc (pcase acc
((or (:si-proj :proj-complete ,_) ((or `(:si-proj :proj-complete ,_)
(:si-task :task-complete ,_)) `(:si-task :task-complete ,_))
(-> "Active sub-iterator must have at least one active child" (-> "Active sub-iterator must have at least one active child"
(org-x-dag-left))) (org-x-dag-left)))
(`(:si-proj :proj-active ,ts-data) (`(:si-proj :proj-active ,ts-data)
@ -1050,79 +1044,29 @@ deadline (eg via epoch time) or if it has a repeater."
(t (t
(org-x-dag-bs-error-kw "Sub-iterator" it-todo))))))) (org-x-dag-bs-error-kw "Sub-iterator" it-todo)))))))
(defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name
child-key childless-key)
(declare (indent 2))
(let ((ret `(,(if child-bss child-key childless-key) ,comptime)))
(org-x-dag-bs-action-check-children child-bss
(org-x-dag-left "Completed %s cannot have active children" type-name)
(either :right ret)
ret
(lambda (local)
(pcase local
(`(:si-task :task-complete ,_) t)
(`(:si-proj :proj-complete ,_) t)
(_ nil))))))
(defun org-x-dag-bs-action-iter-todo-fold (child-bss default trans-fun)
(declare (indent 2))
(org-x-dag-bs-action-rankfold-children child-bss default
(lambda (acc next)
(pcase `(,acc ,next)
(`((:si-active ,a) (:si-active ,b))
(-let (((&plist :scheds as :dead ad) a)
((&plist :scheds bs :dead bd) b))
(cond
((or (xor as bs) (xor ad bd))
(->> "All sub-iters must have the same planning configuration"
(either :left)))
((and as bs (xor (org-ml-time-is-long as) (org-ml-time-is-long bs)))
(->> "Sub-iters must have scheduled timestamp with same length"
(either :left)))
((and ad bd (xor (org-ml-time-is-long ad) (org-ml-time-is-long bd)))
(->> "Sub-iters must have deadline timestamp with same length"
(either :left)))
;; ASSUME this won't fail since the datetimes are assumed to be the
;; same length as per rules above
((and ad bd)
(->> (org-x-dag-datetime< (org-ml-timestamp-get-start-time ad)
(org-ml-timestamp-get-start-time bd))
(either :right)))
(t
(->> (org-x-dag-datetime< (org-ml-timestamp-get-start-time as)
(org-ml-timestamp-get-start-time bs))
(either :right))))))
(`((:si-active ,_) ,_) (either :right nil))
(`(,_ (:si-active ,_)) (either :right t))
(`(,_ ,_) (either :right nil))))
(lambda (next)
(pcase next
(`(:si-active ,_) t)
(_ nil)))
trans-fun))
(defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss) (defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss)
(cl-flet (cl-flet
((new-active-iter ((new-active-iter
(d s cs) (d s cs)
(->> (list :dead d :child-scheds cs :leading-sched s) (->> (list :dead d :child-scheds cs :leading-sched s)
(list :iter-active) (list :iter-nonempty :nonempty-active)
(either :right)))) (either :right))))
(org-x-dag-bs-action-with-closed node-data ancestry "iterators" (org-x-dag-bs-action-with-closed node-data ancestry "iterators"
`(:iter-complete ,it-comptime) `(:iter-empty :empty-complete ,it-comptime)
(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"
"iterators" :iter-complete) (lambda (c) `(:iter-nonempty :nonempty-complete ,c))
(lambda (c) `(:iter-empty :empty-complete ,c)))
(cond (cond
(it-planning (it-planning
(either :left "Iterators cannot be scheduled or deadlined")) (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 '(:iter-empty) (org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty :empty-active)
(lambda (acc cs) (lambda (acc cs)
(pcase acc (pcase acc
((or `(:si-task :task-complete ,_) ((or `(:si-task :task-complete ,_)
`(:si-proj :proj-complete ,_)) `(:si-proj :proj-complete ,_))
(either :right '(:iter-empty))) (either :right '(:iter-nonempty :nonempty-complete)))
(`(:si-task :task-active ,ts-data) (`(:si-task :task-active ,ts-data)
(-let (((&plist :dead d :sched s) ts-data)) (-let (((&plist :dead d :sched s) ts-data))
(new-active-iter d s cs))) (new-active-iter d s cs)))