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

ENH check for created timestamps in goals and actions

This commit is contained in:
Nathan Dwarshuis 2022-04-26 22:38:03 -04:00
parent a4b78d226e
commit ed3581ccb6
1 changed files with 33 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -581,8 +581,6 @@ used for optimization."
;; buffer status ;; buffer status
;; TODO need to check for created timestamps
;; [Status a] -> b -> (a -> a -> Status Bool) -> (a -> Bool) -> (a -> Status b) ;; [Status a] -> b -> (a -> a -> Status Bool) -> (a -> Bool) -> (a -> Status b)
;; -> Status b ;; -> Status b
(defmacro org-x-dag-bs-fold-children (bss default rank-form stop-form trans-form) (defmacro org-x-dag-bs-fold-children (bss default rank-form stop-form trans-form)
@ -612,8 +610,18 @@ used for optimization."
(either>>= final ,trans-form)))) (either>>= final ,trans-form))))
(either :right ,default)))) (either :right ,default))))
(defmacro org-x-dag-left (fmt &rest args)
`(either :left (format ,fmt ,@args)))
(defun org-x-dag-bs-error-kw (type-name kw) (defun org-x-dag-bs-error-kw (type-name kw)
(either :left (format "%ss cannot have keyword '%s" type-name kw))) (org-x-dag-left "%ss cannot have keyword '%s" type-name kw))
(defmacro org-x-dag-bs-check-created (node-data &rest body)
(declare (indent 1))
`(if (not (alist-get org-x-prop-created (plist-get ,node-data :props)
nil nil #'equal))
(either :left "CREATED timestamp not set")
,@body))
(defmacro org-x-dag-bs-with-closed (node-data type-name canc-bs-form (defmacro org-x-dag-bs-with-closed (node-data type-name canc-bs-form
done-form open-form) done-form open-form)
@ -636,11 +644,10 @@ used for optimization."
(let ((it-comptime (complete-time ,c nil))) (let ((it-comptime (complete-time ,c nil)))
,done-form)) ,done-form))
(t (t
(->> (format "Closed %s must be marked CANC/DONE" ,type-name) (org-x-dag-left "Closed %s must be marked CANC/DONE" type-name)))
(either :left))))
(cond (cond
((member it-todo org-x-done-keywords) ((member it-todo org-x-done-keywords)
(either :left (format "DONE/CANC %s must be closed" ,type-name))) (org-x-dag-left "DONE/CANC %s must be closed" type-name))
(t (t
,open-form))))))) ,open-form)))))))
@ -658,17 +665,15 @@ used for optimization."
(let ((canc-bs-form* (wrap-ancestry canc-bs-form)) (let ((canc-bs-form* (wrap-ancestry canc-bs-form))
(done-form* (lift-form done-form)) (done-form* (lift-form done-form))
(open-form* (lift-form open-form))) (open-form* (lift-form open-form)))
`(-let ((it-children (--map (either>>= it `(org-x-dag-bs-check-created ,node-data
(->> (plist-get it :local) (-let ((it-children (--map (either>>= it
(either :right))) (->> (plist-get it :local)
,child-bss))) (either :right)))
;; (print "----") ,child-bss)))
;; (print child-bss) (org-x-dag-bs-with-closed ,node-data ,type-name
;; (print it-children) ,canc-bs-form*
(org-x-dag-bs-with-closed ,node-data ,type-name ,done-form*
,canc-bs-form* ,open-form*))))))
,done-form*
,open-form*)))))
(defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss) (defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss)
(cl-flet (cl-flet
@ -1063,8 +1068,6 @@ used for optimization."
(either<$> it (either<$> it
(-let (((&plist :ancestry a :local l) it)) (-let (((&plist :ancestry a :local l) it))
(list :ancestry a :local (cons :sp-subiter l))))))) (list :ancestry a :local (cons :sp-subiter l)))))))
;; (org-x-dag-node-fmap node
;; (either<$> it (cons :sp-subiter it)))))
(-let (((p (ps is)) (->> (list :canceled-parent-p nil (-let (((p (ps is)) (->> (list :canceled-parent-p nil
:held-parent-p nil) :held-parent-p nil)
(org-x-dag-bs-action-project node-tree)))) (org-x-dag-bs-action-project node-tree))))
@ -1084,16 +1087,17 @@ used for optimization."
(org-x-dag-bs-prefix :endpoint `(,n ,@ns)))) (org-x-dag-bs-prefix :endpoint `(,n ,@ns))))
(defun org-x-dag-bs-toplevel-goal-inner (type-name node-data child-bss) (defun org-x-dag-bs-toplevel-goal-inner (type-name node-data child-bss)
(-let (((&plist :planning :todo) node-data)) (org-x-dag-bs-check-created node-data
(cond (-let (((&plist :planning :todo) node-data))
(planning (cond
(either :left (format "%ss cannot have planning elements" type-name))) (planning
((either-lefts child-bss) (either :left (format "%ss cannot have planning elements" type-name)))
(either :left "Child error")) ((either-lefts child-bss)
((equal todo org-x-kw-todo) (either :left "Child error"))
(either :right '(:active))) ((equal todo org-x-kw-todo)
(t (either :right '(:active)))
(org-x-dag-bs-error-kw type-name todo))))) (t
(org-x-dag-bs-error-kw type-name todo))))))
(defun org-x-dag-bs-toplevel-goal-outer (type-name tree ancestry) (defun org-x-dag-bs-toplevel-goal-outer (type-name tree ancestry)
(org-x-dag-bs-with-children-1 (org-x-dag-bs-with-children-1