REF split parent classifier into separate function
This commit is contained in:
parent
849783c5c0
commit
48ff734880
|
@ -1391,54 +1391,57 @@ removed from, added to, or edited within the DAG respectively."
|
||||||
(dag-edit-nodes to-remove to-insert dag))))
|
(dag-edit-nodes to-remove to-insert dag))))
|
||||||
(plist-put org-x-dag :dag dag*)))
|
(plist-put org-x-dag :dag dag*)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun org-x-dag-id->parent-class (id parent)
|
||||||
|
(-let* (((cfile cgroup) (org-x-dag-id->file-group id))
|
||||||
|
((pfile pgroup) (org-x-dag-id->file-group parent)))
|
||||||
|
(cl-case cgroup
|
||||||
|
;; the only allowed links are local
|
||||||
|
((:lifetime :survival)
|
||||||
|
(unless (equal cfile pfile)
|
||||||
|
:ill-foreign))
|
||||||
|
;; should only link locally or a lifetime goal
|
||||||
|
(:endpoint
|
||||||
|
(unless (or (equal cfile pfile) (eq pgroup :lifetime))
|
||||||
|
:ill-foreign))
|
||||||
|
;; should only link to an endpoint or lifetime goal
|
||||||
|
(:quarterly
|
||||||
|
(cond
|
||||||
|
((memq pgroup '(:endpoint :lifetime)) nil)
|
||||||
|
((equal pfile cfile) :ill-local)
|
||||||
|
(t :ill-foreign)))
|
||||||
|
;; should only link to a quarterly plan
|
||||||
|
(:weekly
|
||||||
|
(cond
|
||||||
|
((eq pgroup :quarterly) nil)
|
||||||
|
((equal pfile cfile) :ill-local)
|
||||||
|
(t :ill-foreign)))
|
||||||
|
;; should only link to a weekly plan or an action
|
||||||
|
(:daily
|
||||||
|
(cond
|
||||||
|
((memq pgroup '(nil :weekly)) nil)
|
||||||
|
((equal pfile cfile) :ill-local)
|
||||||
|
(t :ill-foreign)))
|
||||||
|
;; actions can only be linked to goal files, and nothing else
|
||||||
|
(t
|
||||||
|
(cond
|
||||||
|
((memq pgroup '(:lifetime :endpoint :survival)) nil)
|
||||||
|
((equal pfile cfile) :ill-local)
|
||||||
|
(t :ill-foreign))))))
|
||||||
|
|
||||||
;; TODO this will also include broken links, which isn't totally wrong but these
|
;; TODO this will also include broken links, which isn't totally wrong but these
|
||||||
;; should be filtered out as including them is suboptimal (note: I figureed out
|
;; should be filtered out as including them is suboptimal (note: I figureed out
|
||||||
;; they were here because the broken links dag code is wrong)
|
;; they were here because the broken links dag code is wrong)
|
||||||
(defun org-x-dag-filter-links (relations)
|
(defun org-x-dag-filter-links (relations)
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((classify-edge
|
((flatten-relation
|
||||||
(edge)
|
(rel)
|
||||||
(-let* (((child parent) edge)
|
(-let (((c . ps) rel))
|
||||||
((cfile cgroup) (org-x-dag-id->file-group child))
|
(--map (list c it) ps))))
|
||||||
((pfile pgroup) (org-x-dag-id->file-group parent)))
|
(-let (((&alist :ill-foreign :ill-local)
|
||||||
(cl-case cgroup
|
(->> (-mapcat #'flatten-relation relations)
|
||||||
;; the only allowed links are local
|
(--group-by (apply #'org-x-dag-id->parent-class it)))))
|
||||||
((:lifetime :survival)
|
(list ill-foreign ill-local))))
|
||||||
(unless (equal cfile pfile)
|
|
||||||
:foreign))
|
|
||||||
;; should only link locally or a lifetime goal
|
|
||||||
(:endpoint
|
|
||||||
(unless (or (equal cfile pfile) (eq pgroup :lifetime))
|
|
||||||
:foreign))
|
|
||||||
;; should only link to an endpoint or lifetime goal
|
|
||||||
(:quarterly
|
|
||||||
(cond
|
|
||||||
((memq pgroup '(:endpoint :lifetime)) nil)
|
|
||||||
((equal pfile cfile) :local)
|
|
||||||
(t :foreign)))
|
|
||||||
;; should only link to a quarterly plan
|
|
||||||
(:weekly
|
|
||||||
(cond
|
|
||||||
((eq pgroup :quarterly) nil)
|
|
||||||
((equal pfile cfile) :local)
|
|
||||||
(t :foreign)))
|
|
||||||
;; should only link to a weekly plan or an action
|
|
||||||
(:daily
|
|
||||||
(cond
|
|
||||||
((memq pgroup '(nil :weekly)) nil)
|
|
||||||
((equal pfile cfile) :local)
|
|
||||||
(t :foreign)))
|
|
||||||
;; actions can only be linked to goal files, and nothing else
|
|
||||||
(t
|
|
||||||
(cond
|
|
||||||
((memq pgroup '(:lifetime :endpoint :survival)) nil)
|
|
||||||
((equal pfile cfile) :local)
|
|
||||||
(t :foreign)))))))
|
|
||||||
(-let (((&alist :foreign :local) (->> relations
|
|
||||||
(--mapcat (-let (((c . ps) it))
|
|
||||||
(--map (list c it) ps)))
|
|
||||||
(-group-by #'classify-edge))))
|
|
||||||
(list foreign local))))
|
|
||||||
|
|
||||||
;; TODO there is a HUGE DIFFERENCE between a 'key' (the things in the hash table
|
;; TODO there is a HUGE DIFFERENCE between a 'key' (the things in the hash table
|
||||||
;; the look things up) and a 'node' (which is a cons cell, the car of which is a
|
;; the look things up) and a 'node' (which is a cons cell, the car of which is a
|
||||||
|
|
Loading…
Reference in New Issue