ADD endpoint goal status function
This commit is contained in:
parent
f9ecc76494
commit
2c9143c413
|
@ -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))
|
||||||
|
|
||||||
|
(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)
|
(defun org-x-dag-id->action-status (id in-iteratorp)
|
||||||
(cl-flet*
|
(cl-flet*
|
||||||
((get-child-statuses
|
((to-valid-closed
|
||||||
(id iteratorp)
|
|
||||||
;; 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 (((shallow deep)
|
|
||||||
(->> (org-x-dag-id->buffer-children id)
|
|
||||||
(--reduce-from
|
|
||||||
(-let (((child . subchildren)
|
|
||||||
(org-x-dag-id->action-status it iteratorp))
|
|
||||||
((acc-children acc-subchildren) acc))
|
|
||||||
`((,child ,@acc-children)
|
|
||||||
(,@subchildren ,@acc-subchildren)))
|
|
||||||
nil))))
|
|
||||||
(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,56 +1914,53 @@ 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
|
||||||
(cond
|
(cond
|
||||||
((org-x-dag-id->any-illegal-p id)
|
((org-x-dag-id->any-illegal-p id)
|
||||||
"Action has illegal links")
|
"Action has illegal links")
|
||||||
((not (org-x-dag-id->created-in-past-p id))
|
((not (org-x-dag-id->created-in-past-p id))
|
||||||
"Action must have creation timestamp in the past")
|
"Action must have creation timestamp in the past")
|
||||||
((and closed (not (member kw org-x-done-keywords)))
|
((and closed (not (member kw org-x-done-keywords)))
|
||||||
"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 it (org-x-dag-id->planning-timestamp :deadline id))
|
||||||
((and c-statuses
|
"Actions with children cannot be deadlined")
|
||||||
(org-x-dag-id->planning-timestamp :deadline id))
|
((and iteratorp in-iteratorp)
|
||||||
"Actions with children cannot be deadlined")
|
"Iterators cannot be nested")))
|
||||||
((and iteratorp in-iteratorp)
|
(org-x-dag-status-error id general-error)
|
||||||
"Iterators cannot be nested")))
|
(cond
|
||||||
(org-x-dag-status-error id general-error)
|
;; CANC actions work the same regardless of action type; if the
|
||||||
(cond
|
;; closed timestamp is archivable, its :archivable, otherwise it is
|
||||||
;; CANC actions work the same regardless of action type; if the
|
;; :complete (NOTE that this is 'nice' because I made it such that
|
||||||
;; closed timestamp is archivable, its :archivable, otherwise it
|
;; :complete and :archivable have the same meaning and key for all
|
||||||
;; is :complete (NOTE that this is 'nice' because I made it such
|
;; action types)
|
||||||
;; that :complete and :archivable have the same meaning and key
|
((equal kw org-x-kw-canc)
|
||||||
;; for all action types)
|
(let ((type (cond
|
||||||
((equal kw org-x-kw-canc)
|
(iteratorp :iterator)
|
||||||
(let ((type (cond
|
(in-iteratorp
|
||||||
(iteratorp :iterator)
|
(if it :iterator-project :iterator-task))
|
||||||
(in-iteratorp
|
(t
|
||||||
(if c-statuses :iterator-project :iterator-task))
|
(if it :project :task)))))
|
||||||
(t
|
(to-valid-closed id type closed)))
|
||||||
(if c-statuses :project :task)))))
|
;; assuming none of the general checks above matched, try more
|
||||||
(to-valid-closed id type closed)))
|
;; specific checks depending on if the current action is an iterator
|
||||||
;; assuming none of the general checks above matched, try more
|
;; (and if we are inside one)
|
||||||
;; specific checks depending on if the current action is an
|
(iteratorp
|
||||||
;; iterator (and if we are inside one)
|
(iterator-status id kw closed it))
|
||||||
(iteratorp
|
(in-iteratorp
|
||||||
(iterator-status id kw closed c-statuses))
|
(iterator-project-status id kw closed it))
|
||||||
(in-iteratorp
|
(t
|
||||||
(iterator-project-status id kw closed c-statuses))
|
(project-status id kw closed it))))))))
|
||||||
(t
|
|
||||||
(project-status id kw closed c-statuses))))))
|
|
||||||
`(,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.
|
||||||
|
|
Loading…
Reference in New Issue