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

REF make key functions more concise

This commit is contained in:
Nathan Dwarshuis 2022-05-09 23:34:01 -04:00
parent 06fa37e30b
commit e80797b8de
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1406,7 +1406,7 @@ deadline (eg via epoch time) or if it has a repeater."
(defun org-x-dag-ns-epg (adjlist links ns) (defun org-x-dag-ns-epg (adjlist links ns)
(-let (((&alist :lifetime ht-l) ns)) (-let (((&alist :lifetime ht-l) ns))
(org-x-dag-ns-with-valid ns adjlist :endpoint links (org-x-dag-ns-with-valid ns adjlist :endpoint links
`((:lifetime (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id))) `((:lifetime ,(-partial #'org-x-dag-ns-is-leaf-p adjlist))
(:endpoint)) (:endpoint))
(lambda (id this-h res) (lambda (id this-h res)
(-let* (((&alist :lifetime l) res) (-let* (((&alist :lifetime l) res)
@ -1422,10 +1422,11 @@ deadline (eg via epoch time) or if it has a repeater."
(either-from* x nil (plist-get it key)))) (either-from* x nil (plist-get it key))))
(defun org-x-dag-ns-qtp (adjlist links ns) (defun org-x-dag-ns-qtp (adjlist links ns)
(-let (((&alist :lifetime ht-l :endpoint ht-e) ns)) (-let (((&alist :lifetime ht-l :endpoint ht-e) ns)
(is-leaf-p (-partial #'org-x-dag-ns-is-leaf-p adjlist)))
(org-x-dag-ns-with-valid ns adjlist :quarterly links (org-x-dag-ns-with-valid ns adjlist :quarterly links
`((:lifetime (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id))) `((:lifetime ,is-leaf-p)
(:endpoint (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id)))) (:endpoint ,is-leaf-p))
(lambda (id this-h res) (lambda (id this-h res)
(-let (((&alist :lifetime l :endpoint e) res)) (-let (((&alist :lifetime l :endpoint e) res))
(ht-set this-h id (either :right `(:committed (,@e ,@l)))) (ht-set this-h id (either :right `(:committed (,@e ,@l))))
@ -1437,7 +1438,7 @@ deadline (eg via epoch time) or if it has a repeater."
(defun org-x-dag-ns-wkp (adjlist links ns) (defun org-x-dag-ns-wkp (adjlist links ns)
(-let (((&alist :quarterly ht-q) ns)) (-let (((&alist :quarterly ht-q) ns))
(org-x-dag-ns-with-valid ns adjlist :weekly links (org-x-dag-ns-with-valid ns adjlist :weekly links
`((:quarterly (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id)))) `((:quarterly ,(-partial #'org-x-dag-ns-is-leaf-p adjlist)))
(lambda (id this-h res) (lambda (id this-h res)
(-let (((&alist :quarterly q) res)) (-let (((&alist :quarterly q) res))
(ht-set this-h id (either :right `(:committed ,q))) (ht-set this-h id (either :right `(:committed ,q)))
@ -1453,6 +1454,7 @@ deadline (eg via epoch time) or if it has a repeater."
:survival ht-s :survival ht-s
:quarterly ht-q) :quarterly ht-q)
ns) ns)
(is-leaf-p (-partial #'org-x-dag-ns-is-leaf-p adjlist))
(q-committed (q-committed
(->> (ht->alist ht-q) (->> (ht->alist ht-q)
(--map (cons (car it) (--map (cons (car it)
@ -1479,9 +1481,9 @@ deadline (eg via epoch time) or if it has a repeater."
(-map #'car) (-map #'car)
(org-x-dag-ht-add-links id ht-q :scheduled-actions))))))) (org-x-dag-ht-add-links id ht-q :scheduled-actions)))))))
(org-x-dag-ns-with-valid ns adjlist :action links (org-x-dag-ns-with-valid ns adjlist :action links
`((:survival (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id))) `((:survival ,is-leaf-p)
(:endpoint ,is-committed-leaf-p) (:endpoint ,is-committed-leaf-p)
(:lifetime (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id)))) (:lifetime ,is-leaf-p))
(lambda (id this-h res) (lambda (id this-h res)
(-let (((&alist :survival s :endpoint e :lifetime l) res)) (-let (((&alist :survival s :endpoint e :lifetime l) res))
(->> (cond (->> (cond