ENH make iterator date logic simpler
This commit is contained in:
parent
e4ae5ca4a1
commit
dc7c134045
|
@ -155,7 +155,7 @@
|
||||||
(org-x-dag-datetime-to-date datetime1)))
|
(org-x-dag-datetime-to-date datetime1)))
|
||||||
|
|
||||||
(defun org-x-dag-datetime-max (datetimes)
|
(defun org-x-dag-datetime-max (datetimes)
|
||||||
(-max-by #'org-x-dag-datetime< datetimes))
|
(-max-by #'org-x-dag-datetime> datetimes))
|
||||||
|
|
||||||
(defun org-x-dag-date-max (datetimes)
|
(defun org-x-dag-date-max (datetimes)
|
||||||
(-max-by #'org-x-dag-date< datetimes))
|
(-max-by #'org-x-dag-date< datetimes))
|
||||||
|
@ -1001,7 +1001,8 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
((or `(:si-task :task-complete ,_) `(:si-proj :proj-complete ,_)) t)
|
((or `(:si-task :task-complete ,_) `(: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 complete-default new-active-fun)
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
(cl-flet*
|
(cl-flet*
|
||||||
((fmt-left
|
((fmt-left
|
||||||
|
@ -1025,7 +1026,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-pts-compare a b)))
|
(either :right (org-x-dag-datetime-compare a b)))
|
||||||
(-const (either :left 'length))))))
|
(-const (either :left 'length))))))
|
||||||
(comp2right
|
(comp2right
|
||||||
(sched? comp)
|
(sched? comp)
|
||||||
|
@ -1042,7 +1043,13 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(sym-left-2
|
(sym-left-2
|
||||||
(sched-sym dead-sym)
|
(sched-sym dead-sym)
|
||||||
(if (eq sched-sym dead-sym) (fmt-left-both (left2err sched-sym))
|
(if (eq sched-sym dead-sym) (fmt-left-both (left2err sched-sym))
|
||||||
(fmt-left-2 (left2err sched-sym) (left2err dead-sym)))))
|
(fmt-left-2 (left2err sched-sym) (left2err dead-sym))))
|
||||||
|
(new-active
|
||||||
|
(ts-data child-scheds)
|
||||||
|
(->> (list :dead (plist-get ts-data :dead)
|
||||||
|
:child-sched-dts child-scheds
|
||||||
|
:leading-sched-dt (org-x-dag-datetime-max child-scheds))
|
||||||
|
(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)
|
||||||
(pcase `(,acc ,next)
|
(pcase `(,acc ,next)
|
||||||
|
@ -1083,18 +1090,20 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(`(: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) (-some-> (plist-get d :sched) (list)))
|
(`(:si-task :task-active ,d) (-some-> (plist-get d :sched) (list)))
|
||||||
(_ nil)))
|
(_ nil)))
|
||||||
trans-fun)))
|
(lambda (acc cs)
|
||||||
|
(pcase acc
|
||||||
|
((or `(:si-task :task-complete ,_) `(:si-proj :proj-complete ,_))
|
||||||
|
complete-default)
|
||||||
|
(`(:si-proj :proj-active ,ts-data)
|
||||||
|
(new-active ts-data cs))
|
||||||
|
(`(:si-task :task-active ,ts-data)
|
||||||
|
(new-active ts-data cs))
|
||||||
|
(e (error "Invalid pattern: %s" e)))))))
|
||||||
|
|
||||||
(defun org-x-dag-node-is-iterator-p (node)
|
(defun org-x-dag-node-is-iterator-p (node)
|
||||||
(org-x-dag-node-data-is-iterator-p (plist-get node :node-meta)))
|
(org-x-dag-node-data-is-iterator-p (plist-get node :node-meta)))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-subiter-inner (node-data ancestry child-bss)
|
(defun org-x-dag-bs-action-subiter-inner (node-data ancestry child-bss)
|
||||||
(cl-flet
|
|
||||||
((new-active-proj
|
|
||||||
(d s cs)
|
|
||||||
(->> (list :dead d :child-scheds cs :leading-sched s)
|
|
||||||
(list :si-proj :proj-active)
|
|
||||||
(either :right))))
|
|
||||||
(org-x-dag-bs-action-with-closed node-data ancestry "sub-iterators"
|
(org-x-dag-bs-action-with-closed node-data ancestry "sub-iterators"
|
||||||
(if child-bss
|
(if child-bss
|
||||||
`(:si-proj :proj-complete ,it-comptime)
|
`(:si-proj :proj-complete ,it-comptime)
|
||||||
|
@ -1128,31 +1137,17 @@ 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
|
||||||
`(:si-task :task-active (:sched ,sp :dead ,dp))
|
(->> (list :sched (plist-get sp :datetime)
|
||||||
(lambda (acc cs)
|
:dead (plist-get dp :datetime))
|
||||||
(pcase acc
|
(list :si-task :task-active))
|
||||||
((or `(:si-proj :proj-complete ,_)
|
(->> "Active sub-iterator must have at least one active child"
|
||||||
`(:si-task :task-complete ,_))
|
(either :left))
|
||||||
(-> "Active sub-iterator must have at least one active child"
|
(lambda (data)
|
||||||
(org-x-dag-left)))
|
(either :right `(:si-proj :proj-active ,data)))))
|
||||||
(`(:si-proj :proj-active ,ts-data)
|
|
||||||
(-let (((&plist :dead d :leading-sched s) ts-data))
|
|
||||||
(new-active-proj d s cs)))
|
|
||||||
(`(:si-task :task-active ,ts-data)
|
|
||||||
(-let (((&plist :dead d) ts-data)
|
|
||||||
((&plist :datetime s) (org-x-dag-pts-max cs)))
|
|
||||||
(new-active-proj d s cs)))
|
|
||||||
(e (error "Invalid pattern: %s" e))))))
|
|
||||||
(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-iter-inner (node-data ancestry child-bss)
|
(defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss)
|
||||||
(cl-flet
|
|
||||||
((new-active-iter
|
|
||||||
(d s cs)
|
|
||||||
(->> (list :dead d :child-scheds cs :leading-sched s)
|
|
||||||
(list :iter-nonempty :nonempty-active)
|
|
||||||
(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-empty :empty-complete ,it-comptime)
|
`(:iter-empty :empty-complete ,it-comptime)
|
||||||
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime "iterators"
|
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime "iterators"
|
||||||
|
@ -1163,22 +1158,13 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(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 :empty-active)
|
(org-x-dag-bs-action-subiter-todo-fold child-bss
|
||||||
(lambda (acc cs)
|
'(:iter-empty :empty-active)
|
||||||
(pcase acc
|
(either :right '(:iter-nonempty :nonempty-complete))
|
||||||
((or `(:si-task :task-complete ,_)
|
(lambda (data)
|
||||||
`(:si-proj :proj-complete ,_))
|
(either :right `(:iter-nonempty :nonempty-active ,data)))))
|
||||||
(either :right '(:iter-nonempty :nonempty-complete)))
|
|
||||||
(`(:si-task :task-active ,ts-data)
|
|
||||||
(-let* (((&plist :dead d) ts-data)
|
|
||||||
((&plist :datetime s) (org-x-dag-pts-max cs)))
|
|
||||||
(new-active-iter d s cs)))
|
|
||||||
(`(:si-proj :proj-active ,ts-data)
|
|
||||||
(-let (((&plist :dead d :leading-sched s) ts-data))
|
|
||||||
(new-active-iter d s cs)))
|
|
||||||
(e (error "Invalid pattern: %s" e))))))
|
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw "Iterator" it-todo))))))
|
(org-x-dag-bs-error-kw "Iterator" it-todo)))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-epg-inner (node ancestry child-bss)
|
(defun org-x-dag-bs-epg-inner (node ancestry child-bss)
|
||||||
(let ((is-complete
|
(let ((is-complete
|
||||||
|
|
|
@ -42,6 +42,10 @@
|
||||||
(->> (org-ml-from-string 'timestamp s)
|
(->> (org-ml-from-string 'timestamp s)
|
||||||
(org-x-dag-partition-timestamp)))
|
(org-x-dag-partition-timestamp)))
|
||||||
|
|
||||||
|
(defun timestamp-to-datetime (s)
|
||||||
|
(->> (org-ml-from-string 'timestamp s)
|
||||||
|
(org-ml-timestamp-get-start-time)))
|
||||||
|
|
||||||
(buttercup-define-matcher :to-be-left-with (a x)
|
(buttercup-define-matcher :to-be-left-with (a x)
|
||||||
(cl-destructuring-bind
|
(cl-destructuring-bind
|
||||||
((a-expr . a) (x-expr . x))
|
((a-expr . a) (x-expr . x))
|
||||||
|
@ -280,13 +284,13 @@
|
||||||
|
|
||||||
(describe "Iterators"
|
(describe "Iterators"
|
||||||
(it "Active non-empty"
|
(it "Active non-empty"
|
||||||
(let ((s0 (partition-timestamp "<2022-06-07 Tue>"))
|
(let ((s0 (timestamp-to-datetime "<2022-06-07 Tue>"))
|
||||||
(s1 (partition-timestamp "<2022-06-14 Tue>"))
|
(s1 (timestamp-to-datetime "<2022-06-14 Tue>"))
|
||||||
(s2 (partition-timestamp "<2022-06-21 Tue>")))
|
(s2 (timestamp-to-datetime "<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-scheds `(,s0 ,s1 ,s2)
|
(list :child-sched-dts `(,s0 ,s1 ,s2)
|
||||||
:leading-sched (plist-get s2 :datetime)
|
:leading-sched-dt s2
|
||||||
:dead nil)))))))
|
:dead nil)))))))
|
||||||
|
|
||||||
(provide 'org-x-dag-test)
|
(provide 'org-x-dag-test)
|
||||||
|
|
Loading…
Reference in New Issue