ENH make errors for sub-iterators more precise (and working)
This commit is contained in:
parent
33ca950edc
commit
e4ae5ca4a1
|
|
@ -88,14 +88,21 @@
|
|||
|
||||
;; 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
|
||||
;; 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))
|
||||
`(if (or (and (org-ml-time-is-long ,datetime0)
|
||||
(org-ml-time-is-long ,datetime1))
|
||||
(not (or (org-ml-time-is-long ,datetime0)
|
||||
(org-ml-time-is-long ,datetime1))))
|
||||
`(if (org-x-dag-datetimes-same-length-p datetime0 datetime1)
|
||||
,form
|
||||
(error "Datetimes are invalid lengths: %S and %S" ,datetime0 ,datetime1)))
|
||||
|
||||
|
|
@ -126,6 +133,12 @@
|
|||
(--drop-while (= (car it) (cdr it)))
|
||||
(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)
|
||||
(org-x-dag-datetime< (org-x-dag-datetime-to-date datetime0)
|
||||
(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-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)
|
||||
(cl-flet*
|
||||
((enc-dec-long
|
||||
|
|
@ -173,6 +192,9 @@
|
|||
|
||||
;; 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)
|
||||
(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-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
|
||||
|
||||
(pcase-defmacro regexp (capture regexp)
|
||||
|
|
@ -699,7 +751,8 @@ used for optimization."
|
|||
(pcase (car bss)
|
||||
(`(:right ,r)
|
||||
(if (funcall stop-fun r)
|
||||
(->> (funcall acc-fun r)
|
||||
(->> (either-rights bss)
|
||||
(--mapcat (funcall acc-fun it))
|
||||
(funcall trans-fun r))
|
||||
(either>>= (fold-rank (list r nil) (cdr bss))
|
||||
(-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
|
||||
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
|
||||
(-on rank-fun #'get-local)
|
||||
(-compose stop-fun #'get-local)
|
||||
|
|
@ -947,51 +1003,87 @@ 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)
|
||||
(declare (indent 2))
|
||||
(org-x-dag-bs-action-rankfold-children child-bss default
|
||||
(lambda (acc next)
|
||||
(pcase `(,acc ,next)
|
||||
;; for active tasks, the furthest in the future is ranked the highest
|
||||
(`((:si-task :task-active ,a) (:si-task :task-active ,b))
|
||||
(-let (((&plist :sched as :dead ad) a)
|
||||
((&plist :sched 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))))))
|
||||
((or `((:si-task . ,_) (:si-proj . ,_))
|
||||
`((:si-proj . ,_) (:si-task . ,_)))
|
||||
(either :left "Sub-iterators must have same project structure"))
|
||||
(`(,(or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)) ,_)
|
||||
(either :right nil))
|
||||
(`(,_ ,(or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)))
|
||||
(either :right t))
|
||||
(`(,_ ,_) (either :right nil))))
|
||||
(lambda (next)
|
||||
(pcase next
|
||||
((or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)) t)
|
||||
(_ nil)))
|
||||
(lambda (next)
|
||||
(pcase next
|
||||
(`(:si-proj :proj-active ,d) (plist-get d :child-scheds))
|
||||
(`(:si-task :task-active ,d) (list (plist-get d :sched)))
|
||||
(_ nil)))
|
||||
trans-fun))
|
||||
(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
|
||||
(lambda (acc next)
|
||||
(pcase `(,acc ,next)
|
||||
;; for active tasks, the furthest in the future is ranked the highest
|
||||
(`((:si-task :task-active ,a) (:si-task :task-active ,b))
|
||||
(-let (((&plist :sched as :dead ad) a)
|
||||
((&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
|
||||
((and s d) (sym-left-2 s d))
|
||||
(s (sym-left t s))
|
||||
(d (sym-left nil d)))))))
|
||||
((or `((:si-task . ,_) (:si-proj . ,_))
|
||||
`((:si-proj . ,_) (:si-task . ,_)))
|
||||
(either :left "Sub-iterators must have same project structure"))
|
||||
(`(,(or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)) ,_)
|
||||
(either :right nil))
|
||||
(`(,_ ,(or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)))
|
||||
(either :right t))
|
||||
(`(,_ ,_) (either :right nil))))
|
||||
(lambda (next)
|
||||
(pcase next
|
||||
((or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)) t)
|
||||
(_ nil)))
|
||||
(lambda (next)
|
||||
(pcase next
|
||||
(`(:si-proj :proj-active ,d) (plist-get d :child-scheds))
|
||||
(`(:si-task :task-active ,d) (-some-> (plist-get d :sched) (list)))
|
||||
(_ nil)))
|
||||
trans-fun)))
|
||||
|
||||
(defun org-x-dag-node-is-iterator-p (node)
|
||||
(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-task :task-complete ,c)))
|
||||
|
||||
(-let (((sched dead) (-some->> it-planning
|
||||
(org-ml-get-properties '(:scheduled :deadline)))))
|
||||
(-let* (((sched dead) (-some->> it-planning
|
||||
(org-ml-get-properties '(:scheduled :deadline))))
|
||||
(sp (-some-> sched (org-x-dag-partition-timestamp)))
|
||||
(dp (-some-> dead (org-x-dag-partition-timestamp))))
|
||||
(cond
|
||||
((and sched child-bss)
|
||||
((and sp child-bss)
|
||||
(either :left "Project sub-iterators cannot be scheduled"))
|
||||
((and dead child-bss)
|
||||
((and dp child-bss)
|
||||
(either :left "Project sub-iterators cannot be deadlined"))
|
||||
((org-x-dag-node-data-is-iterator-p node-data)
|
||||
(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)
|
||||
((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
|
||||
`(:si-task :task-active (:sched ,sched :dead ,dead))
|
||||
`(:si-task :task-active (:sched ,sp :dead ,dp))
|
||||
(lambda (acc cs)
|
||||
(pcase acc
|
||||
((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))
|
||||
(new-active-proj d s cs)))
|
||||
(`(: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)))
|
||||
(e (error "Invalid pattern: %s" e))))))
|
||||
(t
|
||||
|
|
@ -1067,7 +1170,8 @@ deadline (eg via epoch time) or if it has a repeater."
|
|||
`(:si-proj :proj-complete ,_))
|
||||
(either :right '(:iter-nonempty :nonempty-complete)))
|
||||
(`(: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)))
|
||||
(`(:si-proj :proj-active ,ts-data)
|
||||
(-let (((&plist :dead d :leading-sched s) ts-data))
|
||||
|
|
@ -2775,12 +2879,6 @@ encountered will be returned."
|
|||
(u (convert-unit unit)))
|
||||
`(,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)
|
||||
"Return the next timestamp repeater of DATETIME."
|
||||
(pcase reptype
|
||||
|
|
@ -3127,8 +3225,8 @@ FUTURE-LIMIT in a list."
|
|||
(`(:iter-empty :empty-active ,_) :empty)
|
||||
(`(:iter-nonempty :nonempty-active ,data)
|
||||
(-let* (((&plist :dead d :leading-sched s) data)
|
||||
(d* (-some->> d (org-x-dag-timestamp-to-epoch)))
|
||||
(s* (-some->> s (org-x-dag-timestamp-to-epoch))))
|
||||
(d* (-some->> d (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 (< (+ (float-time) org-x-iterator-active-future-offset)
|
||||
epoch)
|
||||
|
|
|
|||
|
|
@ -38,6 +38,10 @@
|
|||
org-x-weekly-plan-file "weekly.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)
|
||||
(cl-destructuring-bind
|
||||
((a-expr . a) (x-expr . x))
|
||||
|
|
@ -64,25 +68,65 @@
|
|||
`(nil . ,(format "Expected %s right with %s, but got right with %s"
|
||||
a-expr x r)))))))
|
||||
|
||||
(defun split-plists (a b)
|
||||
(let* ((a* (-partition 2 a))
|
||||
(b* (-partition 2 b))
|
||||
(a- (-difference a* b*))
|
||||
(b- (-difference b* a*)))
|
||||
`(,(-flatten-n 1 a-) ,(-flatten-n 1 b-))))
|
||||
(defun split-plists (eq-funs a b)
|
||||
(cl-flet
|
||||
((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*))
|
||||
(b- (-difference b* a*))
|
||||
(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)
|
||||
(-let (((a-diff b-diff) (split-plists a b)))
|
||||
(defun plists-equal-p (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
|
||||
((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))
|
||||
(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
|
||||
(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)
|
||||
((subtype* last) (-split-at (length subtype) rest))
|
||||
(data* (car last)))
|
||||
|
|
@ -94,12 +138,12 @@
|
|||
(format "Expected %s to have subtype '%s' but instead had subtype '%s'"
|
||||
expr subtype subtype*))
|
||||
(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))
|
||||
(-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))))
|
||||
|
||||
(defun buffer-status-diff-msg (expr type inner-fun to-test)
|
||||
|
|
@ -125,8 +169,14 @@
|
|||
(let* ((ancestry (list :canceled-parent-p c
|
||||
:held-parent-p h
|
||||
:parent-deadline e))
|
||||
(f (->> (-partial #'status-diff-msg test-expr y s d)
|
||||
(-partial #'ancestry-diff-msg test-expr ancestry)
|
||||
(ancestry-eq-funs (list :parent-deadline #'element-equal-p))
|
||||
(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 #'right-diff-msg test-expr))))
|
||||
(-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
|
||||
nil nil nil :sp-proj '(:proj-active) '(:child-scheds nil)))
|
||||
|
||||
;; TODO these tests are broken because I don't have a robust way
|
||||
;; to compare the equality of org elements here (likely will need to
|
||||
;; steal something from the org-ml code, and then tell the plist
|
||||
;; checker which equality tests to use)
|
||||
;; (it "Active (scheduled)"
|
||||
;; (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 "Active (scheduled)"
|
||||
(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"
|
||||
(expect "26586b4d-7fc7-4a9f-b86f-e3c26a83a507" :id-to-be-action
|
||||
|
|
@ -230,7 +276,18 @@
|
|||
(it "Canceled"
|
||||
(expect "322af50a-f431-4940-8caf-cc5acdf5a555" :id-to-be-action
|
||||
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)
|
||||
;;; org-x-dag-test.el ends here
|
||||
|
|
|
|||
Loading…
Reference in New Issue