REF make key functions more concise
This commit is contained in:
parent
06fa37e30b
commit
e80797b8de
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue