From 43a2ac7ebd5c0ef83fb3eda75dcc006d8670b925 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sat, 26 Mar 2022 17:29:26 -0400 Subject: [PATCH] REF remove lots of useless dead code --- local/lib/org-x/org-x-dag.el | 669 +++-------------------------------- 1 file changed, 49 insertions(+), 620 deletions(-) diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el index 245987e..41dfe60 100644 --- a/local/lib/org-x/org-x-dag.el +++ b/local/lib/org-x/org-x-dag.el @@ -2055,57 +2055,56 @@ 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))) - (cl-case cgroup - ;; the only allowed links are local - ((:lifetime :survival) - (unless (equal cfile pfile) - :ill-foreign)) - ;; should only link locally or a lifetime goal - (:endpoint - (unless (or (equal cfile pfile) (eq pgroup :lifetime)) - :ill-foreign)) - ;; should only link to an endpoint or lifetime goal - (:quarterly - (cond - ((memq pgroup '(:endpoint :lifetime)) nil) - ((equal pfile cfile) :ill-local) - (t :ill-foreign))) - ;; should only link to a quarterly plan - (:weekly - (cond - ((eq pgroup :quarterly) nil) - ((equal pfile cfile) :ill-local) - (t :ill-foreign))) - ;; should only link to a weekly plan or an action - (:daily - (cond - ((memq pgroup '(nil :weekly)) nil) - ((equal pfile cfile) :ill-local) - (t :ill-foreign))) - ;; actions can only be linked to goal files, and nothing else - (t - (cond - ((memq pgroup '(:lifetime :endpoint :survival)) nil) - ((equal pfile cfile) :ill-local) - (t :ill-foreign)))))) - -;; TODO this will also include broken links, which isn't totally wrong but these -;; should be filtered out as including them is suboptimal (note: I figureed out -;; they were here because the broken links dag code is wrong) -(defun org-x-dag-filter-links (relations) - (cl-flet - ((flatten-relation - (rel) - (-let (((c . ps) rel)) - (--map (list c it) ps)))) - (-let (((&alist :ill-foreign :ill-local) - (->> (-mapcat #'flatten-relation relations) - (--group-by (apply #'org-x-dag-id->parent-class it))))) - (list ill-foreign ill-local)))) +;; (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))) +;; (cl-case cgroup +;; ;; the only allowed links are local +;; ((:lifetime :survival) +;; (unless (equal cfile pfile) +;; :ill-foreign)) +;; ;; should only link locally or a lifetime goal +;; (:endpoint +;; (unless (or (equal cfile pfile) (eq pgroup :lifetime)) +;; :ill-foreign)) +;; ;; should only link to an endpoint or lifetime goal +;; (:quarterly +;; (cond +;; ((memq pgroup '(:endpoint :lifetime)) nil) +;; ((equal pfile cfile) :ill-local) +;; (t :ill-foreign))) +;; ;; should only link to a quarterly plan +;; (:weekly +;; (cond +;; ((eq pgroup :quarterly) nil) +;; ((equal pfile cfile) :ill-local) +;; (t :ill-foreign))) +;; ;; should only link to a weekly plan or an action +;; (:daily +;; (cond +;; ((memq pgroup '(nil :weekly)) nil) +;; ((equal pfile cfile) :ill-local) +;; (t :ill-foreign))) +;; ;; actions can only be linked to goal files, and nothing else +;; (t +;; (cond +;; ((memq pgroup '(:lifetime :endpoint :survival)) nil) +;; ((equal pfile cfile) :ill-local) +;; (t :ill-foreign)))))) +;; ;; TODO this will also include broken links, which isn't totally wrong but these +;; ;; should be filtered out as including them is suboptimal (note: I figureed out +;; ;; they were here because the broken links dag code is wrong) +;; (defun org-x-dag-filter-links (relations) +;; (cl-flet +;; ((flatten-relation +;; (rel) +;; (-let (((c . ps) rel)) +;; (--map (list c it) ps)))) +;; (-let (((&alist :ill-foreign :ill-local) +;; (->> (-mapcat #'flatten-relation relations) +;; (--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)) @@ -2127,576 +2126,6 @@ removed from, added to, or edited within the DAG respectively." (-when-let (e (org-x-dag-id->created-epoch id)) (<= e (float-time)))) -(defun org-x-dag-id->0th-status (id) - (cl-flet* - ((check-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")) - (t - (when (org-x-dag-id->is-closed-p id) - "closed headlines must be marked DONE/CANC")))) - (check-todo-or-done - (id kw) - (or (check-done id kw) - (unless (equal kw org-x-kw-todo) - "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 - (: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 - ;; - closed keywords must be marked DONE/CANC - (t (check-done id kw)))))))) - -;; type Status = Either String (Enum, a) -;; data NodeData a = Status { props :: [something], status = Status a } - -(defun org-x-dag-status-valid (id data) - `(:valid :id ,id :data ,data)) - -(defun org-x-dag-status-error (id msg) - `(:error :id ,id :msg ,msg)) - -(defmacro org-x-dag-status>>= (status form) - "Treat STATUS like an Either monad. -FORM should take the data of a valid status bound to 'it' and -return another status." - (declare (indent 1)) - `(pcase ,status - (`(:error . ,d) `(:error ,@d)) - (`(:valid . ,it) ,form))) - -(defmacro org-x-dag-status-with-data (status form) - (declare (indent 1)) - `(org-x-dag-status>>= status - (-let (((&plist :id it-id :data it-data) it)) - ,form))) - -(defmacro org-x-dag-status-from-data (status form) - (declare (indent 1)) - `(pcase ,status - (`(:error . ,_) nil) - (`(:valid . ,d) - (-let (((&plist :id it-id :data it-data) d)) - ,form)))) - -(defun org-x-dag-action-status (id action-type code) - ;; action types and their codes - ;; - ;; :task - ;; - :archivable - ;; - :complete - ;; - :active - ;; - ;; :project - ;; - :archivable - ;; - :complete - ;; - :stuck - ;; - :held - ;; - :wait - ;; - :active - ;; - ;; :iterator - ;; - :archivable - ;; - :complete - ;; - :empty - ;; - :active - ;; - :future - ;; - ;; :iterator-task/project - ;; - :archivable - ;; - :complete - ;; - :active - ;; - :future - (org-x-dag-status-valid id (list :code code :action-type action-type))) - -(defun org-x-dag-endpoint-status (id deadline code) - (org-x-dag-status-valid id (list :code code :deadline deadline))) - -;; (defun org-x-dag-id->task-status (id) -;; (cl-flet -;; ((to-valid -;; (code) -;; (org-x-dag-action-status id :task code)) -;; (to-error -;; (msg) -;; (org-x-dag-status-error id msg))) -;; (let ((kw (org-x-dag-id->todo id))) -;; (-if-let (c (org-x-dag-id->planning-epoch :closed id)) -;; (if (member kw org-x-done-keywords) -;; (->> (if (org-x-dag-time-is-archivable-p c) :archivable :complete) -;; (to-valid)) -;; (to-error "Closed id must be marked DONE/CANC")) -;; (cond -;; ((member kw org-x-done-keywords) -;; (to-error "Done id's must have closed timestamp")) -;; (t -;; (to-valid :active))))))) - -(defun org-x-dag-status-is-error-p (status) - (eq (car status) :error)) - -(defmacro org-x-dag-id->with-child-statuses (id child-statuses codelist - to-valid-form rank-form - childless-form) - (declare (indent 3)) - (let ((c (make-symbol "--child-statuses")) - (i (make-symbol "--id"))) - `(-if-let (,c ,child-statuses) - (let* ((,i ,id) - (ranks (--map (org-x-dag-status-from-data it ,rank-form) - ,child-statuses))) - (if (-any #'null ranks) - (org-x-dag-status-error ,i "Child-dependent error") - (pcase (nth (-max ranks) ',codelist) - (`nil (error "Invalid index returned during child translation")) - (`(:error ,msg) (org-x-dag-status-error ,i msg)) - (`(:valid ,it) ,to-valid-form)))) - ,childless-form))) - -(defmacro org-x-dag-id->with-action-child-statuses (id child-statuses action-type - codelist trans-fun - childless-form) - (declare (indent 3)) - `(org-x-dag-id->with-child-statuses ,id ,child-statuses ,codelist - (org-x-dag-action-status ,id ,action-type it) - (-let (((&plist :action-type a :code c) it-data)) - (funcall ,trans-fun it-id a c)) - ,childless-form)) - -(defmacro org-x-dag-id->with-endpoint-child-statuses (id child-statuses deadline - codelist trans-fun - childless-form) - (declare (indent 3)) - `(org-x-dag-id->with-child-statuses ,id ,child-statuses ,codelist - (org-x-dag-endpoint-status ,id ,deadline it) - (-let (((&plist :deadline d :code c) it-data)) - (funcall ,trans-fun it-id ,deadline d c)) - ,childless-form)) - -(defmacro org-x-dag-id->with-nested-buffer-children (id child-form node-form) - (declare (indent 1)) - ;; Distinguish between immediate children and all deeper children; - ;; assume that the car of anything returned by - ;; `org-x-dag-id->action-status' is the parent of all the status - ;; objects in the cdr, so map these together - `(let* ((results (->> (org-x-dag-id->buffer-children ,id) - (--map ,child-form))) - (it (-map #'car results))) - (->> (apply #'append results) - (cons ,node-form)))) - -(defun org-x-dag-id->action-status (id in-iteratorp) - (cl-flet - ((iterator-status - (id kw closed c-statuses) - (cond - ((not (org-x-dag-id->node-property "ARCHIVE" id)) - (org-x-dag-status-error id "Iterator must have ARCHIVE set")) - ((not (org-x-dag-id->node-property org-x-prop-time-shift id)) - (->> (format "Iterator must have %s set" org-x-prop-time-shift) - (org-x-dag-status-error id))) - ((equal kw org-x-done-keywords) - (org-x-dag-id->with-action-child-statuses id c-statuses :iterator - ((:valid :complete) - (:error "Complete iterators can only have complete child nodes")) - (lambda (_ type code) - (when (memq type '(:iterator-task :iterator-project)) - (pcase code - (:complete 0) - (:active 1)))) - (org-x-dag-action-status id :iterator :complete))) - ((equal kw org-x-kw-todo) - (org-x-dag-id->with-action-child-statuses id c-statuses :iterator - ((:valid :empty) - (:valid :active)) - (lambda (_ type code) - (when (memq type '(:iterator-task :iterator-project)) - (pcase code - (:complete 0) - (:active 1)))) - (org-x-dag-action-status id :iterator :empty))) - (t - (funcall to-error "Iterator can only have DONE/CANC/TODO keywords")))) - - (iterator-project-status - (id kw closed c-statuses) - (cond - ((equal kw org-x-kw-done) - (org-x-dag-id->with-action-child-statuses id c-statuses :iterator-project - ((:valid :complete) - (:error "Complete iterator projects can only have complete children")) - (lambda (_ type code) - (when (memq type '(:iterator-task :iterator-project)) - (pcase code - (:complete 0) - (:active 1)))) - (org-x-dag-action-status id :iterator-task :complete))) - ((equal kw org-x-kw-todo) - (org-x-dag-id->with-action-child-statuses id c-statuses :iterator-project - ((:error "Open iterator projects must have at least one active child") - (:valid :active)) - (lambda (_ type code) - (when (memq type '(:iterator-project :iterator-task)) - (pcase code - (:complete 0) - (:active 1)))) - (if (or (org-x-dag-id->planning-epoch :scheduled id) - (org-x-dag-id->planning-epoch :deadline id)) - (org-x-dag-action-status id :iterator-task :active) - (->> "Iterator tasks must be scheduled or deadlined" - (org-x-dag-status-error id))))) - (t - (->> (format "Iterated action has invalid keyword: %s" kw) - (org-x-dag-status-error id))))) - - (project-status - (id kw closed c-statuses) - (cond - ((equal kw org-x-kw-done) - (->> - (org-x-dag-id->with-action-child-statuses id c-statuses :project - ((:valid :complete) - (:error "DONE projects can only have complete child nodes")) - ;; TODO figure out what to do when a key doesn't match, it - ;; should make an error but not sure if it should be a - ;; runtime error or a returned status error - (lambda (_ type code) - (pcase `(,type ,code) - (`(,_ :complete) 0) - (`(:project ,(or :stuck :held :wait :active)) 1) - (`(:task :active) 1) - (`(:iterator ,(or :active :future :empty) 1)) - (e (error "Invalid task/code combination: %S" e)))) - (to-valid-closed id :task closed)) - (check-archivable id closed))) - ((equal kw org-x-kw-todo) - (org-x-dag-id->with-action-child-statuses id c-statuses :project - ((:error "TODO projects should have at least one active child") - (:valid :stuck) - (:valid :held) - (:valid :wait) - (:valid :active)) - (lambda (id type code) - (pcase `(,type ,code) - (`(,_ :complete) 0) - (`(:project :stuck) 1) - (`(:project :held) 2) - (`(:project :wait) 3) - (`(:project :active) 4) - (`(:task ,_) - (let ((kw (org-x-dag-id->todo id))) - (cond - ((equal kw org-x-kw-hold) 2) - ((equal kw org-x-kw-wait) 3) - ((equal kw org-x-kw-next) 4) - ((equal kw org-x-kw-todo) - (if (org-x-dag-id->planning-timestamp :scheduled id) 4 1)) - (t - (error "Could not translate task with keyword: %s" kw))))) - (`(:iterator :empty) 1) - (`(:iterator :active) 4) - (e (error "Invalid task/code combination: %S" e)))) - (org-x-dag-action-status id :task :active))) - (t - (if c-statuses - (if (equal kw org-x-kw-hold) - (org-x-dag-action-status id :project :held) - (->> (format "Projects cannot be marked %s" kw) - (org-x-dag-status-error))) - (org-x-dag-action-status id :task :active)))))) - - (-let ((kw (org-x-dag-id->todo id)) - (closed (org-x-dag-id->planning-timestamp :closed id)) - (iteratorp (org-x-dag-id->is-iterator-p id))) - (org-x-dag-id->with-nested-buffer-children id - (org-x-dag-id->action-status it iteratorp) - ;; first check for a bunch of errors that are equally valid at any - ;; level in the DAG - (-if-let (general-error - (cond - ((org-x-dag-id->any-illegal-p id) - "Action has illegal links") - ((not (org-x-dag-id->created-in-past-p id)) - "Action must have creation timestamp in the past") - ((and closed (not (member kw org-x-done-keywords))) - "Closed actions must be marked with DONE/CANC") - ((and (not closed) (member kw org-x-done-keywords)) - "DONE/CANC actions must have closed timestamp") - ((and it (org-x-dag-id->planning-timestamp :scheduled id)) - "Actions with children cannot be scheduled") - ((and it (org-x-dag-id->planning-timestamp :deadline id)) - "Actions with children cannot be deadlined") - ((and iteratorp in-iteratorp) - "Iterators cannot be nested"))) - (org-x-dag-status-error id general-error) - (cond - ;; CANC actions work the same regardless of action type - ((equal kw org-x-kw-canc) - (let ((type (cond - (iteratorp :iterator) - (in-iteratorp - (if it :iterator-project :iterator-task)) - (t - (if it :project :task))))) - (org-x-dag-action-status id type :complete))) - ;; assuming none of the general checks above matched, try more - ;; specific checks depending on if the current action is an iterator - ;; (and if we are inside one) - (iteratorp - (iterator-status id kw closed it)) - (in-iteratorp - (iterator-project-status id kw closed it)) - (t - (project-status id kw closed it)))))))) - -(defun org-x-dag-status-check-todo-or-done (id to-error alt-fun) - (declare (indent 2)) - (org-x-dag-status-check-done id kw to-error - (lambda (id) - (let ((kw (org-x-dag-id->todo id))) - (if (equal kw org-x-kw-todo) - (to-error "Keyword must be marked TODO/DONE") - (funcall alt-fun id)))))) - -(defun org-x-dag-id->illegal-link-error (id) - (when (org-x-dag-id->any-illegal-p id) - "Node has illegal links")) - -(defun org-x-dag-done-closed-error (kw closed) - (cond - ((and closed (not (member kw org-x-done-keywords))) - "Closed nodes must be marked with DONE/CANC") - ((and (not closed) (member kw org-x-done-keywords)) - "DONE/CANC nodes must have closed timestamp"))) - -(defun org-x-dag-id->created-error (id) - (unless (org-x-dag-id->node-property org-x-prop-created id) - "Node must have creation timestamp")) - -;; TODO it might make more sense to make a 'status' independent of time, such -;; that as time changes, we don't need to constantly recalculate this -(defun org-x-dag-id->endpoint-status (id) - (let ((kw (org-x-dag-id->todo id)) - (closed (org-x-dag-id->planning-timestamp :closed id))) - (org-x-dag-id->with-nested-buffer-children id - (org-x-dag-id->endpoint-status it) - (-if-let (general-error - (or (org-x-dag-id->illegal-link-error id) - (org-x-dag-id->created-error id) - (org-x-dag-done-closed-error kw closed) - (cond - ((org-x-dag-id->planning-timestamp :scheduled id) - "Endpoint goals cannot be scheduled") - ((member kw (list org-x-kw-next org-x-kw-hold org-x-kw-wait)) - "Endpoint goal has invalid keyword: %s" kw)))) - (org-x-dag-status-error id general-error) - (if (equal kw org-x-kw-canc) - (org-x-dag-endpoint-status id nil :complete) - (let ((deadline (org-x-dag-id->planning-epoch :deadline id))) - (if (equal kw org-x-kw-done) - (org-x-dag-id->with-endpoint-child-statuses id it deadline - ((:valid :complete) - (:error "Closed endpoint goals must only have closed children")) - (lambda (_ _ _ code) - (pcase code - (:complete 0) - (:active 1))) - (org-x-dag-endpoint-status id nil :complete)) - (org-x-dag-id->with-endpoint-child-statuses id it deadline - ((:error "Open endpoint goals must have at least one open child") - (:valid :active) - (:error "Child deadline cannot occur after this deadline")) - (lambda (_ this-deadline child-deadline code) - (if (and this-deadline child-deadline - (< deadline child-deadline)) - 2 - (pcase code - (:active 1) - (:complete 2)))) - (org-x-dag-endpoint-status id deadline :active))))))))) - -(defun org-x-dag-toplevel-goal-status (id) - (org-x-dag-status-valid id :toplevel-goal)) - -(defun org-x-dag-id->toplevel-goal-status (id) - (-if-let (err (or (org-x-dag-id->illegal-link-error id) - (org-x-dag-id->created-error id) - (when (org-x-dag-id->metaprop :planning id) - "Toplevel goals cannot have planning elements.") - (unless (equal org-x-kw-todo (org-x-dag-id->todo id)) - "Toplevel goals can only be TODO"))) - (org-x-dag-status-error id general-error) - (org-x-dag-toplevel-goal-status id))) - -(defun org-x-dag-qtp-status (id code deadline) - (org-x-dag-status-valid id (list :code code :deadline))) - -(defun org-x-dag-id->qtp-status (id) - (let ((kw (org-x-dag-id->todo id)) - (closed (org-x-dag-id->planning-timestamp :closed id))) - (-if-let (err (or (org-x-dag-id->illegal-link-error id) - (org-x-dag-id->created-error id) - (org-x-dag-done-closed-error kw closed) - (unless (eq 4 (org-x-dag-id->level id)) - "Quarterly plans cannot have children") - (when (org-x-dag-id->planning-timestamp :scheduled id) - "Quarterly plans cannot be scheduled"))) - (org-x-dag-status-error id general-error) - (if (member kw org-x-done-keywords) - (org-x-dag-qtp-status id :complete) - (-if-let (deadline (org-x-dag-id->planning-datetime :deadline id)) - (if (org-ml-time-is-long) - (org-x-dag-status-error id "Quarterly plan deadlines must be short") - (let ((qdate (->> (org-x-dag-id->tags nil id) - (org-x-dag-quarter-tags-to-date)))) - (if (org-x-dag-datetime< deadline qdate) - (->> "Quarterly plan deadlines must start within/after quarter" - (org-x-dag-status-error id)) - (org-x-dag-qtp-status id :active deadline)))) - (org-x-dag-qtp-status id :active nil)))))) - -(defun org-x-dag-wkp-status (id code) - (org-x-dag-status-valid id (list :code code))) - -(defun org-x-dag-id->wkp-status (id) - (let ((kw (org-x-dag-id->todo id)) - (closed (org-x-dag-id->planning-timestamp :closed id))) - (-if-let (err (or (org-x-dag-id->illegal-link-error id) - (org-x-dag-id->created-error id) - (org-x-dag-done-closed-error kw closed) - (unless (eq 4 (org-x-dag-id->level id)) - "Weekly plans cannot have children") - (when (org-x-dag-id->planning-timestamp :scheduled id) - "Quarterly plans cannot be scheduled") - (when (org-x-dag-id->planning-timestamp :deadline id) - "Quarterly plans cannot be deadlined"))) - (org-x-dag-status-error id general-error) - (if (member kw org-x-done-keywords) - (org-x-dag-qtp-status id :complete) - (org-x-dag-qtp-status id :active))))) - -(defun org-x-dag-wkp-status (id code scheduled) - (org-x-dag-status-valid id (list :code code :scheduled scheduled))) - -(defun org-x-dag-id->dlp-status (id) - (let ((kw (org-x-dag-id->todo id)) - (closed (org-x-dag-id->planning-timestamp :closed id))) - (-if-let (err (or (org-x-dag-id->illegal-link-error id) - (org-x-dag-id->created-error id) - (org-x-dag-done-closed-error kw closed) - (unless (eq 4 (org-x-dag-id->level id)) - "Daily plans cannot have children") - (when (org-x-dag-id->planning-timestamp :deadline id) - "Daily plans cannot be deadlined"))) - (org-x-dag-status-error id general-error) - (if (member kw org-x-done-keywords) - (org-x-dag-wlp-status id :complete nil) - (let ((scheduled (org-x-dag-id->planning-datetime :scheduled id))) - (if (not (and scheduled (org-ml-time-is-long scheduled))) - (->> "Daily plans must have long scheduled timestamp" - (org-x-dag-status-error id)) - ;; ASSUME this won't fail (likewise for quarterly plans) - (let ((ddate (->> (org-x-dag-id->tags nil id) - (org-x-dag-daily-tags-to-date)))) - (if (org-x-dag-datetime= ddate (-take 3 scheduled)) - (org-x-dag-wkp-status id :active scheduled) - (->> "Daily plan scheduled timestamp at wrong date" - (org-x-dag-status-error id)))))))))) - -(defun org-x-dag-id->file-level-status (id) - "Return file-level status of ID and its children. - -Assume ID is a toplevel headline. Return an alist where the car -of each cell is the ID and the cdr is its status." - (-let (((_ group) (org-x-dag-id->file-group id))) - (cl-case group - (:action - (org-x-dag-id->action-status id)) - (:endpoint - (org-x-dag-id->endpoint-status id))))) - -;; (defun org-x-dag-file-level-status (ids) -;; (->> (--filter (org-x-dag-id->is-toplevel-p it) ids) -;; ;; TODO this function doesn't exist yet -;; (--filter (org-x-dag-id->error id)))) - - ;; 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