ENH store buffer parent in distinct key
FIX keep the headline metadata in dag
This commit is contained in:
parent
5fd7801ed8
commit
290c81308e
|
@ -1289,17 +1289,6 @@ used for optimization."
|
||||||
(when (and (< (point) prop-beg) (looking-at org-planning-line-re))
|
(when (and (< (point) prop-beg) (looking-at org-planning-line-re))
|
||||||
(org-element-planning-parser prop-beg))))
|
(org-element-planning-parser prop-beg))))
|
||||||
|
|
||||||
(defun org-x-dag-node (id parents node-meta)
|
|
||||||
(list :id id
|
|
||||||
:parents parents
|
|
||||||
:node-meta node-meta))
|
|
||||||
|
|
||||||
(defmacro org-x-dag-node-fmap (node form)
|
|
||||||
(declare (indent 1))
|
|
||||||
;; TODO not efficient (may or may not matter)
|
|
||||||
`(-let (((&plist :id i :parents ps :node-meta it) ,node))
|
|
||||||
(org-x-dag-node i ps ,form)))
|
|
||||||
|
|
||||||
(defun org-x-dag-get-buffer-nodes (file-meta kws target-props)
|
(defun org-x-dag-get-buffer-nodes (file-meta kws target-props)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(let* ((line-re (org-x-dag-line-regexp kws))
|
(let* ((line-re (org-x-dag-line-regexp kws))
|
||||||
|
@ -1748,49 +1737,64 @@ used for optimization."
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw "Endpoint goal" it-todo)))))
|
(org-x-dag-bs-error-kw "Endpoint goal" it-todo)))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-with-treetop-error (tree parent-node)
|
(defun org-x-dag-bs-with-treetop-error (tree parent-id)
|
||||||
(declare (indent 3))
|
(declare (indent 3))
|
||||||
(-let* (((node . children) tree)
|
(-let* (((node . children) tree)
|
||||||
((&plist :id i :parents ps) node)
|
((&plist :id i :parents links :node-meta m) node)
|
||||||
((&plist :id pi) parent-node)
|
(ps (cons parent-id links))
|
||||||
(this (->> (org-x-dag-bs :error "Children not allowed")
|
(this (->> (org-x-dag-bs :error "Children not allowed")
|
||||||
(org-x-dag-node i (cons i ps)))))
|
(org-x-dag-node i ps parent-id m))))
|
||||||
(cons this (--mapcat (org-x-dag-bs-with-treetop-error it node) children))))
|
(cons this (--mapcat (org-x-dag-bs-with-treetop-error it i) children))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-with-treetop (tree node-fun)
|
(defun org-x-dag-bs-with-treetop (tree node-fun)
|
||||||
(declare (indent 3))
|
(declare (indent 3))
|
||||||
(-let* (((top . children) tree)
|
(-let* ((((&plist :id i :parents links :node-meta m) . children) tree)
|
||||||
(top* (org-x-dag-node-fmap top
|
(bs (if children (org-x-dag-bs :error "Children not allowed")
|
||||||
(if children (org-x-dag-bs :error "Children not allowed")
|
(funcall node-fun m)))
|
||||||
(funcall node-fun it)))))
|
(top (org-x-dag-node i links nil m bs)))
|
||||||
(cons top* (--mapcat (org-x-dag-bs-with-treetop-error it top) children))))
|
(cons top (--mapcat (org-x-dag-bs-with-treetop-error it i) children))))
|
||||||
|
|
||||||
;; TODO add a slot for the buffer parent (so that we know which are toplevel and not)
|
(defun org-x-dag-node (id parents buffer-parent node-meta bs)
|
||||||
(defun org-x-dag-bs-with-children (tree child-fun node-fun concat-fun)
|
(list :id id
|
||||||
|
:parents parents
|
||||||
|
:node-meta (list :hl-meta node-meta
|
||||||
|
:buffer-parent buffer-parent
|
||||||
|
:buffer-status bs)))
|
||||||
|
|
||||||
|
(defmacro org-x-dag-node-fmap (node form)
|
||||||
|
(declare (indent 1))
|
||||||
|
;; TODO not efficient (may or may not matter)
|
||||||
|
`(-let (((&plist :id i
|
||||||
|
:parents ps
|
||||||
|
:node-meta (&plist :hl-meta h
|
||||||
|
:buffer-parent p
|
||||||
|
:buffer-status it))
|
||||||
|
,node))
|
||||||
|
(org-x-dag-node i ps p h ,form)))
|
||||||
|
|
||||||
|
(defun org-x-dag-bs-with-children (tree parent child-fun node-fun concat-fun)
|
||||||
(declare (indent 3))
|
(declare (indent 3))
|
||||||
;; TODO this is super inefficient, make a plist mapper function
|
;; TODO this is super inefficient, make a plist mapper function
|
||||||
(-let* (((node . children) tree)
|
(-let* (((node . children) tree)
|
||||||
((&plist :id i :parents ps :node-meta m) node)
|
((&plist :id i :parents links :node-meta m) node)
|
||||||
((shallow rest) (->> (-map child-fun children)
|
((shallow rest) (->> (--map (funcall child-fun it i) children)
|
||||||
(apply #'-zip-lists)))
|
(apply #'-zip-lists)))
|
||||||
(shallow*
|
(ps (if parent (cons parent links) links)))
|
||||||
(--map (-let (((&plist :id ci :parents cps :node-meta cm) it))
|
(list (->> shallow
|
||||||
(list :id ci :parents (cons i cps) :node-meta cm))
|
(--map (plist-get (plist-get it :node-meta) :buffer-status))
|
||||||
shallow)))
|
|
||||||
(list (->> (--map (plist-get it :node-meta) shallow)
|
|
||||||
(funcall node-fun m)
|
(funcall node-fun m)
|
||||||
(org-x-dag-node i ps))
|
(org-x-dag-node i ps parent m))
|
||||||
(funcall concat-fun shallow* rest))))
|
(funcall concat-fun shallow rest))))
|
||||||
|
|
||||||
;; Tree a -> (Tree a -> (b, [d])) -> (a -> [b] -> c) -> (c, [d])
|
;; Tree a -> (Tree a -> (b, [d])) -> (a -> [b] -> c) -> (c, [d])
|
||||||
(defun org-x-dag-bs-with-children-1 (tree child-fun node-fun)
|
(defun org-x-dag-bs-with-children-1 (tree parent child-fun node-fun)
|
||||||
(org-x-dag-bs-with-children tree child-fun node-fun
|
(org-x-dag-bs-with-children tree parent child-fun node-fun
|
||||||
(lambda (shallow deep)
|
(lambda (shallow deep)
|
||||||
(append shallow (-flatten-n 1 deep)))))
|
(append shallow (-flatten-n 1 deep)))))
|
||||||
|
|
||||||
;; Tree a -> (Tree a -> (b, ([d], [e]))) -> (a -> [b] -> c) -> (c, ([d], [e]))
|
;; Tree a -> (Tree a -> (b, ([d], [e]))) -> (a -> [b] -> c) -> (c, ([d], [e]))
|
||||||
(defun org-x-dag-bs-with-children-2 (tree child-fun node-fun)
|
(defun org-x-dag-bs-with-children-2 (tree parent child-fun node-fun)
|
||||||
(org-x-dag-bs-with-children tree child-fun node-fun
|
(org-x-dag-bs-with-children tree parent child-fun node-fun
|
||||||
(lambda (shallow deep)
|
(lambda (shallow deep)
|
||||||
(--reduce-from (-let (((a b) acc)
|
(--reduce-from (-let (((a b) acc)
|
||||||
((as bs) it))
|
((as bs) it))
|
||||||
|
@ -1798,39 +1802,43 @@ used for optimization."
|
||||||
`(,shallow nil)
|
`(,shallow nil)
|
||||||
deep))))
|
deep))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-subiter (tree)
|
(defun org-x-dag-bs-action-subiter (tree parent)
|
||||||
(org-x-dag-bs-with-children-1
|
(org-x-dag-bs-with-children-1
|
||||||
tree
|
tree
|
||||||
|
parent
|
||||||
#'org-x-dag-bs-action-subiter
|
#'org-x-dag-bs-action-subiter
|
||||||
#'org-x-dag-bs-action-subiter-inner))
|
#'org-x-dag-bs-action-subiter-inner))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-iter (tree)
|
(defun org-x-dag-bs-action-iter (tree parent)
|
||||||
(org-x-dag-bs-with-children-1
|
(org-x-dag-bs-with-children-1
|
||||||
tree
|
tree
|
||||||
|
parent
|
||||||
#'org-x-dag-bs-action-subiter
|
#'org-x-dag-bs-action-subiter
|
||||||
(lambda (node child-bss)
|
(lambda (node child-bss)
|
||||||
(org-x-dag-node-fmap node
|
(org-x-dag-node-fmap node
|
||||||
(org-x-dag-bs-fmap (org-x-dag-bs-action-iter-inner it child-bss)
|
(org-x-dag-bs-fmap (org-x-dag-bs-action-iter-inner it child-bss)
|
||||||
`(:sp-proj it))))))
|
`(:sp-proj it))))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-project (tree)
|
(defun org-x-dag-bs-action-project (tree parent)
|
||||||
(if (org-x-dag-node-is-iterator-p (car tree))
|
(if (org-x-dag-node-is-iterator-p (car tree))
|
||||||
(-let (((iter subiters) (org-x-dag-bs-action-iter tree)))
|
(-let (((iter subiters) (org-x-dag-bs-action-iter tree nil)))
|
||||||
`(,iter (nil ,subiters)))
|
`(,iter (nil ,subiters)))
|
||||||
(org-x-dag-bs-with-children-2
|
(org-x-dag-bs-with-children-2
|
||||||
tree
|
tree
|
||||||
|
parent
|
||||||
#'org-x-dag-bs-action-project
|
#'org-x-dag-bs-action-project
|
||||||
#'org-x-dag-bs-action-project-inner)))
|
#'org-x-dag-bs-action-project-inner)))
|
||||||
|
|
||||||
;; TODO need to check for created timestamps
|
;; TODO need to check for created timestamps
|
||||||
(defun org-x-dag-bs-action (node-tree)
|
(defun org-x-dag-bs-action (node-tree)
|
||||||
;; TODO these types might not line up properly
|
;; TODO these types might not line up properly
|
||||||
(-let (((p (ps is)) (org-x-dag-bs-action-project node-tree)))
|
(-let (((p (ps is)) (org-x-dag-bs-action-project node-tree nil)))
|
||||||
`(,p ,@ps ,@is)))
|
`(,p ,@ps ,@is)))
|
||||||
|
|
||||||
(defun org-x-dag-bs-epg-outer (tree)
|
(defun org-x-dag-bs-epg-outer (tree parent)
|
||||||
(org-x-dag-bs-with-children-1
|
(org-x-dag-bs-with-children-1
|
||||||
tree
|
tree
|
||||||
|
parent
|
||||||
#'org-x-dag-bs-epg-outer
|
#'org-x-dag-bs-epg-outer
|
||||||
#'org-x-dag-bs-epg-inner))
|
#'org-x-dag-bs-epg-inner))
|
||||||
|
|
||||||
|
@ -1838,7 +1846,7 @@ used for optimization."
|
||||||
(--map (org-x-dag-node-fmap it (org-x-dag-bs-fmap it `(,key ,it))) nodes))
|
(--map (org-x-dag-node-fmap it (org-x-dag-bs-fmap it `(,key ,it))) nodes))
|
||||||
|
|
||||||
(defun org-x-dag-bs-epg (tree)
|
(defun org-x-dag-bs-epg (tree)
|
||||||
(-let (((n ns) (org-x-dag-bs-epg-outer tree)))
|
(-let (((n ns) (org-x-dag-bs-epg-outer tree nil)))
|
||||||
(org-x-dag-bs-prefix :endpoint `(,n ,@ns))))
|
(org-x-dag-bs-prefix :endpoint `(,n ,@ns))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-toplevel-goal-inner (type-name node-data child-bss)
|
(defun org-x-dag-bs-toplevel-goal-inner (type-name node-data child-bss)
|
||||||
|
@ -1854,16 +1862,17 @@ used for optimization."
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw type-name todo)))))
|
(org-x-dag-bs-error-kw type-name todo)))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-toplevel-goal-outer (type-name tree)
|
(defun org-x-dag-bs-toplevel-goal-outer (type-name tree parent)
|
||||||
(org-x-dag-bs-with-children-1
|
(org-x-dag-bs-with-children-1
|
||||||
tree
|
tree
|
||||||
(lambda (tree)
|
parent
|
||||||
(org-x-dag-bs-toplevel-goal-outer type-name tree))
|
(lambda (tree parent)
|
||||||
|
(org-x-dag-bs-toplevel-goal-outer type-name tree parent))
|
||||||
(lambda (node-data child-bss)
|
(lambda (node-data child-bss)
|
||||||
(org-x-dag-bs-toplevel-goal-inner type-name node-data child-bss))))
|
(org-x-dag-bs-toplevel-goal-inner type-name node-data child-bss))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-toplevel-goal (type-name type-key tree)
|
(defun org-x-dag-bs-toplevel-goal (type-name type-key tree)
|
||||||
(-let (((n ns) (org-x-dag-bs-toplevel-goal-outer type-name tree)))
|
(-let (((n ns) (org-x-dag-bs-toplevel-goal-outer type-name tree nil)))
|
||||||
(org-x-dag-bs-prefix type-key `(,n ,@ns))))
|
(org-x-dag-bs-prefix type-key `(,n ,@ns))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-ltg (tree)
|
(defun org-x-dag-bs-ltg (tree)
|
||||||
|
|
Loading…
Reference in New Issue