REF remove lots of useless dead code
This commit is contained in:
parent
a58a1dec70
commit
43a2ac7ebd
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue