ADD 0th order node validation

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

@@ -183,9 +183,10 @@
 
 ;; variables to store state
 
-(defun org-x-dag-create (d m fis il if c fs)
+(defun org-x-dag-create (d m fis il if s c fs)
   (list :dag d
         :id->meta m
+        :id->status s
         :file->ids fis
         :illegal-local il
         :illegal-foreign if
@@ -223,6 +224,7 @@
                     (ht-create #'equal)
                     (ht-create #'equal)
                     (ht-create #'equal)
+                    (ht-create #'equal)
                     (org-x-dag-current-date)
                     nil))
 
@@ -326,6 +328,10 @@ Return one of seven values: :lifetime, :survival, :endpoint,
   "Return point for ID."
   (org-x-dag-id->metaprop id :point))
 
+(defun org-x-dag-id->level (id)
+  "Return level for ID."
+  (org-x-dag-id->metaprop id :level))
+
 (defun org-x-dag-id->todo (id)
   "Return todo keyword for ID."
   (org-x-dag-id->metaprop id :todo))
@@ -511,6 +517,12 @@ Return value is a list like (BUFFER LOCAL FOREIGN)."
   "Return t if ID has done keywords."
   (member (org-x-dag-id->todo id) org-x-done-keywords))
 
+(defun org-x-dag-id->is-closed-p (id)
+  "Return t if ID is closed.
+This means the ID has a closed timestamp in the past."
+  (-when-let (c (org-x-dag-id->planning-epoch :closed id))
+    (<= c (float-time))))
+
 (defun org-x-dag-id->id-survival-p (id)
   "Return t if ID has a parent survival goal."
   (let ((f (org-x-dag->goal-file :survival)))
@@ -617,6 +629,22 @@ be uncommitted if it is also incubated."
 (defun org-x-dag-filter-ids-tags (tags ids)
   (--filter (-intersection (org-x-dag-id->tags nil it) tags) ids))
 
+(defun org-x-dag-quarter-tags-to-date (tags)
+  (-let (((y q) (reverse tags)))
+    (org-x-dag-quarter-to-date (list (org-x-dag-tag-to-year y)
+                                     (org-x-dag-tag-to-quarter q)))))
+
+(defun org-x-dag-weekly-tags-to-date (tags)
+  (-let (((y w) (reverse tags)))
+    (org-x-dag-week-number-to-date (list (org-x-dag-tag-to-year y)
+                                         (org-x-dag-tag-to-week w)))))
+
+(defun org-x-dag-daily-tags-to-date (tags)
+  (-let (((y m d) (reverse tags)))
+    (org-x-dag-week-number-to-date (list (org-x-dag-tag-to-year y)
+                                         (org-x-dag-tag-to-month m)
+                                         (org-x-dag-tag-to-day d)))))
+
 (defun org-x-dag-date-to-quarter-tags (date)
   (-let (((y q) (org-x-dag-date-to-quarter date)))
     (list (org-x-dag-format-year-tag y)
@@ -785,8 +813,33 @@ A date like (YEAR MONTH DAY).")
     (5 . "FRI")
     (6 . "SAT")))
 
+(defun org-x-dag--parse-date-tag (prefix tag)
+  (let ((re (format "%s\\([0-9]+\\)" prefix)))
+    (-some->> (s-match re tag)
+      (nth 1)
+      (string-to-number))))
+
+(defun org-x-dag-tag-to-year (tag)
+  (-some->> (org-x-dag--parse-date-tag "Y" tag)
+    (+ 2000)))
+
+(defun org-x-dag-tag-to-quarter (tag)
+  (org-x-dag--parse-date-tag "Q" tag))
+
+(defun org-x-dag-tag-to-week (tag)
+  (org-x-dag--parse-date-tag "W" tag))
+
+(defun org-x-dag-tag-to-day-of-week (tag)
+  (car (rassoc tag org-x-dag-weekly-tags)))
+
+(defun org-x-dag-tag-to-month (tag)
+  (org-x-dag--parse-date-tag "M" tag))
+
+(defun org-x-dag-tag-to-day (tag)
+  (org-x-dag--parse-date-tag "D" tag))
+
 (defun org-x-dag-format-year-tag (year)
-  (format "Y%d" (mod year 2000)))
+  (format "Y%02d" (mod year 2000)))
 
 (defun org-x-dag-format-quarter-tag (quarter)
   (format "Q%d" quarter))
@@ -1391,7 +1444,6 @@ removed from, added to, or edited within the DAG respectively."
                  (dag-edit-nodes to-remove to-insert dag))))
     (plist-put org-x-dag :dag dag*)))
 
-
 (defun org-x-dag-id->parent-class (id parent)
   (-let* (((cfile cgroup) (org-x-dag-id->file-group id))
           ((pfile pgroup) (org-x-dag-id->file-group parent)))
@@ -1443,6 +1495,121 @@ removed from, added to, or edited within the DAG respectively."
                  (--group-by (apply #'org-x-dag-id->parent-class it)))))
       (list ill-foreign ill-local))))
 
+
+(defun org-x-dag-id->illegal-parents (which id)
+  (ht-get (plist-get org-x-dag which) id))
+
+(defun org-x-dag-id->has-illegal-children-p (which id)
+  (ht-find (lambda (_ v) (member id v)) (plist-get org-x-dag which)))
+
+(defun org-x-dag-id->any-illegal-p (id)
+  (or (org-x-dag-id->illegal-parents :illegal-foreign id)
+      (org-x-dag-id->illegal-parents :illegal-local id)
+      (org-x-dag-id->has-illegal-children-p :illegal-foreign id)
+      (org-x-dag-id->has-illegal-children-p :illegal-local id)))
+
+(defun org-x-dag-id->created-epoch (id)
+  (-some->> (org-x-dag-id->node-property org-x-prop-created id)
+    (org-2ft)))
+
+(defun org-x-dag-id->created-in-past-p (id)
+  (-when-let (e (org-x-dag-id->created-epoch id))
+    (<= e (float-time))))
+
+(defun org-x-dag-id->0th-status (id)
+  (cl-flet
+      ((check-todo-or-done
+        (id kw)
+        (cond
+         ((member kw org-x-done-keywords)
+          (unless (org-x-dag-id->is-closed-p id)
+            "DONE/CANC headlines must be closed"))
+         ((equal kw org-x-kw-todo)
+          (when (org-x-dag-id->is-closed-p id)
+            "closed headlines must be marked DONE/CANC"))
+         (t
+          "keyword must be TODO or DONE")))
+       (check-not-scheduled
+        (id)
+        (when (org-x-dag-id->planning-timestamp :scheduled id)
+          "scheduled timestamps not allowed"))
+       (check-not-deadlined
+        (id)
+        (when (org-x-dag-id->planning-timestamp :deadline id)
+          "deadlined timestamps not allowed"))
+       (check-level
+        (level id)
+        (unless (= level (org-x-dag-id->level id))
+          (format "headline must have level %d" level))))
+    (cond
+     ;; all nodes must have legal nodes and have a creation timestamp
+     ((org-x-dag-id->any-illegal-p id)
+      "has illegal links")
+     ((not (org-x-dag-id->created-in-past-p id))
+      "must have creation timestamp in the past")
+     (t
+      (-let (((_ group) (org-x-dag-id->file-group id))
+             (kw (org-x-dag-id->todo id)))
+        (cl-case group
+          ;; lifetime/survival nodes
+          ;; - can only be marked TODO (they never end)
+          ;; - cannot be marked with CLOSED/SCHEDULED/DEADLINE
+          ((:lifetime :survival)
+           (cond
+            ((not (equal kw org-x-kw-todo))
+             "keyword must be TODO")
+            ((org-x-dag-id->metaprop :planning id)
+             "planning element not allowed")))
+          ;; endpoint nodes
+          ;; - cannot be SCHEDULED
+          ;; - can only be TODO or DONE/CANC with CLOSED
+          (:endpoint
+           (or (check-not-scheduled id)
+               (check-todo-or-done id kw)))
+          ;; quarterly plan nodes
+          ;; - can only be level 4 headlines
+          ;; - cannot be SCHEDULED
+          ;; - can only be TODO or DONE/CANC with CLOSED
+          ;; - if DEADLINE, timestamp must start on/after the quarter
+          (:quarterly
+           (or (check-level 4 id)
+               (check-not-scheduled id)
+               (check-todo-or-done id kw)
+               (-when-let (d (org-x-dag-id->planning-datetime :deadline id))
+                 (when (->> (org-x-dag-id->tags nil id)
+                            (org-x-dag-quarter-tags-to-date)
+                            (org-x-dag-datetime< d))
+                   "deadline occurs after quarter start"))))
+          ;; weekly plan nodes
+          ;; - can only level 4
+          ;; - cannot be SCHEDULED or DEADLINE
+          ;; - can only be TODO or DONE/CANC with CLOSED
+          ;; - if DEADLINE, timestamp must start on/after the quarter
+          (:weekly
+           (or (check-level 4 id)
+               (check-not-scheduled id)
+               (check-not-deadlined id)
+               (check-todo-or-done id kw)))
+          ;; daily plan nodes
+          ;; - can only be level 4 headlines
+          ;; - can only be TODO or DONE/CANC with CLOSED
+          ;; - must be SCHEDULED with long timestamp on the indicated day
+          (:daily
+           (or (check-level 4 id)
+               (check-todo-or-done id kw)
+               (-let (((date time) (->> (org-x-dag-id->planning-datetime id)
+                                        (org-x-dag-datetime-split))))
+                 (cond
+                  ((not (and date time))
+                   "must have HH:MM scheduled timestamp")
+                  ((->> (org-x-dag-id->tags nil id)
+                        (org-x-dag-daily-tags-to-date)
+                        (org-x-dag-datetime= date))
+                   "timestamp must be within the calendar date")))))
+          ;; action nodes
+          ;; - anything goes...apparently
+          (t nil)))))))
+
 ;; TODO there is a HUGE DIFFERENCE between a 'key' (the things in the hash table
 ;; the look things up) and a 'node' (which is a cons cell, the car of which is a
 ;; 'key' and the cdr of which is a 'relation'). These names suck, but the point
@@ -1453,7 +1620,11 @@ removed from, added to, or edited within the DAG respectively."
 TO-REMOVE, TO-INSERT, and TO-UPDATE are lists of files to remove
 from, add to, and update with the DAG. FILE-STATE is a nested
 plist holding the files to be used in the DAG."
-  (-let* (((&plist :id->meta :file->ids :illegal-foreign if :illegal-local il)
+  (-let* (((&plist :id->meta
+                   :file->ids
+                   :illegal-foreign if
+                   :illegal-local il
+                   :id->status)
            org-x-dag)
           (files2rem (append to-update to-remove))
           (files2ins (append to-update to-insert))
@@ -1468,7 +1639,12 @@ plist holding the files to be used in the DAG."
     ;; figure out which links are illegal
     (-let (((illegal-foreign illegal-local) (org-x-dag-filter-links links2ins)))
       (org-x-dag-update-ht files2rem illegal-foreign if)
-      (org-x-dag-update-ht files2rem illegal-local il))))
+      (org-x-dag-update-ht files2rem illegal-local il))
+    ;; update node-level status after figuring out which are invalid via links
+    (let ((status2ins (->> (-map #'car ids2ins)
+                           (--map (cons it (org-x-dag-id->0th-status it))))))
+      (org-x-dag-update-ht ids2rem status2ins id->status))))
+    
 
 (defun org-x-dag-sync (&optional force)
   "Sync the DAG with files from `org-x-dag-get-files'.
@@ -1882,6 +2058,14 @@ except it ignores inactive timestamps."
   (-some->> (org-x-dag-id->metaprop id :planning)
     (org-ml-get-property which)))
 
+(defun org-x-dag-id->planning-datetime (which id)
+  (-some->> (org-x-dag-id->planning-timestamp which id)
+    (org-ml-timestamp-get-start-time)))
+
+(defun org-x-dag-id->planning-epoch (which id)
+  (-some->> (org-x-dag-id->planning-datetime which id)
+    (org-ml-time-to-unixtime)))
+
 (defun org-x-dag-id->node-property (prop id)
   (alist-get prop (org-x-dag-id->metaprop id :props) nil nil #'equal))