From e17ac965a1f0f9aa0d7619058b70b73b93daba43 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Tue, 13 Apr 2021 22:52:58 -0400 Subject: [PATCH] ADD better timestamp splitter and tests --- local/lib/org-x/org-x.el | 65 +++++++++++++----- .../lib/org-x/test/org-x-test-buffer-state.el | 68 ++++++++++++++++++- 2 files changed, 112 insertions(+), 21 deletions(-) diff --git a/local/lib/org-x/org-x.el b/local/lib/org-x/org-x.el index a89e18a..87d7f4d 100644 --- a/local/lib/org-x/org-x.el +++ b/local/lib/org-x/org-x.el @@ -1333,24 +1333,53 @@ Each member in the cons cell is a timestamp-plist." ;; 3. sort from earliest to latest starting time ;; 4. sum the range of timestamps in each day, keeping those that exceed 24 hours -;; (defun org-x-cluster-split-tsp-maybe (tsp) -;; "Split TIMESTAMP if it spans multiple days." -;; (-let (((&plist :start-time :range) tsp)) -;; (if (= range 0) (list tsp) -;; ;; assume long time (for now) -;; (let* (((y m d H M) start-time) -;; (et* (encode-time `(0 ,M ,M ,d ,m ,y nil nil nil))) -;; ((M* H* d* m* y*) (-take 5 (cdr (decode-time et*))))) -;; (if (or (< d d*) (< m m*) (< y y*)) -;; (let ((range* (- (float-time et*) -;; (float-time (encode-time `(0 0 0 ,d* ,m* ,y* nil nil nil)))))) -;; ( - - ;; (start-offset-sec (if (and H M) (* 60 (+ M (* 60 H))) 0)) - ;; (spanned-days (1- (/ (+ start-offset-sec range) (* 24 60 60))))) - ;; (if (= 0 spanned-days) (list (list :start-time start-time :range range)) - ;; (let ((first-range (- (* 24 60 60) start-offset-sec)) - ;; (last-range (% (+ start-offset-sec range) (* 24 60 60)))) +(defun org-x-cluster-split-tsp-maybe (tsp) + "Split TSP if it spans multiple days." + ;; NOTE, `encode-time' seems pretty slow but this is necessary since some + ;; barbarians in power insist on keep daylight savings time, which means I + ;; can't just do straight modular arithmetic to find where each day boundary + ;; lies. + (-let (((&plist :start-time :range :fp) tsp)) + (if (= range 0) (list tsp) + (-let* (((y m d H M) start-time) + (start-time* (if (and H M) start-time `(,@start-time 0 0))) + (start-epoch (->> `(0 ,(or M 0) ,(or H 0) ,d ,m ,y nil nil nil) + (encode-time) + (float-time) + (round))) + (end-epoch (+ start-epoch range)) + (next t) + (split-epoch nil) + ((M* H* d* m* y*) '(nil nil nil nil nil)) + (acc nil)) + (while next + ;; get the projected ending time + (-setq (M* H* d* m* y*) (-take 5 (cdr (decode-time end-epoch)))) + ;; Get the epoch time on which to split. If not on a day boundary, + ;; calculate the epoch time of the most recent day boundary. If on a + ;; day boundary, split on the boundary one full day earlier by + ;; decrementing day by one + (when (and (= 0 M*) (= 0 H*)) + (setq d* (1- d*))) + (setq split-epoch (->> `(0 0 0 ,d* ,m* ,y* nil nil nil) + (encode-time) + (float-time) + (round))) + ;; If the split-epoch is less than or equal to the start, loop is + ;; done. Else add a new entry and reset the projected ending time to + ;; the current split time; rinse and repeat. + (if (< start-epoch split-epoch) + (setq acc (cons (list :start-time `(,y* ,m* ,d* 0 0) + :range (- end-epoch split-epoch) + :fp fp) + acc) + end-epoch split-epoch) + (setq next nil + acc (cons (list :start-time start-time* + :range (- end-epoch start-epoch) + :fp fp) + acc)))) + acc)))) (defun org-x-cluster-split-day-bounds (tsps) "Split timestamp-plists in TSPS via daily boundaries. diff --git a/local/lib/org-x/test/org-x-test-buffer-state.el b/local/lib/org-x/test/org-x-test-buffer-state.el index fc73e25..5766eb6 100644 --- a/local/lib/org-x/test/org-x-test-buffer-state.el +++ b/local/lib/org-x/test/org-x-test-buffer-state.el @@ -378,7 +378,7 @@ Forms are denoted like %(FORM)%." ":PARENT_TYPE: iterator" ":END:" "** TODO sub" - "SCHEDULED: %(org-x-gen-ts (+ (* 60 60 24) org-clone-iter-future-time))%") + "SCHEDULED: %(org-x-gen-ts (+ (* 60 60 24) org-x-iter-future-time))%") => :actv "project error" @@ -388,7 +388,7 @@ Forms are denoted like %(FORM)%." ":END:" "** NEXT sub" "*** TODO subsub" - "SCHEDULED: %(org-x-gen-ts (1+ org-clone-iter-future-time))%") + "SCHEDULED: %(org-x-gen-ts (1+ org-x-iter-future-time))%") => :project-error) (org-x--test-buffer-strings "Periodical status" @@ -416,7 +416,7 @@ Forms are denoted like %(FORM)%." ":PARENT_TYPE: periodical" ":END:" "** sub" - "%(org-x-gen-ts (+ (* 60 60 24) org-clone-peri-future-time) t)%") + "%(org-x-gen-ts (+ (* 60 60 24) org-x-peri-future-time) t)%") => :actv "unscheduled" @@ -427,5 +427,67 @@ Forms are denoted like %(FORM)%." "** sub") => :unscheduled) +(defmacro org-x--test-time-splitter-specs (&rest specs) + (declare (indent 0)) + ;; 3 args for clarity, currently does nothing functional + (let ((forms (->> (-partition 4 specs) + (--map (-let (((title input _useless-sugar output) it)) + `(it ,title + (expect (org-x-cluster-split-tsp-maybe ,input) + :to-equal + ,output))))))) + `(describe "Time splitter" + ,@forms))) + +(org-x--test-time-splitter-specs + "zero range" + '(:start-time (2021 1 1 0 0) :range 0 :fp "") + => '((:start-time (2021 1 1 0 0) :range 0 :fp "")) + + "1-hour range" + '(:start-time (2021 1 1 0 0) :range 3600 :fp "") + => '((:start-time (2021 1 1 0 0) :range 3600 :fp "")) + + "12-hour range (noon start)" + '(:start-time (2021 1 1 12 0) :range 43200 :fp "") + => '((:start-time (2021 1 1 12 0) :range 43200 :fp "")) + + "24-hour range (day boundary)" + '(:start-time (2021 1 1 0 0) :range 86400 :fp "") + => '((:start-time (2021 1 1 0 0) :range 86400 :fp "")) + + "24-hour range (noon start)" + '(:start-time (2021 1 1 12 0) :range 86400 :fp "") + => '((:start-time (2021 1 1 12 0) :range 43200 :fp "") + (:start-time (2021 1 2 0 0) :range 43200 :fp "")) + + "48-hour range (day boundary)" + '(:start-time (2021 1 1 0 0) :range 172800 :fp "") + => '((:start-time (2021 1 1 0 0) :range 86400 :fp "") + (:start-time (2021 1 2 0 0) :range 86400 :fp "")) + + "48-hour range (noon start)" + '(:start-time (2021 1 1 12 0) :range 172800 :fp "") + => '((:start-time (2021 1 1 12 0) :range 43200 :fp "") + (:start-time (2021 1 2 0 0) :range 86400 :fp "") + (:start-time (2021 1 3 0 0) :range 43200 :fp "")) + + "zero range (short)" + '(:start-time (2021 1 1) :range 0 :fp "") + => '((:start-time (2021 1 1) :range 0 :fp "")) + + "1-hour range (short)" + '(:start-time (2021 1 1) :range 3600 :fp "") + => '((:start-time (2021 1 1 0 0) :range 3600 :fp "")) + + "24-hour range (short)" + '(:start-time (2021 1 1) :range 86400 :fp "") + => '((:start-time (2021 1 1 0 0) :range 86400 :fp "")) + + "48-hour range (short)" + '(:start-time (2021 1 1) :range 172800 :fp "") + => '((:start-time (2021 1 1 0 0) :range 86400 :fp "") + (:start-time (2021 1 2 0 0) :range 86400 :fp ""))) + (provide 'org-x-test-buffer-state) ;;; org-x-test-buffer-state.el ends here