WIP convert weekly buffer status to tree-based representation

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

@@ -196,6 +196,10 @@ org tag and a long name respectively for the category.")
 ;; all follow the nomenclature `org-x-prop-PROPNAME' (key) or
 ;; `org-x-prop-PROPNAME-VALNAME' (value)
 
+(defconst org-x-prop-week-len "X-WEEK-LEN"
+  "The length of a week in the weekly plan.
+Should be an integer greater than 1.")
+
 (defconst org-x-prop-parent-type "PARENT_TYPE"
   "Property denoting iterator/periodical headline.")
 

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

@@ -222,6 +222,7 @@ Must be an integer from 0 - 6, with 0 = Sunday.")
 DATE-OFFSETS is a list of lists like (ABS OFFSET) where ABS is an
 absolute date and OFFSET is a positive integer representing a
 relative shift in days from ABS."
+  (print date-offsets)
   (cl-flet
       ((to-interval
         (acc date-offset)
@@ -1210,11 +1211,11 @@ deadline (eg via epoch time) or if it has a repeater."
         `(:complete (,@it-comptime :date ,date-abs))
         (either :right `(:complete (,@it-comptime :date ,date-abs)))
         (cond
-         ((-some->> it-planning (org-ml-get-properties :scheduled))
+         ((-some->> it-planning (org-ml-get-property :scheduled))
           (either :left "QTPs cannot be scheduled"))
          ((equal it-todo org-x-kw-todo)
           (-if-let (dead (-some->> it-planning
-                           (org-ml-get-properties :deadline)))
+                           (org-ml-get-property :deadline)))
               ;; ASSUME :parent-tags will contain the date tags as the level of
               ;; the plan will never exceed one
               (let ((dead-dt (->> (org-ml-timestamp-get-start-time dead)
@@ -1229,48 +1230,58 @@ deadline (eg via epoch time) or if it has a repeater."
           (org-x-dag-bs-error-kw "QTP" it-todo)))))))
 
 (defun org-x-dag-bs-wkp-leaf-inner (node-data ancestry child-bss)
-  (if (child-bss) (either :left "Weekly plan nodes cannot have children")
+  (if child-bss (either :left "Weekly plan nodes cannot have children")
     (org-x-dag-bs-with-closed node-data "weekly plan"
-      `(:complete ,it-comptime)
+      `(:leaf :complete ,it-comptime)
-      (either :right `(:complete ,it-comptime))
+      (either :right `(:leaf :complete ,it-comptime))
       (cond
-       ((-some->> it-planning (org-ml-get-properties :scheduled))
+       ((-some->> it-planning (org-ml-get-property :scheduled))
         (either :left "WKPs cannot be scheduled"))
-       ((-some->> it-planning (org-ml-get-properties :deadline))
+       ((-some->> it-planning (org-ml-get-property :deadline))
         (either :left "WKPs cannot be deadlined"))
        ((equal it-todo org-x-kw-todo)
-        (either :right `(:active)))
+        (either :right `(:leaf :active)))
        (t
         (org-x-dag-bs-error-kw "WKP" it-todo))))))
 
 (defun org-x-dag-bs-wkp-branch-inner (node-data ancestry child-bss)
   (org-x-dag-bs-with-closed node-data "weekly plan"
-    `(:complete ,it-comptime)
+    `(:branch :complete ,it-comptime)
-    (either :right `(:complete ,it-comptime))
+    (either :right `(:branch :complete ,it-comptime))
-    (let ((sched (-some->> it-planning (org-ml-get-properties :scheduled))))
+    (let ((sched (-some->> it-planning (org-ml-get-property :scheduled))))
       (cond
        ((or (not sched) (org-ml-time-is-long sched))
         (either :left "WKP day nodes must be short scheduled"))
-       ((-some->> it-planning (org-ml-get-properties :deadline))
+       ((-some->> it-planning (org-ml-get-property :deadline))
         (either :left "WKP day nodes cannot be deadlined"))
        ((equal it-todo org-x-kw-todo)
-        (either :right `(:active)))
+        (either :right `(:branch :active)))
        (t
         (org-x-dag-bs-error-kw "WKP day node" it-todo))))))
 
 (defun org-x-dag-bs-wkp-root-inner (node-data ancestry child-bss)
   (org-x-dag-bs-with-closed node-data "weekly plan"
-    `(:complete ,it-comptime)
+    `(:root :complete ,it-comptime)
     ;; TODO need to check the week length and the scheduled children
-    (either :right `(:complete ,it-comptime))
+    (either :right `(:root :complete ,it-comptime))
-    (let ((sched (-some->> it-planning (org-ml-get-properties :scheduled))))
+    (let ((sched (-some->> it-planning (org-ml-get-property :scheduled)))
+          ;; ASSUME anything that isn't actually a number will be converted to
+          ;; a zero and will fail the test below
+          (offset (->> (alist-get org-x-prop-week-len
+                                  (plist-get node-data :props)
+                                  nil nil #'equal)
+                       (string-to-number))))
       (cond
        ((or (not sched) (org-ml-time-is-long sched))
         (either :left "WKP root nodes must be short scheduled"))
-       ((-some->> it-planning (org-ml-get-properties :deadline))
+       ((-some->> it-planning (org-ml-get-property :deadline))
         (either :left "WKP root nodes cannot be deadlined"))
+       ((< offset 1)
+        (either :left "WKP root week length must be an int >= 1"))
        ((equal it-todo org-x-kw-todo)
-        (either :right `(:active)))
+        (let ((date (->> (org-ml-timestamp-get-start-time sched)
+                         (org-x-dag-date-to-absolute))))
+          (either :right `(:root :active (:date ,date :offset ,offset)))))
        (t
         (org-x-dag-bs-error-kw "WKP day node" it-todo))))))
 
@@ -1330,7 +1341,7 @@ deadline (eg via epoch time) or if it has a repeater."
    #'org-x-dag-bs-wkp-root-inner))
 
 (defun org-x-dag-bs-wkp (tree)
-  (-let (((n ns) (org-x-dag-bs-with-treetop tree #'org-x-dag-bs-wkp-inner)))
+  (-let (((n ns) (org-x-dag-bs-wkp-root tree nil)))
     (org-x-dag-bs-prefix :weekly `(,n ,@ns))))
 
 (defun org-x-dag-bs-dlp (tree)
@@ -2001,7 +2012,8 @@ removed from, added to, or edited within the DAG respectively."
                         (:action (list org-x-prop-parent-type
                                        org-x-prop-time-shift
                                        org-x-prop-routine
-                                       "ARCHIVE")))
+                                       "ARCHIVE"))
+                        (:weekly (list org-x-prop-week-len)))
                       (append def-props)))
           (bs-fun (pcase group
                     (:action #'org-x-dag-bs-action)
@@ -2060,19 +2072,23 @@ removed from, added to, or edited within the DAG respectively."
 
 (defun org-x-dag-weekly-span (date)
   (cl-flet
-      ((bs2date-offset
+      ((id-date-offset
-        (bs)
+        (adjlist id)
-        (-let (((_ _ (&plist :date d :offset o)) bs))
+        (either-from (org-x-dag-adjlist-id-bs adjlist id)
-          `(,d ,o))))
+          (-const nil)
+          (lambda (r)
+            (pcase r
+              (`(:weekly :root :active ,p)
+               (-let (((&plist :date d :offset o) p))
+                 `(,d ,o))))))))
     (-let* (((&plist :dag d :file->ids f) org-x-dag)
             (adjlist (dag-get-adjacency-list d))
             (weekly-file (-> (plist-get org-x-dag-files :plan-files)
                              (plist-get :weekly)))
             (abs (org-x-dag-date-to-absolute date))
             (ints (->> (ht-get f weekly-file)
-                       (--map (org-x-dag-adjlist-id-bs adjlist it))
+                       (--map (id-date-offset adjlist it))
-                       (either-rights)
+                       (-non-nil)
-                       (-map #'bs2date-offset)
                        (org-x-dag-weekly-intervals)
                        (interval-sort))))
       (-when-let (overlaps (nth 0 (interval-overlaps ints)))