ADD better timestamp splitter and tests
This commit is contained in:
parent
eb2f538ba5
commit
e17ac965a1
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue