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

ADD iterator junk to the action status function

This commit is contained in:
Nathan Dwarshuis 2022-03-10 23:16:00 -05:00
parent 1cfbf77ade
commit bd9e60b676
1 changed files with 176 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1649,8 +1649,9 @@ removed from, added to, or edited within the DAG respectively."
(defun org-x-dag-status-is-error-p (status) (defun org-x-dag-status-is-error-p (status)
(eq (car (cdr status)) :error)) (eq (car (cdr status)) :error))
(defmacro org-x-dag-id->with-project-children (id child-statuses codetree task-fun) (defmacro org-x-dag-id->with-child-statuses (id child-statuses task-key
(declare (indent 2)) project-key codetree task-fun)
(declare (indent 4))
(let ((flat-codes (-map #'car codetree)) (let ((flat-codes (-map #'car codetree))
(proj-ranking-tbl (proj-ranking-tbl
(->> codetree (->> codetree
@ -1669,17 +1670,126 @@ removed from, added to, or edited within the DAG respectively."
(let* ((ranks (--map (-let (((id . status) it)) (let* ((ranks (--map (-let (((id . status) it))
(pcase status (pcase status
(`(:error _) nil) (`(:error _) nil)
(`(:status (:type :task :code ,code)) (`(:status (:type ,k :code ,code))
(alist-get code ',proj-ranking-tbl)) (cl-case k
(`(:status (:type :project :code ,code)) (,task-key
(funcall ,task-fun id code)))) (alist-get code ',proj-ranking-tbl))
(,project-key
(funcall ,task-fun id code))))))
,child-statuses))) ,child-statuses)))
(if (-any #'null ranks) (if (-any #'null ranks)
(to-status :error "Child error") (to-status :error "Child error")
(->> (nth (-max ranks) ',flat-codes) (->> (nth (-max ranks) ',flat-codes)
(apply #'to-status))))))) (apply #'to-status)))))))
;; TODO where do iterators fit into this? ;; TODO not DRY
(defun org-x-dag-id->iterator-task-status (id)
(cl-flet
((to-status
(type data)
(org-x-dag-id-action-status id type :task data)))
(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-status :status))
(to-status :error "Closed iterator tasks must be marked DONE/CANC"))
(cond
((member kw org-x-done-keywords)
(to-status :error "Done iterator tasks must have closed timestamp"))
((equal kw org-x-k-todo)
(-if-let (ts (or (org-x-dag-id->planning-epoch :scheduled id)
(org-x-dag-id->planning-epoch :deadline id)))
(if (< org-x-iterator-active-future-offset (- ts (float-time)))
(to-status :status :future)
(to-status :status :active))
(to-status :error "Iterator tasks must be scheduled or deadlined")))
(t
(to-status :error "Iterator tasks cannot have keyword: %s" kw)))))))
(defun org-x-dag-id->iterator-project-status (id)
(cl-flet
((to-status
(code)
(org-x-dag-id-action-status id :status :project code))
(to-error
(msg)
(org-x-dag-id-action-status id :error :project msg)))
(let ((kw (org-x-dag-id->todo id))
(child-statuses
(->> (org-x-dag-id->buffer-children id)
(-mapcat #'org-x-dag-id->iterator-project-status)))
(status
(cond
((not child-statuses)
(org-x-dag-id->iterator-task-status id))
((org-x-dag-id->planning-timestamp :scheduled id)
(to-error "Iterator project nodes cannot be scheduled"))
((equal kw org-x-kw-canc)
(to-status :complete))
((equal kw org-x-kw-done)
(org-x-dag-id->with-child-statuses id child-statuses :iterator-task :iterator-project
(((:status :archivable))
((:status :complete))
((:error "Complete iterator projects can only have complete children")
:active :future))
(lambda (_ code)
(cl-case code
(:archivable 0)
(:closed 1)
(t 2)))))
((equal kw org-x-kw-todo)
(org-x-dag-id->with-child-statuses id child-statuses :iterator-task :iterator-project
(((:error "Open iterator projects need to have at least one active child")
:complete :archivable)
((:status :active))
((:status :future)))
(lambda (_ code)
(cl-case code
((:archivable :complete) 0)
(:active 1)
(:future 2)))))
(t
(to-error (format "Iterator projects has invalid keyword: %s" kw))))))
`(,status ,@child-statuses))))
(defun org-x-dag-headline-get-iterator-status (id)
(cl-flet
((to-status
(code)
(org-x-dag-id-action-status id :status :iterator code))
(to-error
(msg)
(org-x-dag-id-action-status id :error :iterator msg)))
(let* ((kw (org-x-dag-id->todo id))
(child-statuses
(->> (org-x-dag-id->buffer-children id)
(-mapcat #'org-x-dag-id->iterator-project-status)))
(this-status
(cond
((not (org-x-dag-id->node-property "ARCHIVE" id))
(to-error "Iterator must have ARCHIVE set"))
((not (org-x-dag-id->node-property org-x-prop-time-shift id))
(to-error "Iterator must have %s set" org-x-prop-time-shift))
;; TODO this is set up to assume that iterators will never be
;; archived, which is almost true (with almost doing some heavy lifting)
((not (equal kw org-x-kw-todo))
(to-error "Iterators can only be marked TODO"))
((not child-statuses)
(to-status :empty))
(t
;; TODO this is utterly gross...
(let ((s (if (--any-p (pcase (cdr it)
(`(:status (:type ,(or :iterator-task
:iterator-proejct)
:code :future))
t))
child-statuses)
:future
:active)))
(to-status s))))))
`(,this-status ,@child-statuses))))
(defun org-x-dag-id->action-status (id) (defun org-x-dag-id->action-status (id)
(cl-flet (cl-flet
((to-status ((to-status
@ -1688,61 +1798,65 @@ removed from, added to, or edited within the DAG respectively."
(to-error (to-error
(msg) (msg)
(org-x-dag-id-action-status id :error :project msg))) (org-x-dag-id-action-status id :error :project msg)))
(let* ((keyword (org-x-dag-id->todo id)) (if (org-x-dag-id->is-iterator-p id)
(child-statuses (->> (org-x-dag-id->buffer-children id) (org-x-dag-headline-get-iterator-status id)
(-mapcat #'org-x-dag-id->action-status))) (let* ((keyword (org-x-dag-id->todo id))
(this-status (child-statuses (->> (org-x-dag-id->buffer-children id)
(cond (-mapcat #'org-x-dag-id->action-status)))
((org-x-dag-id->any-illegal-p id) (this-status
(to-error "Node has illegal links")) (cond
((not (org-x-dag-id->created-in-past-p id)) ;; TODO this isn't done for iterators
(to-error "Node must have creation timestamp in the past")) ((org-x-dag-id->any-illegal-p id)
((not child-statuses) (to-error "Node has illegal links"))
(org-x-dag-id->task-status id)) ((not (org-x-dag-id->created-in-past-p id))
((org-x-dag-id->planning-timestamp :scheduled id) (to-error "Node must have creation timestamp in the past"))
(to-error "Projects cannot be scheduled")) ((org-x-dag-id->is-iterator-p id)
((equal keyword org-x-kw-hold) ((not child-statuses)
(to-status :held)) (org-x-dag-id->task-status id))
((member keyword org-x--project-invalid-todostates) ((org-x-dag-id->planning-timestamp :scheduled id)
(->> (s-join ", " org-x--project-invalid-todostates) (to-error "Projects cannot be scheduled"))
(format "Projects cannot have these keywords: %s") ((equal keyword org-x-kw-hold)
(to-error))) (to-status :held))
((equal keyword org-x-kw-canc) ((member keyword org-x--project-invalid-todostates)
(->> (if (org-x-dag-id->is-archivable-p id) :archivable :complete) (->> (s-join ", " org-x--project-invalid-todostates)
(to-status))) (format "Projects cannot have these keywords: %s")
((equal keyword org-x-kw-done) (to-error)))
(org-x-dag-id->with-project-children id child-statuses ((equal keyword org-x-kw-canc)
(((:status :archivable)) (->> (if (org-x-dag-id->is-archivable-p id) :archivable :complete)
((:status :complete)) (to-status)))
((:error "DONE projects can only have complete child nodes") ((equal keyword org-x-kw-done)
:stuck :held :wait :active)) (org-x-dag-id->with-child-statuses id child-statuses :task :project
(lambda (_ code) (((:status :archivable))
(cl-case code ((:status :complete))
(:archivable 0) ((:error "DONE projects can only have complete child nodes")
(:complete 1) :stuck :held :wait :active))
(:active 2))))) (lambda (_ code)
((equal keyword org-x-kw-todo) (cl-case code
(org-x-dag-id->with-project-children id child-statuses (:archivable 0)
(((:error "TODO projects should have at least one active child") (:complete 1)
:archivable :complete) (:active 2)))))
((:status :stuck)) ((equal keyword org-x-kw-todo)
((:status :held)) (org-x-dag-id->with-child-statuses id child-statuses :task :project
((:status :wait)) (((:error "TODO projects should have at least one active child")
((:status :active))) :archivable :complete)
(lambda (id _) ((:status :stuck))
(let ((kw (org-x-dag-id->todo id))) ((:status :held))
(cond ((:status :wait))
((equal kw org-x-kw-todo) ((:status :active)))
(if (org-x-dag-id->planning-timestamp :scheduled id) 4 1)) (lambda (id _)
((equal kw org-x-kw-hold) 2) (let ((kw (org-x-dag-id->todo id)))
((equal kw org-x-kw-wait) 3) (cond
((equal kw org-x-kw-next) 4) ((equal kw org-x-kw-todo)
;; ASSUME anything that doesn't have the above keywords (if (org-x-dag-id->planning-timestamp :scheduled id) 4 1))
;; is either :archivable or :complete in which case it ((equal kw org-x-kw-hold) 2)
;; is an error ((equal kw org-x-kw-wait) 3)
(t 0)))))) ((equal kw org-x-kw-next) 4)
(t (error "Could not determine status for '%s'" id))))) ;; ASSUME anything that doesn't have the above keywords
`(,this-status ,@child-statuses)))) ;; is either :archivable or :complete in which case it
;; is an error
(t 0))))))
(t (error "Could not determine status for '%s'" id))))))
`(,this-status ,@child-statuses)))))
(defun org-x-dag-id->endpoint-status (id) (defun org-x-dag-id->endpoint-status (id)
()) ())