ADD better timestamp splitter and tests

This commit is contained in:
Nathan Dwarshuis 2021-04-13 22:52:58 -04:00
parent eb2f538ba5
commit e17ac965a1
2 changed files with 112 additions and 21 deletions

View File

@ -1333,24 +1333,53 @@ Each member in the cons cell is a timestamp-plist."
;; 3. sort from earliest to latest starting time ;; 3. sort from earliest to latest starting time
;; 4. sum the range of timestamps in each day, keeping those that exceed 24 hours ;; 4. sum the range of timestamps in each day, keeping those that exceed 24 hours
;; (defun org-x-cluster-split-tsp-maybe (tsp) (defun org-x-cluster-split-tsp-maybe (tsp)
;; "Split TIMESTAMP if it spans multiple days." "Split TSP if it spans multiple days."
;; (-let (((&plist :start-time :range) tsp)) ;; NOTE, `encode-time' seems pretty slow but this is necessary since some
;; (if (= range 0) (list tsp) ;; barbarians in power insist on keep daylight savings time, which means I
;; ;; assume long time (for now) ;; can't just do straight modular arithmetic to find where each day boundary
;; (let* (((y m d H M) start-time) ;; lies.
;; (et* (encode-time `(0 ,M ,M ,d ,m ,y nil nil nil))) (-let (((&plist :start-time :range :fp) tsp))
;; ((M* H* d* m* y*) (-take 5 (cdr (decode-time et*))))) (if (= range 0) (list tsp)
;; (if (or (< d d*) (< m m*) (< y y*)) (-let* (((y m d H M) start-time)
;; (let ((range* (- (float-time et*) (start-time* (if (and H M) start-time `(,@start-time 0 0)))
;; (float-time (encode-time `(0 0 0 ,d* ,m* ,y* nil nil nil)))))) (start-epoch (->> `(0 ,(or M 0) ,(or H 0) ,d ,m ,y nil nil nil)
;; ( (encode-time)
(float-time)
;; (start-offset-sec (if (and H M) (* 60 (+ M (* 60 H))) 0)) (round)))
;; (spanned-days (1- (/ (+ start-offset-sec range) (* 24 60 60))))) (end-epoch (+ start-epoch range))
;; (if (= 0 spanned-days) (list (list :start-time start-time :range range)) (next t)
;; (let ((first-range (- (* 24 60 60) start-offset-sec)) (split-epoch nil)
;; (last-range (% (+ start-offset-sec range) (* 24 60 60)))) ((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) (defun org-x-cluster-split-day-bounds (tsps)
"Split timestamp-plists in TSPS via daily boundaries. "Split timestamp-plists in TSPS via daily boundaries.

View File

@ -378,7 +378,7 @@ Forms are denoted like %(FORM)%."
":PARENT_TYPE: iterator" ":PARENT_TYPE: iterator"
":END:" ":END:"
"** TODO sub" "** 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 => :actv
"project error" "project error"
@ -388,7 +388,7 @@ Forms are denoted like %(FORM)%."
":END:" ":END:"
"** NEXT sub" "** NEXT sub"
"*** TODO subsub" "*** 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) => :project-error)
(org-x--test-buffer-strings "Periodical status" (org-x--test-buffer-strings "Periodical status"
@ -416,7 +416,7 @@ Forms are denoted like %(FORM)%."
":PARENT_TYPE: periodical" ":PARENT_TYPE: periodical"
":END:" ":END:"
"** sub" "** 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 => :actv
"unscheduled" "unscheduled"
@ -427,5 +427,67 @@ Forms are denoted like %(FORM)%."
"** sub") "** sub")
=> :unscheduled) => :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) (provide 'org-x-test-buffer-state)
;;; org-x-test-buffer-state.el ends here ;;; org-x-test-buffer-state.el ends here