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
;; 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.

View File

@ -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