REF clean up this plist-get :local stuff

This commit is contained in:
Nathan Dwarshuis 2022-04-28 23:20:56 -04:00
parent a9620934b8
commit f21b2d4f0c
1 changed files with 37 additions and 23 deletions

View File

@ -595,6 +595,12 @@ used for optimization."
(if (not bss) (either :right nochild)
(fold-while bss))))
(defun org-x-dag-bs-action-check-children (bss fail success nochild stop-fun)
(declare (indent 4))
(org-x-dag-bs-check-children bss fail success nochild
(lambda (child-bs)
(funcall stop-fun (plist-get child-bs :local)))))
;; [Status a] -> b -> (a -> a -> Status Bool) -> (a -> Bool) -> (a -> Status b)
;; -> Status b
(defun org-x-dag-bs-rankfold-children (bss default rank-fun stop-fun trans-fun)
@ -619,6 +625,15 @@ used for optimization."
(funcall trans-fun it))))
(_ err))))))
(defun org-x-dag-bs-action-rankfold-children (bss default rank-fun stop-fun
trans-fun)
(cl-flet ((get-local (x) (plist-get x :local)))
(declare (indent 2))
(org-x-dag-bs-rankfold-children bss default
(-on rank-fun #'get-local)
(-compose stop-fun #'get-local)
(-compose trans-fun #'get-local))))
(defmacro org-x-dag-left (fmt &rest args)
`(either :left (format ,fmt ,@args)))
@ -696,17 +711,16 @@ used for optimization."
`(:sp-proj :proj-complete ,it-comptime)
`(:sp-task :task-complete ,it-comptime))
(org-x-dag-bs-check-children child-bss
(org-x-dag-bs-action-check-children child-bss
(either :left "Completed projects cannot have active children")
(either :right `(:sp-proj :proj-complete ,it-comptime))
`(:sp-task :task-complete ,it-comptime)
(lambda (child-bs)
(-let (((&plist :local) child-bs))
(lambda (local)
(pcase local
(`(:sp-proj :proj-complete ,_) t)
(`(:sp-iter :iter-complete ,_) t)
(`(:sp-task :task-complete ,_) t)
(_ nil)))))
(_ nil))))
(-let* (((sched dead) (-some->> it-planning
(org-ml-get-properties '(:scheduled :deadline))))
@ -720,9 +734,9 @@ used for optimization."
((and child-bss sched)
(either :left "Projects cannot be scheduled"))
((equal it-todo org-x-kw-todo)
(org-x-dag-bs-rankfold-children child-bss task-default
(org-x-dag-bs-action-rankfold-children child-bss task-default
(lambda (acc next)
(->> (pcase `(,(plist-get acc :local) ,(plist-get next :local))
(->> (pcase `(,acc ,next)
(`((:sp-task :task-active ,a) (:sp-task :task-active ,b))
(and (not (is-next a)) (is-next b)))
@ -769,14 +783,14 @@ used for optimization."
(either :right)))
(lambda (next)
(pcase (plist-get next :local)
(pcase next
(`(:sp-proj :proj-active) t)
(`(:sp-iter :iter-active ,_) t)
(`(:sp-task :task-active ,d) (is-next d))
(_ nil)))
(lambda (acc)
(pcase (plist-get acc :local)
(pcase acc
((or `(:sp-proj :proj-complete ,_)
`(:sp-task :task-complete ,_)
`(:sp-iter :iter-complete ,_))
@ -812,21 +826,21 @@ used for optimization."
(defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name
comp-key)
(declare (indent 2))
(org-x-dag-bs-check-children child-bss
(org-x-dag-bs-action-check-children child-bss
(org-x-dag-left "Completed %s cannot have active children" type-name)
(either :right `(,comp-key ,comptime))
`(,comp-key ,comptime)
(lambda (child-bs)
(pcase (plist-get child-bs :local)
(lambda (local)
(pcase local
(`(:si-complete ,_) t)
(_ nil)))))
(defun org-x-dag-bs-action-subiter-todo-fold (child-bss type-name active-key
default)
(declare (indent 1))
(org-x-dag-bs-rankfold-children child-bss default
(org-x-dag-bs-action-rankfold-children child-bss default
(lambda (acc next)
(pcase `(,(plist-get acc :local) ,(plist-get next :local))
(pcase `(,acc ,next)
(`((:si-active ,a) (:si-active ,b))
(-let (((&plist :sched as :dead ad) a)
((&plist :sched bs :dead bd) b))
@ -854,11 +868,11 @@ used for optimization."
(`(,_ (:si-active ,_)) (either :right t))
(`(,_ ,_) (either :right nil))))
(lambda (next)
(pcase (plist-get next :local)
(pcase next
(`(:si-active ,_) t)
(_ nil)))
(lambda (acc)
(pcase (plist-get acc :local)
(pcase acc
(`(:si-complete ,_)
(->> type-name
(org-x-dag-left "Active %s must have at least one active child")))
@ -908,13 +922,13 @@ used for optimization."
(defun org-x-dag-bs-epg-inner (node ancestry child-bss)
(let ((is-complete
(lambda (child-bs)
(pcase (plist-get child-bs :local)
(lambda (local)
(pcase local
(`(:complete ,_) t)
(_ nil)))))
(org-x-dag-bs-action-with-closed node ancestry "endpoint goal"
`(:complete ,it-comptime)
(org-x-dag-bs-check-children child-bss
(org-x-dag-bs-action-check-children child-bss
(either :left "Completed EPGs cannot have active children")
(either :right `(:complete ,it-comptime))
`(:complete ,it-comptime)
@ -923,7 +937,7 @@ used for optimization."
((-some->> it-planning (org-ml-get-property :scheduled))
(either :left "EPGs cannot be scheduled"))
((equal it-todo org-x-kw-todo)
(org-x-dag-bs-check-children child-bss
(org-x-dag-bs-action-check-children child-bss
(either :right '(:active))
(either :left "Active EPGs must have at least one active child")
'(:active)