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

FIX silly plist error

This commit is contained in:
Nathan Dwarshuis 2022-04-28 20:30:33 -04:00
parent 1a4c7e0bc6
commit a9620934b8
1 changed files with 20 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -660,10 +660,10 @@ used for optimization."
(t (t
,open-form))))))) ,open-form)))))))
(defmacro org-x-dag-bs-action-with-closed (node-data ancestry child-bss type-name (defmacro org-x-dag-bs-action-with-closed (node-data ancestry type-name
canc-bs-form canc-bs-form
done-form open-form) done-form open-form)
(declare (indent 4)) (declare (indent 3))
(cl-flet* (cl-flet*
((wrap-ancestry ((wrap-ancestry
(form) (form)
@ -674,14 +674,7 @@ 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)))
;; TODO this seems excessive, I'm unwrapping some outer type for the
;; sake of some inner type, but if any of these are left then
;; they should short circuit the fold/check functions embedded in here
`(org-x-dag-bs-check-created ,node-data `(org-x-dag-bs-check-created ,node-data
;; (-let ((it-children (--map (either>>= it
;; (->> (plist-get it :local)
;; (either :right)))
;; ,child-bss)))
(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*
@ -698,7 +691,7 @@ used for optimization."
(or sched (equal todo org-x-kw-next))))) (or sched (equal todo org-x-kw-next)))))
;; rankings ;; rankings
;; *-active > proj-wait > proj-held > (proj-stuck == iter-empty) > *-complete ;; *-active > proj-wait > proj-held > (proj-stuck == iter-empty) > *-complete
(org-x-dag-bs-action-with-closed node-data ancestry child-bss "projects" (org-x-dag-bs-action-with-closed node-data ancestry "projects"
(if child-bss (if child-bss
`(:sp-proj :proj-complete ,it-comptime) `(:sp-proj :proj-complete ,it-comptime)
`(:sp-task :task-complete ,it-comptime)) `(:sp-task :task-complete ,it-comptime))
@ -729,7 +722,7 @@ used for optimization."
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(org-x-dag-bs-rankfold-children child-bss task-default (org-x-dag-bs-rankfold-children child-bss task-default
(lambda (acc next) (lambda (acc next)
(->> (pcase `(,(plist-get :local acc) ,(plist-get :local next)) (->> (pcase `(,(plist-get acc :local) ,(plist-get next :local))
(`((:sp-task :task-active ,a) (:sp-task :task-active ,b)) (`((:sp-task :task-active ,a) (:sp-task :task-active ,b))
(and (not (is-next a)) (is-next b))) (and (not (is-next a)) (is-next b)))
@ -776,14 +769,14 @@ used for optimization."
(either :right))) (either :right)))
(lambda (next) (lambda (next)
(pcase (plist-get :local next) (pcase (plist-get next :local)
(`(:sp-proj :proj-active) t) (`(:sp-proj :proj-active) t)
(`(:sp-iter :iter-active ,_) t) (`(:sp-iter :iter-active ,_) t)
(`(:sp-task :task-active ,d) (is-next d)) (`(:sp-task :task-active ,d) (is-next d))
(_ nil))) (_ nil)))
(lambda (acc) (lambda (acc)
(pcase (plist-get :local acc) (pcase (plist-get acc :local)
((or `(:sp-proj :proj-complete ,_) ((or `(:sp-proj :proj-complete ,_)
`(:sp-task :task-complete ,_) `(:sp-task :task-complete ,_)
`(:sp-iter :iter-complete ,_)) `(:sp-iter :iter-complete ,_))
@ -824,7 +817,7 @@ used for optimization."
(either :right `(,comp-key ,comptime)) (either :right `(,comp-key ,comptime))
`(,comp-key ,comptime) `(,comp-key ,comptime)
(lambda (child-bs) (lambda (child-bs)
(pcase (plist-get :local child-bs) (pcase (plist-get child-bs :local)
(`(:si-complete ,_) t) (`(:si-complete ,_) t)
(_ nil))))) (_ nil)))))
@ -833,7 +826,7 @@ used for optimization."
(declare (indent 1)) (declare (indent 1))
(org-x-dag-bs-rankfold-children child-bss default (org-x-dag-bs-rankfold-children child-bss default
(lambda (acc next) (lambda (acc next)
(pcase `(,(plist-get :local acc) ,(plist-get :local next)) (pcase `(,(plist-get acc :local) ,(plist-get next :local))
(`((:si-active ,a) (:si-active ,b)) (`((:si-active ,a) (:si-active ,b))
(-let (((&plist :sched as :dead ad) a) (-let (((&plist :sched as :dead ad) a)
((&plist :sched bs :dead bd) b)) ((&plist :sched bs :dead bd) b))
@ -861,22 +854,23 @@ used for optimization."
(`(,_ (:si-active ,_)) (either :right t)) (`(,_ (:si-active ,_)) (either :right t))
(`(,_ ,_) (either :right nil)))) (`(,_ ,_) (either :right nil))))
(lambda (next) (lambda (next)
(pcase (plist-get :local next) (pcase (plist-get next :local)
(`(:si-active ,_) t) (`(:si-active ,_) t)
(_ nil))) (_ nil)))
(lambda (acc) (lambda (acc)
(pcase (plist-get :local acc) (pcase (plist-get acc :local)
(`(:si-complete ,_) (`(:si-complete ,_)
(->> type-name (->> type-name
(org-x-dag-left "Active %s must have at least one active child"))) (org-x-dag-left "Active %s must have at least one active child")))
(`(:si-active ,ts-data) (`(:si-active ,ts-data)
(either :right `(,active-key ,ts-data))))))) (either :right `(,active-key ,ts-data)))
(e (error "Invalid pattern: %s" e))))))
(defun org-x-dag-node-is-iterator-p (node) (defun org-x-dag-node-is-iterator-p (node)
(org-x-dag-node-data-is-iterator-p (plist-get node :node-meta))) (org-x-dag-node-data-is-iterator-p (plist-get node :node-meta)))
(defun org-x-dag-bs-action-subiter-inner (node-data ancestry child-bss) (defun org-x-dag-bs-action-subiter-inner (node-data ancestry child-bss)
(org-x-dag-bs-action-with-closed node-data ancestry child-bss "sub-iterators" (org-x-dag-bs-action-with-closed node-data ancestry "sub-iterators"
`(:si-complete ,it-comptime) `(:si-complete ,it-comptime)
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime (org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime
"sub-iterators" :si-complete) "sub-iterators" :si-complete)
@ -897,7 +891,7 @@ used for optimization."
(org-x-dag-bs-error-kw "Sub-iterator" it-todo)))))) (org-x-dag-bs-error-kw "Sub-iterator" it-todo))))))
(defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss) (defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss)
(org-x-dag-bs-action-with-closed node-data ancestry child-bss "iterators" (org-x-dag-bs-action-with-closed node-data ancestry "iterators"
`(:iter-complete ,it-comptime) `(:iter-complete ,it-comptime)
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime (org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime
"iterators" :iter-complete) "iterators" :iter-complete)
@ -915,10 +909,10 @@ used for optimization."
(defun org-x-dag-bs-epg-inner (node ancestry child-bss) (defun org-x-dag-bs-epg-inner (node ancestry child-bss)
(let ((is-complete (let ((is-complete
(lambda (child-bs) (lambda (child-bs)
(pcase (plist-get :local child-bs) (pcase (plist-get child-bs :local)
(`(:complete ,_) t) (`(:complete ,_) t)
(_ nil))))) (_ nil)))))
(org-x-dag-bs-action-with-closed node ancestry child-bss "endpoint goal" (org-x-dag-bs-action-with-closed node ancestry "endpoint goal"
`(:complete ,it-comptime) `(:complete ,it-comptime)
(org-x-dag-bs-check-children child-bss (org-x-dag-bs-check-children child-bss
(either :left "Completed EPGs cannot have active children") (either :left "Completed EPGs cannot have active children")