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

ENH integrate new buffer status code with sync code

This commit is contained in:
Nathan Dwarshuis 2022-03-26 17:24:08 -04:00
parent 35a29ad1b4
commit a58a1dec70
1 changed files with 58 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -204,19 +204,22 @@
(org-x-get-incubator-files)))) (org-x-get-incubator-files))))
(defun org-x-dag-flatten-goal-file-state (state) ;; (defun org-x-dag-flatten-goal-file-state (state)
(-let (((&plist :lifetime l :endpoint e :survival s) state)) ;; (-let (((&plist :lifetime l :endpoint e :survival s) state))
`(,l ,e ,s))) ;; `(,l ,e ,s)))
(defun org-x-dag-flatten-planning-file-state (state) ;; (defun org-x-dag-flatten-planning-file-state (state)
(-let (((&plist :quarterly q :weekly w :daily d) state)) ;; (-let (((&plist :quarterly q :weekly w :daily d) state))
`(,q ,w ,d))) ;; `(,q ,w ,d)))
(defun org-x-dag-flatten-file-state (state) (defun org-x-dag-flatten-file-state (state)
(-let (((&plist :goal-files :plan-files :action-files) state)) (cl-flet
(append (org-x-dag-flatten-goal-file-state goal-files) ((flat-flip
(org-x-dag-flatten-planning-file-state plan-files) (plist)
action-files))) (->> (-partition-all 2 plist)
(--map (cons (cadr it) (car it))))))
(-let (((&plist :goal-files g :plan-files p :action-files a) state))
(append (flat-flip g) (flat-flip p) (--map (cons it :action) a)))))
(defun org-x-dag-empty () (defun org-x-dag-empty ()
(org-x-dag-create (dag-empty) (org-x-dag-create (dag-empty)
@ -1987,16 +1990,6 @@ used for optimization."
;;; DAG SYNCHRONIZATION/CONSTRUCTION ;;; DAG SYNCHRONIZATION/CONSTRUCTION
;; (defun org-x-dag-get-files ()
;; "Return a list of all files to be used in the DAG."
;; `(,(org-x-get-lifetime-goal-file)
;; ,(org-x-get-endpoint-goal-file)
;; ,(org-x-get-survival-goal-file)
;; ,(org-x-qtp-get-file)
;; ,(org-x-get-weekly-plan-file)
;; ,(org-x-get-daily-plan-file)
;; ,@(org-x-get-action-and-incubator-files)))
(defun org-x-dag-get-md5 (path) (defun org-x-dag-get-md5 (path)
"Get the md5 checksum of PATH." "Get the md5 checksum of PATH."
(org-x-with-file path (buffer-hash))) (org-x-with-file path (buffer-hash)))
@ -2007,49 +2000,47 @@ used for optimization."
The returned value will be a list like (TO-REMOVE TO-INSERT The returned value will be a list like (TO-REMOVE TO-INSERT
TO-UPDATE) which will contain the file paths the should be TO-UPDATE) which will contain the file paths the should be
removed from, added to, or edited within the DAG respectively." removed from, added to, or edited within the DAG respectively."
(cl-flet (cl-flet*
((lookup-md5 ((lookup-md5
(path) (path)
(alist-get path org-x-dag-sync-state nil nil #'equal))) (alist-get path org-x-dag-sync-state nil nil #'equal))
(-let* (;;(existing-files (org-x-dag-get-files)) (get-file-md5
(file-state (org-x-dag-read-file-paths)) (file-pair)
(existing-files (org-x-dag-flatten-file-state file-state)) (-let (((path . group) file-pair)
(state-files (-map #'car org-x-dag-sync-state)) (md5 ))
(to-remove (-difference state-files existing-files)) (list :path path
((&alist 'to-insert 'to-update 'no-change) :group group
(->> (--map (cons it (org-x-dag-get-md5 it)) existing-files) :md5 (org-x-dag-get-md5 path))))
(--group-by (-let* (((path . new-md5) it) (file-status
(file-data)
(-let* (((&plist :md5 new-md5 :path path) file-data)
(old-md5 (lookup-md5 path))) (old-md5 (lookup-md5 path)))
(cond (cond
((null old-md5) 'to-insert) ((not old-md5) 'to-insert)
((equal old-md5 new-md5) 'no-change) ((equal old-md5 new-md5) 'no-change)
(t 'to-update))))))) (t 'to-update)))))
(-let* ((file-state (org-x-dag-read-file-paths))
(existing-files (org-x-dag-flatten-file-state file-state))
(state-files (-map #'car org-x-dag-sync-state))
(to-remove (->> (-map #'car existing-files)
(-difference state-files)))
((&alist 'to-insert 'to-update 'no-change)
(->> (-map #'get-file-md5 existing-files)
(-group-by #'file-status))))
(list file-state to-remove to-insert to-update no-change)))) (list file-state to-remove to-insert to-update no-change))))
(defun org-x-dag-flatten-file-state (file-state) (defun org-x-dag-read-files (files)
(-let* (((&plist :goal-files g :plan-files p :action-files a) file-state))
(->> (append g p)
(-partition-all 2)
(--map (cons (nth 1 it) (nth 0 it)))
(append (--map (cons it :action) a)))))
(defun org-x-dag-read-files (files file-state)
(cl-flet (cl-flet
((append-results ((append-results
(acc file-pair) (acc filedata)
(-let* (((file . group) file-pair) (-let* (((&plist :path :group) filedata)
((acc-ids acc-meta acc-filemaps acc-links) acc) ((acc-ids acc-filemaps acc-links) acc)
((ids metas links) (org-x-dag-get-file-nodes file group)) (ids (org-x-dag-get-file-nodes path group))
(filemap (cons file (-map #'car ids)))) (filemap (cons path (--map (plist-get :id it) ids))))
`((,@ids ,@acc-ids) `((,@ids ,@acc-ids)
(,@metas ,@acc-meta) (,filemap ,@acc-filemaps)))))
(,filemap ,@acc-filemaps) ;; (,@links ,@acc-links)))))
(,@links ,@acc-links))))) (-reduce-from #'append-results nil files)))
;; TODO wtf is this error prone garbage? (the use of filter implies failure
;; in a list that should have a bijective mapping to the file list)
(->> (org-x-dag-flatten-file-state file-state)
(--filter (member (car it) files))
(-reduce-from #'append-results nil))))
;; TODO what about all the nodes that don't need to be updated? ;; TODO what about all the nodes that don't need to be updated?
(defun org-x-dag-update-ht (to-remove to-insert ht) (defun org-x-dag-update-ht (to-remove to-insert ht)
@ -2725,21 +2716,20 @@ plist holding the files to be used in the DAG."
(files2rem (append to-update to-remove)) (files2rem (append to-update to-remove))
(files2ins (append to-update to-insert)) (files2ins (append to-update to-insert))
(ids2rem (org-x-dag-files->ids files2rem)) (ids2rem (org-x-dag-files->ids files2rem))
((ids2ins meta2ins fms2ins links2ins) ((ids2ins fms2ins links2ins) (org-x-dag-read-files files2ins)))
(org-x-dag-read-files files2ins file-state))) ;; (org-x-dag-update-ht ids2rem meta2ins id->meta)
(org-x-dag-update-ht ids2rem meta2ins id->meta) ;; (org-x-dag-update-ht files2rem fms2ins file->ids)
(org-x-dag-update-ht files2rem fms2ins file->ids)
(org-x-dag-update-dag ids2ins ids2rem) (org-x-dag-update-dag ids2ins ids2rem)
(plist-put org-x-dag :files file-state) (plist-put org-x-dag :files file-state)))
;; update illegal links after updating the adjlist, since we need that to ;; update illegal links after updating the adjlist, since we need that to
;; figure out which links are illegal ;; figure out which links are illegal
(-let (((illegal-foreign illegal-local) (org-x-dag-filter-links links2ins))) ;; (-let (((illegal-foreign illegal-local) (org-x-dag-filter-links links2ins)))
(org-x-dag-update-ht files2rem illegal-foreign if) ;; (org-x-dag-update-ht files2rem illegal-foreign if)
(org-x-dag-update-ht files2rem illegal-local il)) ;; (org-x-dag-update-ht files2rem illegal-local il))
;; update node-level status after figuring out which are invalid via links ;; update node-level status after figuring out which are invalid via links
(let ((status2ins (->> (-map #'car ids2ins) ;; (let ((status2ins (->> (-map #'car ids2ins)
(--map (cons it (org-x-dag-id->0th-status it)))))) ;; (--map (cons it (org-x-dag-id->0th-status it))))))
(org-x-dag-update-ht ids2rem status2ins id->status)))) ;; (org-x-dag-update-ht ids2rem status2ins id->status))))
(defun org-x-dag-sync (&optional force) (defun org-x-dag-sync (&optional force)
@ -2752,11 +2742,10 @@ If FORCE is non-nil, sync no matter what."
;; TODO verify integrity somewhere in here ;; TODO verify integrity somewhere in here
(-let (((file-state to-remove to-insert to-update no-change) (-let (((file-state to-remove to-insert to-update no-change)
(org-x-dag-get-sync-state))) (org-x-dag-get-sync-state)))
(org-x-dag-update file-state (org-x-dag-update file-state to-remove to-insert to-update)
to-remove (->> (append to-update to-insert no-change)
(-map #'car to-insert) (--map (cons (plist-get it :path) (plist-get it :md5)))
(-map #'car to-update)) (setq org-x-dag-sync-state))
(setq org-x-dag-sync-state (append to-insert to-update no-change))
nil)) nil))
;; NODE FORMATTING ;; NODE FORMATTING