ADD tests for conflict headlines

This commit is contained in:
Nathan Dwarshuis 2021-04-14 23:19:33 -04:00
parent 7a956c0d44
commit e3beacfbde
2 changed files with 108 additions and 25 deletions

View File

@ -1188,8 +1188,7 @@ for TS."
(defun org-x-cluster-effort-seconds (effort-str) (defun org-x-cluster-effort-seconds (effort-str)
"Convert EFFORT-STR into an integer in seconds from HH:MM format." "Convert EFFORT-STR into an integer in seconds from HH:MM format."
(-some->> effort-str (org-duration-to-minutes) (* 60))) (-some->> effort-str (org-duration-to-minutes) (round) (* 60)))
(defun org-x-cluster-extract-hl-sched (hl fp) (defun org-x-cluster-extract-hl-sched (hl fp)
"Extract scheduled timestamp from headline HL in filepath FP. "Extract scheduled timestamp from headline HL in filepath FP.
@ -1289,10 +1288,9 @@ and added to accumulator ACC."
(defun org-x-cluster-conflicting-p (tsp-a tsp-b) (defun org-x-cluster-conflicting-p (tsp-a tsp-b)
"Return t if timestamps TS-A and TS-B conflict." "Return t if timestamps TS-A and TS-B conflict."
;; assume that ts-a starts before ts-b ;; assume that ts-a starts before ts-b
(let* ((start-a (plist-get tsp-a :unixtime)) (let ((start-a (plist-get tsp-a :unixtime))
(start-b (plist-get tsp-b :unixtime)) (start-b (plist-get tsp-b :unixtime)))
(end-a (-> tsp-a (plist-get :range) (+ start-a)))) (or (= start-a start-b) (< start-b (+ start-a (plist-get tsp-a :range))))))
(or (= start-a start-b) (< start-b end-a))))
(defun org-x-cluster-find-conflict (tsp tsps conlist) (defun org-x-cluster-find-conflict (tsp tsps conlist)
"Test if timestamp-plist TSP conflicts with any in TSPS. "Test if timestamp-plist TSP conflicts with any in TSPS.
@ -1300,29 +1298,29 @@ If found, anything in TSPS is cons'd with TSP and added to CONLIST
as a pair. New CONLIST is returned." as a pair. New CONLIST is returned."
(->> tsps (->> tsps
(--take-while (org-x-cluster-conflicting-p tsp it)) (--take-while (org-x-cluster-conflicting-p tsp it))
(--map (cons tsp it)) (--map (list tsp it))
(append conlist))) (append conlist)))
(defun org-x-cluster-build-conlist (tsps) (defun org-x-cluster-build-conlist (tsps)
"Build a list of conflict pairs from timestamp-plist TSPS." "Build a list of conflict pairs from timestamp-plist TSPS."
(let ((conlist)) (let ((conlist))
(while (< 1 (length tsps)) (while (< 1 (length tsps))
(setq conlist (org-x-cluster-find-conflict (car tsps) (setq conlist (org-x-cluster-find-conflict (car tsps) (cdr tsps) conlist)
(cdr tsps)
conlist)
tsps (cdr tsps))) tsps (cdr tsps)))
conlist)) conlist))
(defun org-x-cluster-get-conflicts* (tsps)
(->> (--filter (org-ml-time-is-long (plist-get it :start-time)) tsps)
(org-x-cluster-append-unixtime)
(org-x-cluster-filter-past)
(--sort (< (plist-get it :unixtime) (plist-get other :unixtime)))
(org-x-cluster-build-conlist)))
(defun org-x-cluster-get-conflicts () (defun org-x-cluster-get-conflicts ()
"Return a list of cons cells representing conflict pairs. "Return a list of cons cells representing conflict pairs.
Each member in the cons cell is a timestamp-plist." Each member in the cons cell is a timestamp-plist."
(->> (->> (org-x-cluster-get-unprocessed)
(org-x-cluster-get-unprocessed) (org-x-cluster-get-conflicts*)))
(--filter (org-ml-time-is-long (plist-get it :start-time)))
(org-x-cluster-append-unixtime)
(org-x-cluster-filter-past)
(--sort (< (plist-get it :unixtime) (plist-get other :unixtime)))
(org-x-cluster-build-conlist)))
;; get overloaded days ;; get overloaded days
;; ;;
@ -1385,7 +1383,6 @@ Each member in the cons cell is a timestamp-plist."
acc)))) acc))))
acc))))) acc)))))
(defun org-x-cluster-daily-split (tsps) (defun org-x-cluster-daily-split (tsps)
"Group timestamp-plist TSPS into sublists for each day." "Group timestamp-plist TSPS into sublists for each day."
(--partition-by (-take 3 (plist-get it :start-time)) tsps)) (--partition-by (-take 3 (plist-get it :start-time)) tsps))
@ -1394,12 +1391,8 @@ Each member in the cons cell is a timestamp-plist."
"Return t if total time of timestamp-plists in TSPS exceeds 24 hours. "Return t if total time of timestamp-plists in TSPS exceeds 24 hours.
It is assumed the TSPS represents tasks and appointments within one It is assumed the TSPS represents tasks and appointments within one
day." day."
(letrec ((ts2diff (<= 86400 (-sum (--map (plist-get tsp :range) tsps))))
(lambda (tsp)
(let ((start (plist-get tsp :unixtime)))
(- (-> tsp (plist-get :range) (+ start)) start)))))
(->> tsps (--map (funcall ts2diff it)) -sum (<= 86400))))
(defun org-x-cluster-get-overloads () (defun org-x-cluster-get-overloads ()
"Return list of lists of timestamp-plists grouped by day. "Return list of lists of timestamp-plists grouped by day.
Anything present represents all the tasks in a single day if that day Anything present represents all the tasks in a single day if that day
@ -1512,7 +1505,7 @@ MARKER for use in the conflict agenda view."
(insert (concat (insert (concat
"At " (org-x-cluster-ts-fmt (car it)) "\n" "At " (org-x-cluster-ts-fmt (car it)) "\n"
(org-x-cluster-headline-text (car it)) "\n" (org-x-cluster-headline-text (car it)) "\n"
(org-x-cluster-headline-text (cdr it)) "\n" (org-x-cluster-headline-text (cadr it)) "\n"
"\n")))) "\n"))))
;; clean up and finalize ;; clean up and finalize

View File

@ -427,6 +427,95 @@ Forms are denoted like %(FORM)%."
"** sub") "** sub")
=> :unscheduled) => :unscheduled)
(org-x--test-buffer-strings "Conflicts"
(->> (org-x-cluster-extract-buffer "fp")
(org-x-cluster-get-conflicts*)
;; drop the :unixtime key from the front to make testing easier
(--map (--map (-drop 2 it) it)))
"no timestamps"
("* TODO one"
"* TODO two")
=> nil
"two scheduled timestamps"
("* TODO one"
"SCHEDULED: [2022-01-01 Tue 12:00]"
"* TODO two"
"SCHEDULED: [2022-01-01 Tue 12:00]")
=> '(((:start-time (2022 1 1 12 0) :range 0 :offset 1 :filepath "fp")
(:start-time (2022 1 1 12 0) :range 0 :offset 46 :filepath "fp")))
"scheduled timestamps + active timestamp"
("* TODO one"
"SCHEDULED: [2022-01-01 Tue 12:00]"
"* two"
"<2022-01-01 Tue 12:00>")
=> '(((:start-time (2022 1 1 12 0) :range 0 :offset 1 :filepath "fp")
(:start-time (2022 1 1 12 0) :range 0 :offset 46 :filepath "fp")))
"two scheduled timestamps (staggered)"
("* TODO one"
"SCHEDULED: [2022-01-01 Tue 12:00]"
":PROPERTIES:"
":Effort: 0:30"
":END:"
"* TODO two"
"SCHEDULED: [2022-01-01 Tue 12:15]"
":PROPERTIES:"
":Effort: 0:30"
":END:")
=> '(((:start-time (2022 1 1 12 0) :range 1800 :offset 1 :filepath "fp")
(:start-time (2022 1 1 12 15) :range 1800 :offset 79 :filepath "fp")))
"scheduled + active (staggered)"
("* TODO one"
"SCHEDULED: [2022-01-01 Tue 12:00]"
":PROPERTIES:"
":Effort: 0:30"
":END:"
"* two"
"<2022-01-01 Tue 12:15-12:45>")
=> '(((:start-time (2022 1 1 12 0) :range 1800 :offset 1 :filepath "fp")
(:start-time (2022 1 1 12 15) :range 1800 :offset 79 :filepath "fp")))
"two scheduled timestamps (non-overlapping)"
("* TODO one"
"SCHEDULED: [2022-01-01 Tue 12:00]"
":PROPERTIES:"
":Effort: 0:05"
":END:"
"* TODO two"
"SCHEDULED: [2022-01-01 Tue 12:15]"
":PROPERTIES:"
":Effort: 0:05"
":END:")
=> nil
"three scheduled timestamps (overlapping)"
("* TODO one"
"SCHEDULED: [2022-01-01 Tue 12:00]"
":PROPERTIES:"
":Effort: 0:15"
":END:"
"* TODO two"
"SCHEDULED: [2022-01-01 Tue 12:05]"
":PROPERTIES:"
":Effort: 0:15"
":END:"
"* TODO three"
"SCHEDULED: [2022-01-01 Tue 12:10]"
":PROPERTIES:"
":Effort: 0:15"
":END:")
=> '(((:start-time (2022 1 1 12 0) :range 900 :offset 1 :filepath "fp")
(:start-time (2022 1 1 12 5) :range 900 :offset 79 :filepath "fp"))
((:start-time (2022 1 1 12 0) :range 900 :offset 1 :filepath "fp")
(:start-time (2022 1 1 12 10) :range 900 :offset 157 :filepath "fp"))
((:start-time (2022 1 1 12 5) :range 900 :offset 79 :filepath "fp")
(:start-time (2022 1 1 12 10) :range 900 :offset 157 :filepath "fp"))))
(defmacro org-x--test-time-splitter-specs (&rest specs) (defmacro org-x--test-time-splitter-specs (&rest specs)
(declare (indent 0)) (declare (indent 0))
;; 3 args for clarity, currently does nothing functional ;; 3 args for clarity, currently does nothing functional
@ -443,6 +532,7 @@ Forms are denoted like %(FORM)%."
`(describe "Time splitter" `(describe "Time splitter"
,@forms))) ,@forms)))
(org-x--test-time-splitter-specs (org-x--test-time-splitter-specs
"zero range" "zero range"
(:start-time (2021 1 1 0 0) :range 0) (:start-time (2021 1 1 0 0) :range 0)