ENH incoporate new timestamp splitter

local/lib/org-x/org-x.el

@@ -1138,23 +1138,37 @@ and slow."
 ;; using `org-element-parse-buffer' and a variety of filtering functions to
 ;; extract relevent timestamps.
 
-(defun org-x-cluster-make-tsp (unixtime range offset fp hardness &optional type)
+;; (defun org-x-cluster-make-tsp (unixtime range offset fp hardness &optional type)
+;;   "Construct a timestamp plist to be used in further processing.
+
+;; The fields are as follows:
+;; - UNIXTIME is the unixtime of the timestamp as an integer
+;; - RANGE is the duration of the timestamp (could be 0)
+;; - OFFSET is the character offset of the timestamp in its file
+;; - HARDNESS is a boolean denoting if the timestamp is 'hard' (has minutes and
+;;   hours) or 'soft' (only a date).
+;; - TYPE can be optionally supplied to denote kinds of timestamps
+;;   (only 'scheduled' for now).
+;; - FP the path to the file in which the timestamp resides"
+;;   (list :unixtime (round unixtime)
+;;         :range (or range 0)
+;;         :offset offset
+;;         :type type
+;;         :hardness hardness
+;;         :filepath fp))
+
+(defun org-x-cluster-make-tsp (start-time range offset fp)
   "Construct a timestamp plist to be used in further processing.
 
 The fields are as follows:
-- UNIXTIME is the unixtime of the timestamp as an integer
+
+- START-TIME is a list from `org-ml-timestamp-get-start-time'
 - RANGE is the duration of the timestamp (could be 0)
 - OFFSET is the character offset of the timestamp in its file
-- HARDNESS is a boolean denoting if the timestamp is 'hard' (has minutes and
-  hours) or 'soft' (only a date).
-- TYPE can be optionally supplied to denote kinds of timestamps
-  (only 'scheduled' for now).
 - FP the path to the file in which the timestamp resides"
-  (list :unixtime (round unixtime)
+  (list :start-time start-time
-        :range (or range 0)
+        :range range
         :offset offset
-        :type type
-        :hardness hardness
         :filepath fp))
         
 (defun org-x-cluster-ts-hard-p (ts)
@@ -1168,24 +1182,14 @@ or active-range types are considered. Returns a new timestamp-plist
 for TS."
   (when ts
     (let ((offset (org-element-property :begin hl))
-          (hardness (org-x-cluster-ts-hard-p ts))
+          (start-time (org-ml-timestamp-get-start-time ts))
-          (start (->> (org-ml-timestamp-get-start-time ts)
-                   (org-ml-time-to-unixtime)))
           (range (org-ml-timestamp-get-range ts)))
-      (org-x-cluster-make-tsp start 0 offset fp hardness))))
+      (org-x-cluster-make-tsp start-time range offset fp))))
         
 (defun org-x-cluster-effort-seconds (effort-str)
   "Convert EFFORT-STR into an integer in seconds from HH:MM format."
   (-some->> effort-str (org-duration-to-minutes) (* 60)))
 
-;; (defun org-x-cluster-extract (acc fun objs &rest args)
-;;   "Run FUN on each of OBJS and put results into accumulator ACC.
-;; FUN is a function that takes the accumulator as its first argument,
-;; one member of OBJS as the second, and ARGS as the rest if supplied."
-;;   (while objs
-;;     (setq acc (apply fun acc (car objs) args)
-;;           objs (cdr objs)))
-;;   acc)
 
 (defun org-x-cluster-extract-hl-sched (hl fp)
   "Extract scheduled timestamp from headline HL in filepath FP.
@@ -1195,10 +1199,8 @@ Create a new timestamp-plist and add to accumulator ACC."
     (let* ((effort-raw (org-ml-headline-get-node-property "Effort" hl))
            (effort (if effort-raw (org-x-cluster-effort-seconds effort-raw) 0))
            (offset (org-ml-get-property :begin hl))
-           (start-time (org-ml-timestamp-get-start-time ts))
+           (start-time (org-ml-timestamp-get-start-time ts)))
-           (start-epoch (org-ml-time-to-unixtime start-time))
+      (org-x-cluster-make-tsp start-time effort offset fp))))
-           (is-long (org-ml-time-is-long start-time)))
-      (org-x-cluster-make-tsp start-epoch effort offset fp is-long))))
 
 (defun org-x-cluster-extract-hl-ts (hl fp)
   "Extract timestamps from headline HL in filepath FP.
@@ -1254,23 +1256,22 @@ and added to accumulator ACC."
   (->> (org-ml-parse-headlines 'all)
     (org-x-cluster-filter-todo)
     (org-x-cluster-filter-habit)
-    (--reduce-from (let ((new (org-x-cluster-extract-hl it fp)))
+    (--map (org-x-cluster-extract-hl it fp))
-                     (if new (cons new acc) acc))
+    (-non-nil)))
-                   nil)))
 
 (defun org-x-cluster-extract-file (fp)
   "Extract timestamps from filepath FP and add to accumulator ACC."
   (with-current-buffer (find-file-noselect fp t)
     (org-x-cluster-extract-buffer fp)))
+
+(defun org-x-cluster-append-unixtime (tsps)
+  (--map (append (list :unixtime (org-ml-time-to-unixtime (plist-get it :start-time))) it) tsps))
   
 (defun org-x-cluster-get-unprocessed ()
   "Return a list of timestamp-plists with desired filter settings."
   (->> (org-agenda-files)
     (org-x-cluster-filter-files)
-    (--reduce-from (let ((new (org-x-cluster-extract-file it)))
+    (-mapcat #'org-x-cluster-extract-file)))
-                     (if new (append new acc) acc))
-                   nil)
-    (org-x-cluster-filter-past)))
 
 ;; get conflict headlines
 ;;
@@ -1317,9 +1318,11 @@ as a pair. New CONLIST is returned."
 Each member in the cons cell is a timestamp-plist."
   (->>
    (org-x-cluster-get-unprocessed)
-   (--filter (plist-get it :hardness))
+   (--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))
+   (org-x-cluster-build-conlist)))
 
 ;; get overloaded days
 ;;
@@ -1335,100 +1338,57 @@ Each member in the cons cell is a timestamp-plist."
 
 (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
+  ;; 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))
+  (cl-flet
-    (if (= range 0) (list tsp)
+      ((encode-float-time
-      (-let* (((y m d H M) start-time)
+        (time)
-              (start-time* (if (and H M) start-time `(,@start-time 0 0)))
+        (round (float-time (encode-time time)))))
-              (start-epoch (->> `(0 ,(or M 0) ,(or H 0) ,d ,m ,y nil nil nil)
+    (-let (((&plist :start-time :range :offset :filepath) tsp))
-                             (encode-time)
+      (if (= range 0) (list tsp)
-                             (float-time)
+        ;; `encode-time' and `decode-time' might not use the right time zone
-                             (round)))
+        ;; unless specified manually
-              (end-epoch (+ start-epoch range))
+        (-let* ((tz (current-time-zone))
-              (next t)
+                (start-time* (if (org-ml-time-is-long start-time) start-time
-              (split-epoch nil)
+                               `(,@start-time 0 0)))
-              ((M* H* d* m* y*) '(nil nil nil nil nil))
+                ((y m d H M) start-time*)
-              (acc nil))
+                (start-epoch (encode-float-time `(0 ,M ,H ,d ,m ,y nil nil ,tz)))
-        (while next
+                (end-epoch (+ start-epoch range))
-          ;; get the projected ending time
+                (next t)
-          (-setq (M* H* d* m* y*) (-take 5 (cdr (decode-time end-epoch))))
+                (split-epoch nil)
-          ;; Get the epoch time on which to split. If not on a day boundary,
+                ((M* H* d* m* y*) '(nil nil nil nil nil))
-          ;; calculate the epoch time of the most recent day boundary. If on a
+                (acc nil))
-          ;; day boundary, split on the boundary one full day earlier by
+          (while next
-          ;; decrementing day by one
+            ;; get the projected ending time
-          (when (and (= 0 M*) (= 0 H*))
+            (-setq (M* H* d* m* y*) (-take 5 (cdr (decode-time end-epoch tz))))
-            (setq d* (1- d*)))
+            ;; Get the epoch time on which to split. If not on a day boundary,
-          (setq split-epoch (->> `(0 0 0 ,d* ,m* ,y* nil nil nil)
+            ;; calculate the epoch time of the most recent day boundary. If on a
-                              (encode-time)
+            ;; day boundary, split on the boundary one full day earlier by
-                              (float-time)
+            ;; decrementing day by one
-                              (round)))
+            (when (and (= 0 M*) (= 0 H*))
-          ;; If the split-epoch is less than or equal to the start, loop is
+              (setq d* (1- d*)))
-          ;; done. Else add a new entry and reset the projected ending time to
+            (setq split-epoch (encode-float-time `(0 0 0 ,d* ,m* ,y* nil nil ,tz)))
-          ;; the current split time; rinse and repeat.
+            ;; If the split-epoch is less than or equal to the start, loop is
-          (if (< start-epoch split-epoch)
+            ;; done. Else add a new entry and reset the projected ending time to
-              (setq acc (cons (list :start-time `(,y* ,m* ,d* 0 0)
+            ;; the current split time; rinse and repeat.
-                                    :range (- end-epoch split-epoch)
+            (if (< start-epoch split-epoch)
-                                    :fp fp)
+                (setq acc (cons (org-x-cluster-make-tsp
-                              acc)
+                                 `(,y* ,m* ,d* 0 0) (- end-epoch split-epoch)
-                    end-epoch split-epoch)
+                                 offset filepath)
-            (setq next nil
+                                acc)
-                  acc (cons (list :start-time start-time*
+                      end-epoch split-epoch)
-                                  :range (- end-epoch start-epoch)
+              (setq next nil
-                                  :fp fp)
+                    acc (cons (org-x-cluster-make-tsp
-                            acc))))
+                               start-time* (- end-epoch start-epoch) offset filepath)
-        acc))))
+                              acc))))
+          acc)))))
 
-(defun org-x-cluster-split-day-bounds (tsps)
-  "Split timestamp-plists in TSPS via daily boundaries.
-Returns a new timestamp-plist with equal or greater length depending
-on how many members needed splitting."
-  (letrec
-      ((new
-        (lambda (start end tsp)
-          (org-x-cluster-make-tsp start
-                                      (- end start)
-                                      (plist-get tsp :offset)
-                                      (plist-get tsp :filepath)
-                                      (plist-get tsp :hardness)
-                                      (plist-get tsp :type))))
-       ;; need to temporarily offset the epoch time so day
-       ;; boundaries line up in local time
-       (split
-        (lambda (start end tsp)
-          (let* ((tzs-a (-> start current-time-zone car))
-                 (tzs-b (-> end current-time-zone car))
-                 (start* (-> end
-                           (+ tzs-b)
-                           (ceiling 86400)
-                           (1-)
-                           (* 86400)
-                           (- tzs-b))))
-            (if (> start* (-> start (+ tzs-a) (floor 86400) (* 86400) (- tzs-a)))
-                (cons (funcall new start* end tsp)
-                      (funcall split start start* tsp))
-              (list (funcall new start end tsp))))))
-       (split-maybe
-        (lambda (tsp)
-          (let* ((start (plist-get tsp :unixtime))
-                 (end (+ start (plist-get tsp :range)))
-                 (tzs (-> start current-time-zone car)))
-            (if (< (-> start (+ tzs) (ceiling 86400)) end)
-                (funcall split start end tsp)
-              tsp)))))
-    (--mapcat (funcall split-maybe it) tsps)))
 
 (defun org-x-cluster-daily-split (tsps)
   "Group timestamp-plist TSPS into sublists for each day."
-  (letrec ((tz-shift (lambda (tsp) (-> tsp current-time-zone car (+ tsp)))))
+  (--partition-by (-take 3 (plist-get it :start-time)) tsps))
-    (->>
-     tsps
-     (--partition-by (--> it
-                          (plist-get it :unixtime)
-                          (funcall tz-shift it)
-                          (floor it 86400))))))
                           
 (defun org-x-cluster-overloaded-p (tsps)
   "Return t if total time of timestamp-plists in TSPS exceeds 24 hours.
@@ -1447,7 +1407,9 @@ is overloaded. If a day is not overloaded there will be nothing for it
 in the returned list."
   (->> (org-x-cluster-get-unprocessed)
     (--filter (< 0 (plist-get it :range)))
-    (org-x-cluster-split-day-bounds)
+    (-mapcat #'org-x-cluster-split-tsp-maybe)
+    (org-x-cluster-append-unixtime)
+    (org-x-cluster-filter-past)
     (--sort (< (plist-get it :unixtime) (plist-get other :unixtime)))
     (org-x-cluster-daily-split)
     (--filter (org-x-cluster-overloaded-p it))))

local/lib/org-x/test/org-x-test-buffer-state.el

@@ -430,64 +430,68 @@ Forms are denoted like %(FORM)%."
 (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)
+  (let ((forms
-                 (--map (-let (((title input _useless-sugar output) it))
+         (->> (-partition 4 specs)
-                          `(it ,title
+           (--map (-let* (((title input _useless-sugar output) it)
-                             (expect (org-x-cluster-split-tsp-maybe ,input)
+                          (extra '(:offset 0 :filepath "bass4urface"))
-                                     :to-equal
+                          (input* (append input extra))
-                                     ,output)))))))
+                          (output* (--map (append it extra) output)))
+                    `(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)
-  => '((:start-time (2021 1 1 0 0) :range 0 :fp ""))
+  => ((:start-time (2021 1 1 0 0) :range 0))
 
   "1-hour range"
-  '(:start-time (2021 1 1 0 0) :range 3600 :fp "")
+  (:start-time (2021 1 1 0 0) :range 3600)
-  => '((:start-time (2021 1 1 0 0) :range 3600 :fp ""))
+  => ((:start-time (2021 1 1 0 0) :range 3600))
 
   "12-hour range (noon start)"
-  '(:start-time (2021 1 1 12 0) :range 43200 :fp "")
+  (:start-time (2021 1 1 12 0) :range 43200)
-  => '((:start-time (2021 1 1 12 0) :range 43200 :fp ""))
+  => ((:start-time (2021 1 1 12 0) :range 43200))
 
   "24-hour range (day boundary)"
-  '(:start-time (2021 1 1 0 0) :range 86400 :fp "")
+  (:start-time (2021 1 1 0 0) :range 86400)
-  => '((:start-time (2021 1 1 0 0) :range 86400 :fp ""))
+  => ((:start-time (2021 1 1 0 0) :range 86400))
 
   "24-hour range (noon start)"
-  '(:start-time (2021 1 1 12 0) :range 86400 :fp "")
+  (:start-time (2021 1 1 12 0) :range 86400)
-  => '((:start-time (2021 1 1 12 0) :range 43200 :fp "")
+  => ((:start-time (2021 1 1 12 0) :range 43200)
-       (:start-time (2021 1 2 0 0) :range 43200 :fp ""))
+       (:start-time (2021 1 2 0 0) :range 43200))
 
   "48-hour range (day boundary)"
-  '(:start-time (2021 1 1 0 0) :range 172800 :fp "")
+  (:start-time (2021 1 1 0 0) :range 172800)
-  => '((:start-time (2021 1 1 0 0) :range 86400 :fp "")
+  => ((:start-time (2021 1 1 0 0) :range 86400)
-       (:start-time (2021 1 2 0 0) :range 86400 :fp ""))
+       (:start-time (2021 1 2 0 0) :range 86400))
 
   "48-hour range (noon start)"
-  '(:start-time (2021 1 1 12 0) :range 172800 :fp "")
+  (:start-time (2021 1 1 12 0) :range 172800)
-  => '((:start-time (2021 1 1 12 0) :range 43200 :fp "")
+  => ((:start-time (2021 1 1 12 0) :range 43200)
-       (:start-time (2021 1 2 0 0) :range 86400 :fp "")
+       (:start-time (2021 1 2 0 0) :range 86400)
-       (:start-time (2021 1 3 0 0) :range 43200 :fp ""))
+       (:start-time (2021 1 3 0 0) :range 43200))
 
   "zero range (short)"
-  '(:start-time (2021 1 1) :range 0 :fp "")
+  (:start-time (2021 1 1) :range 0)
-  => '((:start-time (2021 1 1) :range 0 :fp ""))
+  => ((:start-time (2021 1 1) :range 0))
 
   "1-hour range (short)"
-  '(:start-time (2021 1 1) :range 3600 :fp "")
+  (:start-time (2021 1 1) :range 3600)
-  => '((:start-time (2021 1 1 0 0) :range 3600 :fp ""))
+  => ((:start-time (2021 1 1 0 0) :range 3600))
 
   "24-hour range (short)"
-  '(:start-time (2021 1 1) :range 86400 :fp "")
+  (:start-time (2021 1 1) :range 86400)
-  => '((:start-time (2021 1 1 0 0) :range 86400 :fp ""))
+  => ((:start-time (2021 1 1 0 0) :range 86400))
 
   "48-hour range (short)"
-  '(:start-time (2021 1 1) :range 172800 :fp "")
+  (:start-time (2021 1 1) :range 172800)
-  => '((:start-time (2021 1 1 0 0) :range 86400 :fp "")
+  => ((:start-time (2021 1 1 0 0) :range 86400)
-       (:start-time (2021 1 2 0 0) :range 86400 :fp "")))
+       (:start-time (2021 1 2 0 0) :range 86400)))
 
 (provide 'org-x-test-buffer-state)
 ;;; org-x-test-buffer-state.el ends here