ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ADD endpoint goal status function

This commit is contained in:
Nathan Dwarshuis 2022-03-12 23:29:30 -05:00
parent f9ecc76494
commit 2c9143c413
1 changed files with 137 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
local/lib/org-x/org-x-dag.el
View File

@ -1684,8 +1684,8 @@ return another status."
;; - :future ;; - :future
(org-x-dag-status-valid id (list :code code :action-type action-type))) (org-x-dag-status-valid id (list :code code :action-type action-type)))
(defun org-x-dag-goal-status (id code deadline) (defun org-x-dag-endpoint-status (id deadline code)
(org-x-dag-status-valid (list :code code :deadline deadline))) (org-x-dag-status-valid id (list :code code :deadline deadline)))
;; (defun org-x-dag-id->task-status (id) ;; (defun org-x-dag-id->task-status (id)
;; (cl-flet ;; (cl-flet
@ -1738,25 +1738,31 @@ return another status."
(funcall ,trans-fun it-id a c)) (funcall ,trans-fun it-id a c))
,childless-form)) ,childless-form))
(defun org-x-dag-id->action-status (id in-iteratorp) (defmacro org-x-dag-id->with-endpoint-child-statuses (id child-statuses deadline
(cl-flet* codelist trans-fun
((get-child-statuses childless-form)
(id iteratorp) (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; ;; Distinguish between immediate children and all deeper children;
;; assume that the car of anything returned by ;; assume that the car of anything returned by
;; `org-x-dag-id->action-status' is the parent of all the status ;; `org-x-dag-id->action-status' is the parent of all the status
;; objects in the cdr, so map these together ;; objects in the cdr, so map these together
(-let (((shallow deep) `(let* ((results (->> (org-x-dag-id->buffer-children ,id)
(->> (org-x-dag-id->buffer-children id) (--map ,child-form)))
(--reduce-from (it (-map #'car results)))
(-let (((child . subchildren) (->> (apply #'append results)
(org-x-dag-id->action-status it iteratorp)) (cons ,node-form))))
((acc-children acc-subchildren) acc))
`((,child ,@acc-children) (defun org-x-dag-id->action-status (id in-iteratorp)
(,@subchildren ,@acc-subchildren))) (cl-flet*
nil)))) ((to-valid-closed
(list shallow deep)))
(to-valid-closed
(id type ts) (id type ts)
(->> (if (->> (org-ml-timestamp-get-start-time ts) (->> (if (->> (org-ml-timestamp-get-start-time ts)
(org-ml-time-to-unixtime) (org-ml-time-to-unixtime)
@ -1908,11 +1914,11 @@ return another status."
(org-x-dag-status-error))) (org-x-dag-status-error)))
(org-x-dag-action-status id :task :active)))))) (org-x-dag-action-status id :task :active))))))
(-let* ((kw (org-x-dag-id->todo id)) (-let ((kw (org-x-dag-id->todo id))
(closed (org-x-dag-id->planning-timestamp :closed id)) (closed (org-x-dag-id->planning-timestamp :closed id))
(iteratorp (org-x-dag-id->is-iterator-p id)) (iteratorp (org-x-dag-id->is-iterator-p id)))
((c-statuses subc-statuses) (get-child-statuses id iteratorp)) (org-x-dag-id->with-nested-buffer-children id
(this-status (org-x-dag-id->action-status it iteratorp)
;; first check for a bunch of errors that are equally valid at any ;; first check for a bunch of errors that are equally valid at any
;; level in the DAG ;; level in the DAG
(-if-let (general-error (-if-let (general-error
@ -1925,39 +1931,36 @@ return another status."
"Closed actions must be marked with DONE/CANC") "Closed actions must be marked with DONE/CANC")
((and (not closed) (member kw org-x-done-keywords)) ((and (not closed) (member kw org-x-done-keywords))
"DONE/CANC actions must have closed timestamp") "DONE/CANC actions must have closed timestamp")
((and c-statuses ((and it (org-x-dag-id->planning-timestamp :scheduled id))
(org-x-dag-id->planning-timestamp :scheduled id))
"Actions with children cannot be scheduled") "Actions with children cannot be scheduled")
((and c-statuses ((and it (org-x-dag-id->planning-timestamp :deadline id))
(org-x-dag-id->planning-timestamp :deadline id))
"Actions with children cannot be deadlined") "Actions with children cannot be deadlined")
((and iteratorp in-iteratorp) ((and iteratorp in-iteratorp)
"Iterators cannot be nested"))) "Iterators cannot be nested")))
(org-x-dag-status-error id general-error) (org-x-dag-status-error id general-error)
(cond (cond
;; CANC actions work the same regardless of action type; if the ;; CANC actions work the same regardless of action type; if the
;; closed timestamp is archivable, its :archivable, otherwise it ;; closed timestamp is archivable, its :archivable, otherwise it is
;; is :complete (NOTE that this is 'nice' because I made it such ;; :complete (NOTE that this is 'nice' because I made it such that
;; that :complete and :archivable have the same meaning and key ;; :complete and :archivable have the same meaning and key for all
;; for all action types) ;; action types)
((equal kw org-x-kw-canc) ((equal kw org-x-kw-canc)
(let ((type (cond (let ((type (cond
(iteratorp :iterator) (iteratorp :iterator)
(in-iteratorp (in-iteratorp
(if c-statuses :iterator-project :iterator-task)) (if it :iterator-project :iterator-task))
(t (t
(if c-statuses :project :task))))) (if it :project :task)))))
(to-valid-closed id type closed))) (to-valid-closed id type closed)))
;; assuming none of the general checks above matched, try more ;; assuming none of the general checks above matched, try more
;; specific checks depending on if the current action is an ;; specific checks depending on if the current action is an iterator
;; iterator (and if we are inside one) ;; (and if we are inside one)
(iteratorp (iteratorp
(iterator-status id kw closed c-statuses)) (iterator-status id kw closed it))
(in-iteratorp (in-iteratorp
(iterator-project-status id kw closed c-statuses)) (iterator-project-status id kw closed it))
(t (t
(project-status id kw closed c-statuses)))))) (project-status id kw closed it))))))))
`(,this-status ,@c-statuses ,@subc-statuses))))
(defun org-x-dag-id->has-done-error-p (id) (defun org-x-dag-id->has-done-error-p (id)
(or (and (not (org-x-dag-id->is-done-p id)) (org-x-dag-id->is-closed-p id)) (or (and (not (org-x-dag-id->is-done-p id)) (org-x-dag-id->is-closed-p id))
@ -1972,29 +1975,71 @@ return another status."
(to-error "Keyword must be marked TODO/DONE") (to-error "Keyword must be marked TODO/DONE")
(funcall alt-fun id)))))) (funcall alt-fun id))))))
;; (defun org-x-dag-id->endpoint-status (id) (defun org-x-dag-id->illegal-link-error (id)
;; (cl-flet (when (org-x-dag-id->any-illegal-p id)
;; ((to-status "Node has illegal links"))
;; (type code)
;; (org-x-dag-goal-status id :status type code)) (defun org-x-dag-done-closed-error (kw closed)
;; (to-error (cond
;; (type msg) ((and closed (not (member kw org-x-done-keywords)))
;; (org-x-dag-goal-status id :error type msg))) "Closed nodes must be marked with DONE/CANC")
;; (let ((child-statuses (->> (org-x-dag-id->buffer-children id) ((and (not closed) (member kw org-x-done-keywords))
;; (-mapcat #'org-x-dag-id->endpoint-status))) "DONE/CANC nodes must have closed timestamp")))
;; (this-status
;; (cond (defun org-x-dag-id->created-error (id)
;; ((org-x-dag-id->has-done-error-p id) (unless (org-x-dag-id->created-in-past-p id)
;; (to-error :branch "Closed timestamps must have DONE/CANC")) "Node must have creation timestamp in the past"))
;; ((org-x-dag-id->planning-timestamp :scheduled id)
;; (to-error :branch "Endpoint goals cannot be scheduled")) (defun org-x-dag-id->endpoint-status (id)
;; ((equal kw org-x-kw-todo) (cl-flet*
;; (to-status :branch :active)) ((to-valid-closed
;; ((org-x-dag-id->is-done-p id) (id ts)
;; (to-status :branch :complete)) (->> (if (->> (org-ml-timestamp-get-start-time ts)
;; ((not children) (org-ml-time-to-unixtime)
;; ()))) (org-x-dag-time-is-archivable-p))
;; `(,this-status ,@child-statuses))))) :archivable
:complete)
(org-x-dag-endpoint-status id nil))))
(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)
(to-valid-closed id closed)
(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 :archivable)
(:valid :complete)
(:error "Closed endpoint goals must only have closed children"))
(lambda (_ _ _ code)
(pcase code
(:archivable 0)
(:complete 1)
(:active 2)))
(to-valid-closed id closed))
(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)
((or :complete :archivable) 2))))
(org-x-dag-endpoint-status id deadline :active))))))))))
(defun org-x-dag-id->file-level-status (id) (defun org-x-dag-id->file-level-status (id)
"Return file-level status of ID and its children. "Return file-level status of ID and its children.