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

ENH make errors for sub-iterators more precise (and working)

This commit is contained in:
Nathan Dwarshuis 2022-06-11 20:13:49 -04:00
parent 33ca950edc
commit e4ae5ca4a1
2 changed files with 251 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -88,14 +88,21 @@
;; datetime operations ;; datetime operations
(defmacro org-x-dag-with-times (datetime0 datetime1 form) (defun org-x-dag-datetimes-same-length-p (datetime0 datetime1)
;; ASSUME all digits in this comparison are on the calendar/clock (eg day 32 ;; ASSUME all digits in this comparison are on the calendar/clock (eg day 32
;; does not 'rollover' to day 1 on the next month) ;; does not 'rollover' to day 1 on the next month)
(not (xor (org-ml-time-is-long datetime0) (org-ml-time-is-long datetime1))))
;; Maybe a -> Maybe a -> (a -> a -> b) -> b -> Maybe b
(defun org-x-dag-with-datetimes (a b fun alt)
(when (and a b)
(if (org-x-dag-datetimes-same-length-p a b)
(funcall fun a b)
(funcall alt))))
(defmacro org-x-dag-with-times (datetime0 datetime1 form)
(declare (indent 2)) (declare (indent 2))
`(if (or (and (org-ml-time-is-long ,datetime0) `(if (org-x-dag-datetimes-same-length-p datetime0 datetime1)
(org-ml-time-is-long ,datetime1))
(not (or (org-ml-time-is-long ,datetime0)
(org-ml-time-is-long ,datetime1))))
,form ,form
(error "Datetimes are invalid lengths: %S and %S" ,datetime0 ,datetime1))) (error "Datetimes are invalid lengths: %S and %S" ,datetime0 ,datetime1)))
@ -126,6 +133,12 @@
(--drop-while (= (car it) (cdr it))) (--drop-while (= (car it) (cdr it)))
(not)))) (not))))
(defun org-x-dag-datetime-compare (a b)
(cond
((org-x-dag-datetime= a b) 'eq)
((org-x-dag-datetime< a b) 'gt)
(t 'lt)))
(defun org-x-dag-date< (datetime0 datetime1) (defun org-x-dag-date< (datetime0 datetime1)
(org-x-dag-datetime< (org-x-dag-datetime-to-date datetime0) (org-x-dag-datetime< (org-x-dag-datetime-to-date datetime0)
(org-x-dag-datetime-to-date datetime1))) (org-x-dag-datetime-to-date datetime1)))
@ -141,6 +154,12 @@
(org-x-dag-datetime= (org-x-dag-datetime-to-date datetime0) (org-x-dag-datetime= (org-x-dag-datetime-to-date datetime0)
(org-x-dag-datetime-to-date datetime1))) (org-x-dag-datetime-to-date datetime1)))
(defun org-x-dag-datetime-max (datetimes)
(-max-by #'org-x-dag-datetime< datetimes))
(defun org-x-dag-date-max (datetimes)
(-max-by #'org-x-dag-date< datetimes))
(defun org-x-dag-datetime-shift (datetime shift unit) (defun org-x-dag-datetime-shift (datetime shift unit)
(cl-flet* (cl-flet*
((enc-dec-long ((enc-dec-long
@ -173,6 +192,9 @@
;; date <-> epoch ;; date <-> epoch
(defun org-x-dag-datetime-to-epoch (date)
(float-time (encode-time `(0 ,@(reverse date) nil -1 nil))))
(defun org-x-dag-date-to-epoch (date) (defun org-x-dag-date-to-epoch (date)
(float-time (encode-time `(0 0 0 ,@(reverse date) nil -1 nil)))) (float-time (encode-time `(0 0 0 ,@(reverse date) nil -1 nil))))
@ -375,6 +397,36 @@ relative shift in days from ABS."
;; (org-x-dag-format-month-tag m) ;; (org-x-dag-format-month-tag m)
;; (org-x-dag-format-day-tag d)))) ;; (org-x-dag-format-day-tag d))))
;; timestamps <-> datetime
(defun org-x-dag-partition-timestamp (ts)
(list :datetime (org-ml-timestamp-get-start-time ts)
:length (org-ml-timestamp-get-range ts)
:pos (org-ml-get-property :begin ts)
:repeater (org-ml-timestamp-extract-modulus 'repeater ts)
:warning (org-ml-timestamp-extract-modulus 'warning ts)))
(defun org-x--dag-pts-compare (fun a b)
(funcall (-on fun (lambda (ts) (plist-get ts :datetime))) a b))
(defun org-x-dag-pts-compare (a b)
(org-x--dag-pts-compare #'org-x-dag-datetime-compare a b))
(defun org-x-dag-pts= (a b)
(org-x--dag-pts-compare #'org-x-dag-datetime= a b))
(defun org-x-dag-pts< (a b)
(org-x--dag-pts-compare #'org-x-dag-datetime< a b))
(defun org-x-dag-pts> (a b)
(org-x--dag-pts-compare #'org-x-dag-datetime> a b))
(defun org-x-dag-pts-max (ps)
(-max-by #'org-x-dag-pts> ps))
(defun org-x-dag-pts-is-long-p (pts)
(org-ml-time-is-long (plist-get pts :datetime)))
;; allocation ;; allocation
(pcase-defmacro regexp (capture regexp) (pcase-defmacro regexp (capture regexp)
@ -699,7 +751,8 @@ used for optimization."
(pcase (car bss) (pcase (car bss)
(`(:right ,r) (`(:right ,r)
(if (funcall stop-fun r) (if (funcall stop-fun r)
(->> (funcall acc-fun r) (->> (either-rights bss)
(--mapcat (funcall acc-fun it))
(funcall trans-fun r)) (funcall trans-fun r))
(either>>= (fold-rank (list r nil) (cdr bss)) (either>>= (fold-rank (list r nil) (cdr bss))
(-let (((cur as) it)) (-let (((cur as) it))
@ -708,8 +761,11 @@ used for optimization."
(defun org-x-dag-bs-action-rankfold-children (bss default rank-fun stop-fun (defun org-x-dag-bs-action-rankfold-children (bss default rank-fun stop-fun
acc-fun trans-fun) acc-fun trans-fun)
(cl-flet ((get-local (x) (plist-get x :local)))
(declare (indent 2)) (declare (indent 2))
(cl-flet
((get-local
(x)
(plist-get x :local)))
(org-x-dag-bs-rankfold-children bss default (org-x-dag-bs-rankfold-children bss default
(-on rank-fun #'get-local) (-on rank-fun #'get-local)
(-compose stop-fun #'get-local) (-compose stop-fun #'get-local)
@ -947,6 +1003,46 @@ deadline (eg via epoch time) or if it has a repeater."
(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))
(cl-flet*
((fmt-left
(sched? wrong)
(let ((what (if sched? "scheduled" "deadlined")))
(org-x-dag-left "Sub-iter %s timestamps %s" what wrong)))
(fmt-left-both
(wrong)
(org-x-dag-left "Sub-iter scheduled/deadlined timestamps %s" wrong))
(fmt-left-2
(sched-wrong dead-wrong)
(org-x-dag-left
"Sub-iter scheduled timestamps %s and deadlined timestamps %s"
sched-wrong dead-wrong))
(compare
(a b)
(cond
((not (or a b)) (either :left nil))
((xor a b) (either :left 'presence))
(t
(org-x-dag-with-datetimes
a b
(lambda (a b)
(either :right (org-x-dag-pts-compare a b)))
(-const (either :left 'length))))))
(comp2right
(sched? comp)
(if (eq comp 'eq) (fmt-left sched? "should be different")
(either :right (eq comp 'gt))))
(left2err
(sym)
(pcase sym
(`presence "should be on all or none")
(`length "must have same length")))
(sym-left
(sched? sym)
(fmt-left sched? (left2err sym)))
(sym-left-2
(sched-sym dead-sym)
(if (eq sched-sym dead-sym) (fmt-left-both (left2err sched-sym))
(fmt-left-2 (left2err sched-sym) (left2err dead-sym)))))
(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)
@ -954,26 +1050,22 @@ deadline (eg via epoch time) or if it has a repeater."
(`((:si-task :task-active ,a) (:si-task :task-active ,b)) (`((:si-task :task-active ,a) (:si-task :task-active ,b))
(-let (((&plist :sched as :dead ad) a) (-let (((&plist :sched as :dead ad) a)
((&plist :sched bs :dead bd) b)) ((&plist :sched bs :dead bd) b))
(pcase `(,(compare as bs) ,(compare ad bd))
(`((:left ,s) (:right ,d)) (if s (sym-left t s) (comp2right nil d)))
(`((:right ,s) (:left ,d)) (if d (sym-left nil d) (comp2right t s)))
(`((:right ,s) (:right ,d))
(pcase `(,s ,d)
(`(gt gt) (either :right t))
(`(lt lt) (either :right nil))
((or `(gt lt) `(lt gt)) (fmt-left-both "should not cross"))
(`(eq eq) (fmt-left-both "should be different"))
(`(eq ,_) (fmt-left t "should be different"))
(`(,_ eq) (fmt-left nil "should be different"))))
(`((:left ,s) (:left ,d))
(cond (cond
((or (xor as bs) (xor ad bd)) ((and s d) (sym-left-2 s d))
(->> "All sub-iters must have the same planning configuration" (s (sym-left t s))
(either :left))) (d (sym-left nil d)))))))
((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))))))
((or `((:si-task . ,_) (:si-proj . ,_)) ((or `((:si-task . ,_) (:si-proj . ,_))
`((:si-proj . ,_) (:si-task . ,_))) `((:si-proj . ,_) (:si-task . ,_)))
(either :left "Sub-iterators must have same project structure")) (either :left "Sub-iterators must have same project structure"))
@ -989,9 +1081,9 @@ deadline (eg via epoch time) or if it has a repeater."
(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) (-some-> (plist-get d :sched) (list)))
(_ nil))) (_ nil)))
trans-fun)) trans-fun)))
(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)))
@ -1013,20 +1105,30 @@ deadline (eg via epoch time) or if it has a repeater."
(lambda (c) `(:si-proj :proj-complete ,c)) (lambda (c) `(:si-proj :proj-complete ,c))
(lambda (c) `(:si-task :task-complete ,c))) (lambda (c) `(:si-task :task-complete ,c)))
(-let (((sched dead) (-some->> it-planning (-let* (((sched dead) (-some->> it-planning
(org-ml-get-properties '(:scheduled :deadline))))) (org-ml-get-properties '(:scheduled :deadline))))
(sp (-some-> sched (org-x-dag-partition-timestamp)))
(dp (-some-> dead (org-x-dag-partition-timestamp))))
(cond (cond
((and sched child-bss) ((and sp child-bss)
(either :left "Project sub-iterators cannot be scheduled")) (either :left "Project sub-iterators cannot be scheduled"))
((and dead child-bss) ((and dp child-bss)
(either :left "Project sub-iterators cannot be deadlined")) (either :left "Project sub-iterators 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) ((org-x-dag-action-dead-after-parent-p ancestry dead)
(either :left "Sub-iterator deadline must not start after parent")) (either :left "Sub-iterator deadline must not start after parent"))
((equal it-todo org-x-kw-todo) ((and sp (plist-get sp :repeater))
(either :left "Scheduled sub-iterators cannot repeat"))
((and dp (plist-get dp :repeater))
(either :left "Deadlined sub-iterators cannot repeat"))
((and sp (< 0 (plist-get sp :length)))
(either :left "Scheduled sub-iterators cannot be ranged"))
((and dp (< 0 (plist-get dp :length)))
(either :left "Deadlined sub-iterators cannot be ranged"))
((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 ,sched :dead ,dead)) `(:si-task :task-active (:sched ,sp :dead ,dp))
(lambda (acc cs) (lambda (acc cs)
(pcase acc (pcase acc
((or `(:si-proj :proj-complete ,_) ((or `(:si-proj :proj-complete ,_)
@ -1037,7 +1139,8 @@ deadline (eg via epoch time) or if it has a repeater."
(-let (((&plist :dead d :leading-sched s) ts-data)) (-let (((&plist :dead d :leading-sched s) ts-data))
(new-active-proj d s cs))) (new-active-proj d s cs)))
(`(:si-task :task-active ,ts-data) (`(:si-task :task-active ,ts-data)
(-let (((&plist :dead d :sched s) ts-data)) (-let (((&plist :dead d) ts-data)
((&plist :datetime s) (org-x-dag-pts-max cs)))
(new-active-proj d s cs))) (new-active-proj d s cs)))
(e (error "Invalid pattern: %s" e)))))) (e (error "Invalid pattern: %s" e))))))
(t (t
@ -1067,7 +1170,8 @@ deadline (eg via epoch time) or if it has a repeater."
`(:si-proj :proj-complete ,_)) `(:si-proj :proj-complete ,_))
(either :right '(:iter-nonempty :nonempty-complete))) (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) ts-data)
((&plist :datetime s) (org-x-dag-pts-max cs)))
(new-active-iter d s cs))) (new-active-iter d s cs)))
(`(:si-proj :proj-active ,ts-data) (`(:si-proj :proj-active ,ts-data)
(-let (((&plist :dead d :leading-sched s) ts-data)) (-let (((&plist :dead d :leading-sched s) ts-data))
@ -2775,12 +2879,6 @@ encountered will be returned."
(u (convert-unit unit))) (u (convert-unit unit)))
`(,v ,u ,type)))))) `(,v ,u ,type))))))
(defun org-x-dag-partition-timestamp (ts)
(list :datetime (org-ml-timestamp-get-start-time ts)
:pos (org-ml-get-property :begin ts)
:repeater (org-ml-timestamp-extract-modulus 'repeater ts)
:warning (org-ml-timestamp-extract-modulus 'warning ts)))
(defun org-x-dag-repeater-get-next (sel-datetime datetime shift shifttype reptype) (defun org-x-dag-repeater-get-next (sel-datetime datetime shift shifttype reptype)
"Return the next timestamp repeater of DATETIME." "Return the next timestamp repeater of DATETIME."
(pcase reptype (pcase reptype
@ -3127,8 +3225,8 @@ FUTURE-LIMIT in a list."
(`(: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 s) data)
(d* (-some->> d (org-x-dag-timestamp-to-epoch))) (d* (-some->> d (org-x-dag-datetime-to-epoch)))
(s* (-some->> s (org-x-dag-timestamp-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*)))
(if (< (+ (float-time) org-x-iterator-active-future-offset) (if (< (+ (float-time) org-x-iterator-active-future-offset)
epoch) epoch)

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

@ -38,6 +38,10 @@
org-x-weekly-plan-file "weekly.org" org-x-weekly-plan-file "weekly.org"
org-x-quarterly-plan-file "quarterly.org")) org-x-quarterly-plan-file "quarterly.org"))
(defun partition-timestamp (s)
(->> (org-ml-from-string 'timestamp s)
(org-x-dag-partition-timestamp)))
(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))
@ -64,25 +68,65 @@
`(nil . ,(format "Expected %s right with %s, but got right with %s" `(nil . ,(format "Expected %s right with %s, but got right with %s"
a-expr x r))))))) a-expr x r)))))))
(defun split-plists (a b) (defun split-plists (eq-funs a b)
(let* ((a* (-partition 2 a)) (cl-flet
(b* (-partition 2 b)) ((get-keys
(x)
(->> (-partition 2 x)
(-map #'car)))
(key-eq
(k)
(let ((av (plist-get a k))
(bv (plist-get b k))
(f (or (plist-get eq-funs k) #'equal)))
(funcall f av bv))))
(let* ((a* (get-keys a))
(b* (get-keys b))
(a- (-difference a* b*)) (a- (-difference a* b*))
(b- (-difference b* a*))) (b- (-difference b* a*))
`(,(-flatten-n 1 a-) ,(-flatten-n 1 b-)))) (common (->> (-intersection a* b*)
(--reduce-from (if (key-eq it) acc
(cons (list it
(plist-get a it)
(plist-get b it))
acc))
nil))))
`(,a- ,b- ,common))))
(defun plist-diff-msg (expr a b) (defun plists-equal-p (a b)
(-let (((a-diff b-diff) (split-plists a b))) (equal (split-plists nil a b) '(nil nil nil)))
(defun element-equal-p (a b)
;; NOTE this does not compare children of elements/objects
(cl-flet
((get-useful-props
(node)
(->> (org-ml-get-all-properties node)
(-partition 2)
(--remove (memq (car it) '(:parent :begin :end :contents-begin :contents-end)))
(-flatten-n 1))))
(and (eq (org-ml-get-type a) (org-ml-get-type b))
(plists-equal-p (get-useful-props a) (get-useful-props b)))))
(defun plist-diff-msg (eq-funs expr a b)
(-let (((a-diff b-diff common-diffs) (split-plists eq-funs a b)))
(cond (cond
((and a-diff b-diff) ((and a-diff b-diff)
(format "Expected %s to have pairs '%s' and not to have pairs '%s'" (format "Expected %s to have keys '%s' and not to have keys '%s'"
expr b-diff a-diff)) expr b-diff a-diff))
(a-diff (a-diff
(format "Expected %s not to have pairs '%s'" expr a-diff)) (format "Expected %s not to have keys '%s'" expr a-diff))
(b-diff (b-diff
(format "Expected %s to have pairs '%s'" expr b-diff))))) (format "Expected %s to have keys '%s'" expr b-diff))
(common-diffs
(-let (((as bs)
(->> common-diffs
(--map `((,(car it) ,(nth 1 it)) (,(car it) ,(nth 2 it))))
(apply #'-zip-lists))))
(format "Expected %s to have key/value pairs '%s' but instead had '%s'"
expr as bs))))))
(defun status-diff-msg (expr type subtype data to-test) (defun status-diff-msg (eq-funs expr type subtype data to-test)
(-let* (((type* . rest) to-test) (-let* (((type* . rest) to-test)
((subtype* last) (-split-at (length subtype) rest)) ((subtype* last) (-split-at (length subtype) rest))
(data* (car last))) (data* (car last)))
@ -94,12 +138,12 @@
(format "Expected %s to have subtype '%s' but instead had subtype '%s'" (format "Expected %s to have subtype '%s' but instead had subtype '%s'"
expr subtype subtype*)) expr subtype subtype*))
(t (t
(plist-diff-msg expr data data*))))) (plist-diff-msg eq-funs expr data data*)))))
(defun ancestry-diff-msg (expr ancestry inner-fun to-test) (defun ancestry-diff-msg (eq-funs expr ancestry inner-fun to-test)
(declare (indent 3)) (declare (indent 3))
(-let* (((&plist :ancestry A :local L) to-test)) (-let* (((&plist :ancestry A :local L) to-test))
(or (plist-diff-msg expr A ancestry) (or (plist-diff-msg eq-funs expr A ancestry)
(funcall inner-fun L)))) (funcall inner-fun L))))
(defun buffer-status-diff-msg (expr type inner-fun to-test) (defun buffer-status-diff-msg (expr type inner-fun to-test)
@ -125,8 +169,14 @@
(let* ((ancestry (list :canceled-parent-p c (let* ((ancestry (list :canceled-parent-p c
:held-parent-p h :held-parent-p h
:parent-deadline e)) :parent-deadline e))
(f (->> (-partial #'status-diff-msg test-expr y s d) (ancestry-eq-funs (list :parent-deadline #'element-equal-p))
(-partial #'ancestry-diff-msg test-expr ancestry) (local-eq-funs (list :sched #'element-equal-p
;; TODO this is wrong
:child-scheds (lambda (a b)
(seq-set-equal-p
a b #'element-equal-p))))
(f (->> (-partial #'status-diff-msg local-eq-funs test-expr y s d)
(-partial #'ancestry-diff-msg ancestry-eq-funs test-expr ancestry)
(-partial #'buffer-status-diff-msg test-expr :action) (-partial #'buffer-status-diff-msg test-expr :action)
(-partial #'right-diff-msg test-expr)))) (-partial #'right-diff-msg test-expr))))
(-if-let (m (funcall f (org-x-dag-id->bs test))) (-if-let (m (funcall f (org-x-dag-id->bs test)))
@ -170,15 +220,11 @@
(expect "a98df83f-bc98-4767-b2bc-f1054dbf89f9" :id-to-be-action (expect "a98df83f-bc98-4767-b2bc-f1054dbf89f9" :id-to-be-action
nil nil nil :sp-proj '(:proj-active) '(:child-scheds nil))) nil nil nil :sp-proj '(:proj-active) '(:child-scheds nil)))
;; TODO these tests are broken because I don't have a robust way (it "Active (scheduled)"
;; to compare the equality of org elements here (likely will need to (let ((sched (org-ml-from-string 'timestamp "<2022-06-10 Fri>")))
;; steal something from the org-ml code, and then tell the plist (expect "3788c7bc-390e-4caf-af8e-06831ff3276b" :id-to-be-action
;; checker which equality tests to use) nil nil nil :sp-proj '(:proj-active)
;; (it "Active (scheduled)" `(:child-scheds (,sched)))))
;; (let ((sched (org-ml-from-string 'timestamp "<2022-06-10 Fri>")))
;; (expect "3788c7bc-390e-4caf-af8e-06831ff3276b" :id-to-be-action
;; nil nil nil :sp-proj '(:proj-active)
;; `(:child-scheds (,sched)))))
(it "Wait" (it "Wait"
(expect "26586b4d-7fc7-4a9f-b86f-e3c26a83a507" :id-to-be-action (expect "26586b4d-7fc7-4a9f-b86f-e3c26a83a507" :id-to-be-action
@ -230,7 +276,18 @@
(it "Canceled" (it "Canceled"
(expect "322af50a-f431-4940-8caf-cc5acdf5a555" :id-to-be-action (expect "322af50a-f431-4940-8caf-cc5acdf5a555" :id-to-be-action
nil nil nil :sp-task '(:task-complete) nil nil nil :sp-task '(:task-complete)
'(:canceledp t :epoch 1654903560)))))) '(:canceledp t :epoch 1654903560))))
(describe "Iterators"
(it "Active non-empty"
(let ((s0 (partition-timestamp "<2022-06-07 Tue>"))
(s1 (partition-timestamp "<2022-06-14 Tue>"))
(s2 (partition-timestamp "<2022-06-21 Tue>")))
(expect "2711e9b9-f765-415d-930f-b7ff16b3140b" :id-to-be-action
nil nil nil :sp-iter '(:iter-nonempty :nonempty-active)
(list :child-scheds `(,s0 ,s1 ,s2)
:leading-sched (plist-get s2 :datetime)
:dead nil)))))))
(provide 'org-x-dag-test) (provide 'org-x-dag-test)
;;; org-x-dag-test.el ends here ;;; org-x-dag-test.el ends here