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

ENH use partitioned timestamps in action projects

This commit is contained in:
Nathan Dwarshuis 2022-06-11 23:29:12 -04:00
parent dc7c134045
commit 96a0bdd962
2 changed files with 21 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -881,15 +881,19 @@ deadline (eg via epoch time) or if it has a repeater."
(-let* (((sched dead) (-some->> it-planning (-let* (((sched dead) (-some->> it-planning
(org-ml-get-properties '(:scheduled :deadline)))) (org-ml-get-properties '(:scheduled :deadline))))
(task-default (->> (list :todo it-todo (sp (-some-> sched (org-x-dag-partition-timestamp)))
:sched sched (dp (-some-> dead (org-x-dag-partition-timestamp)))
:dead dead) (task-default (->> (list :todo it-todo :sched sp :dead dp)
(list :sp-task :task-active)))) (list :sp-task :task-active))))
(cond (cond
((and child-bss (equal it-todo org-x-kw-hold)) ((and child-bss (equal it-todo org-x-kw-hold))
(new-proj :proj-held)) (new-proj :proj-held))
((and child-bss sched) ((and child-bss sp)
(either :left "Projects cannot be scheduled")) (either :left "Projects cannot be scheduled"))
((and sp (< 0 (plist-get sp :length)))
(either :left "Projects cannot have ranged scheduled timestamps"))
((and dp (< 0 (plist-get dp :length)))
(either :left "Projects cannot have ranged deadline timestamps"))
((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) ((org-x-dag-action-dead-after-parent-p ancestry dead)
@ -1026,7 +1030,7 @@ deadline (eg via epoch time) or if it has a repeater."
(org-x-dag-with-datetimes (org-x-dag-with-datetimes
a b a b
(lambda (a b) (lambda (a b)
(either :right (org-x-dag-datetime-compare a b))) (either :right (org-x-dag-pts-compare a b)))
(-const (either :left 'length)))))) (-const (either :left 'length))))))
(comp2right (comp2right
(sched? comp) (sched? comp)
@ -1047,8 +1051,9 @@ deadline (eg via epoch time) or if it has a repeater."
(new-active (new-active
(ts-data child-scheds) (ts-data child-scheds)
(->> (list :dead (plist-get ts-data :dead) (->> (list :dead (plist-get ts-data :dead)
:child-sched-dts child-scheds :child-scheds child-scheds
:leading-sched-dt (org-x-dag-datetime-max child-scheds)) :leading-sched-dt (-> (org-x-dag-pts-max child-scheds)
(plist-get :datetime)))
(funcall new-active-fun)))) (funcall new-active-fun))))
(org-x-dag-bs-action-rankfold-children child-bss default (org-x-dag-bs-action-rankfold-children child-bss default
(lambda (acc next) (lambda (acc next)
@ -1087,7 +1092,7 @@ deadline (eg via epoch time) or if it has a repeater."
(_ 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-sched-dts))
(`(:si-task :task-active ,d) (-some-> (plist-get d :sched) (list))) (`(:si-task :task-active ,d) (-some-> (plist-get d :sched) (list)))
(_ nil))) (_ nil)))
(lambda (acc cs) (lambda (acc cs)
@ -1137,8 +1142,7 @@ deadline (eg via epoch time) or if it has a repeater."
(either :left "Deadlined sub-iterators cannot be ranged")) (either :left "Deadlined sub-iterators cannot be ranged"))
((member it-todo (list org-x-kw-todo org-x-kw-wait)) ((member it-todo (list org-x-kw-todo org-x-kw-wait))
(org-x-dag-bs-action-subiter-todo-fold child-bss (org-x-dag-bs-action-subiter-todo-fold child-bss
(->> (list :sched (plist-get sp :datetime) (->> (list :sched sp :dead dp)
:dead (plist-get dp :datetime))
(list :si-task :task-active)) (list :si-task :task-active))
(->> "Active sub-iterator must have at least one active child" (->> "Active sub-iterator must have at least one active child"
(either :left)) (either :left))
@ -3210,7 +3214,7 @@ FUTURE-LIMIT in a list."
(`(:iter-empty :empty-complete ,_) :complete) (`(:iter-empty :empty-complete ,_) :complete)
(`(:iter-empty :empty-active ,_) :empty) (`(:iter-empty :empty-active ,_) :empty)
(`(:iter-nonempty :nonempty-active ,data) (`(:iter-nonempty :nonempty-active ,data)
(-let* (((&plist :dead d :leading-sched s) data) (-let* (((&plist :dead d :leading-sched-dt s) data)
(d* (-some->> d (org-x-dag-datetime-to-epoch))) (d* (-some->> d (org-x-dag-datetime-to-epoch)))
(s* (-some->> s (org-x-dag-datetime-to-epoch)))) (s* (-some->> s (org-x-dag-datetime-to-epoch))))
(-if-let (epoch (if (and d* s*) (min d* s*) (or s* d*))) (-if-let (epoch (if (and d* s*) (min d* s*) (or s* d*)))

12
local/lib/org-x/test/org-x-dag-test.el
View File

@ -225,7 +225,7 @@
nil nil nil :sp-proj '(:proj-active) '(:child-scheds nil))) nil nil nil :sp-proj '(:proj-active) '(:child-scheds nil)))
(it "Active (scheduled)" (it "Active (scheduled)"
(let ((sched (org-ml-from-string 'timestamp "<2022-06-10 Fri>"))) (let ((sched (partition-timestamp "<2022-06-10 Fri>")))
(expect "3788c7bc-390e-4caf-af8e-06831ff3276b" :id-to-be-action (expect "3788c7bc-390e-4caf-af8e-06831ff3276b" :id-to-be-action
nil nil nil :sp-proj '(:proj-active) nil nil nil :sp-proj '(:proj-active)
`(:child-scheds (,sched))))) `(:child-scheds (,sched)))))
@ -284,13 +284,13 @@
(describe "Iterators" (describe "Iterators"
(it "Active non-empty" (it "Active non-empty"
(let ((s0 (timestamp-to-datetime "<2022-06-07 Tue>")) (let ((s0 (partition-timestamp "<2022-06-07 Tue>"))
(s1 (timestamp-to-datetime "<2022-06-14 Tue>")) (s1 (partition-timestamp "<2022-06-14 Tue>"))
(s2 (timestamp-to-datetime "<2022-06-21 Tue>"))) (s2 (partition-timestamp "<2022-06-21 Tue>")))
(expect "2711e9b9-f765-415d-930f-b7ff16b3140b" :id-to-be-action (expect "2711e9b9-f765-415d-930f-b7ff16b3140b" :id-to-be-action
nil nil nil :sp-iter '(:iter-nonempty :nonempty-active) nil nil nil :sp-iter '(:iter-nonempty :nonempty-active)
(list :child-sched-dts `(,s0 ,s1 ,s2) (list :child-scheds `(,s0 ,s1 ,s2)
:leading-sched-dt s2 :leading-sched-dt (plist-get s2 :datetime)
:dead nil))))))) :dead nil)))))))
(provide 'org-x-dag-test) (provide 'org-x-dag-test)