ENH check for created timestamps in goals and actions
This commit is contained in:
parent
a4b78d226e
commit
ed3581ccb6
|
@ -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
|
||||||
|
(-let ((it-children (--map (either>>= it
|
||||||
(->> (plist-get it :local)
|
(->> (plist-get it :local)
|
||||||
(either :right)))
|
(either :right)))
|
||||||
,child-bss)))
|
,child-bss)))
|
||||||
;; (print "----")
|
|
||||||
;; (print child-bss)
|
|
||||||
;; (print it-children)
|
|
||||||
(org-x-dag-bs-with-closed ,node-data ,type-name
|
(org-x-dag-bs-with-closed ,node-data ,type-name
|
||||||
,canc-bs-form*
|
,canc-bs-form*
|
||||||
,done-form*
|
,done-form*
|
||||||
,open-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,6 +1087,7 @@ 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)
|
||||||
|
(org-x-dag-bs-check-created node-data
|
||||||
(-let (((&plist :planning :todo) node-data))
|
(-let (((&plist :planning :todo) node-data))
|
||||||
(cond
|
(cond
|
||||||
(planning
|
(planning
|
||||||
|
@ -1093,7 +1097,7 @@ used for optimization."
|
||||||
((equal todo org-x-kw-todo)
|
((equal todo org-x-kw-todo)
|
||||||
(either :right '(:active)))
|
(either :right '(:active)))
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw type-name todo)))))
|
(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
|
||||||
|
|
Loading…
Reference in New Issue