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

added generic iterator to manage sql data extraction

This commit is contained in:
ndwarshuis 2018-12-28 22:16:34 -05:00
parent 59d2eb7a78
commit 583f554b70
1 changed files with 95 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

221
conf.org
View File

@ -3206,7 +3206,7 @@ These are the main functions to populate the db.
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-planning-changes-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-planning-changes-schema)
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-links-schema))) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-links-schema)))
(defun nd/org-sql-extract-lb-header (item-part &optional acc) (defun nd/org-sql-extract-lb-header (item-part acc)
"Add specific data from logbook entry ITEM-PART to accumulator ACC. "Add specific data from logbook entry ITEM-PART to accumulator ACC.
ITEM-PART is a partitions logbook item as described in ITEM-PART is a partitions logbook item as described in
`nd/org-sql-partition-item'. Note headings are parsed according to `nd/org-sql-partition-item'. Note headings are parsed according to
@ -3250,7 +3250,6 @@ nothing is added if a match is not found."
;; header type not determined, therefore do nothing ;; header type not determined, therefore do nothing
(t acc)))) (t acc))))
;; TODO this gets called for clock notes?
(defun nd/org-element-note-get-time-logged (item-part) (defun nd/org-element-note-get-time-logged (item-part)
"Return time-logged of ITEM-PART or nil if it cannot be determined. "Return time-logged of ITEM-PART or nil if it cannot be determined.
ITEM-PART is a partitioned logbook item as described in ITEM-PART is a partitioned logbook item as described in
@ -3266,7 +3265,7 @@ ITEM-PART is a partitioned logbook item as described in
(set-match-data (alist-get :match-data item-part)) (set-match-data (alist-get :match-data item-part))
(nd/org-ts-format-to-iso (match-string time-index header-text))))) (nd/org-ts-format-to-iso (match-string time-index header-text)))))
(defun nd/org-sql-extract-lb-entry (item-part &optional acc) (defun nd/org-sql-extract-lb-entry (item-part acc)
"Add data from logbook entry ITEM-PART to accumulator ACC. "Add data from logbook entry ITEM-PART to accumulator ACC.
ITEM-PART is a partitioned logbook item as described in ITEM-PART is a partitioned logbook item as described in
`nd/org-sql-partition-item'." `nd/org-sql-partition-item'."
@ -3288,31 +3287,23 @@ ITEM-PART is a partitioned logbook item as described in
(acc* (nd/alist-put acc 'logbook logbook-data))) (acc* (nd/alist-put acc 'logbook logbook-data)))
(nd/org-sql-extract-lb-header item-part acc*))) (nd/org-sql-extract-lb-header item-part acc*)))
(defun nd/org-sql-add-note-to-clock (clock-data item-part &optional acc)
"Add ITEM-PART to CLOCK-DATA and add to accumulator ACC.
ITEM-PART is a partitions logbook item as described in
`nd/org-sql-partition-item'."
(let* ((header-text (alist-get :header-text item-part))
(clock-data* `(,@clock-data :clock_note ,header-text)))
(nd/alist-put acc 'clocking clock-data*)))
(defun nd/org-logbook-parse-timestamp-range (ts) (defun nd/org-logbook-parse-timestamp-range (ts)
"Return start and end of timestamp TS depending on if it is a range. "Return start and end of timestamp TS depending on if it is a range.
Return value will be a list of two elements if range and one if not." Return value will be a list of two elements if range and one if not."
(when ts (when ts
(let ((convert (let ((split
(lambda (ts &optional end) (lambda (ts &optional end)
(nd/org-ts-format-to-iso (nd/org-ts-format-to-iso
(org-element-property (org-element-property
:raw-value :raw-value
(org-timestamp-split-range ts end)))))) (org-timestamp-split-range ts end))))))
(if (eq (org-element-property :type ts) 'inactive-range) (if (eq (org-element-property :type ts) 'inactive-range)
(let ((start (funcall convert ts)) (let ((start (funcall split ts))
(end (funcall convert ts t))) (end (funcall split ts t)))
(cons start end)) (cons start end))
`(,(funcall convert ts)))))) `(,(funcall split ts))))))
(defun nd/org-sql-extract-lb-clock (clock hl-part &optional acc item) (defun nd/org-sql-extract-lb-clock (clock acc hl-part &optional item)
"Add data from logbook CLOCK to accumulator ACC. "Add data from logbook CLOCK to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline' HL-PART is an object as returned by `nd/org-sql-partition-headline'
and represents the headline surrounding the clock. and represents the headline surrounding the clock.
@ -3336,38 +3327,40 @@ added to the clock, else add it as a normal logbook entry."
(let* ((item-part (nd/org-sql-partition-item item hl-part)) (let* ((item-part (nd/org-sql-partition-item item hl-part))
(item-type (alist-get :type item-part))) (item-type (alist-get :type item-part)))
(if item-type (if item-type
;; if we know the type, add the clock and note
;; separately
(let ((acc* (nd/alist-put acc 'clocking clock-data))) (let ((acc* (nd/alist-put acc 'clocking clock-data)))
(nd/org-sql-extract-lb-entry item-part acc*)) (nd/org-sql-extract-lb-entry item-part acc*))
(nd/org-sql-add-note-to-clock clock-data item-part acc)))))) ;; else add it with the clocking table
(let* ((hdr-text (alist-get :header-text item-part))
(clock-data* `(,@clock-data :clock_note ,hdr-text)))
(nd/alist-put acc 'clocking clock-data*)))))))
(defun nd/org-sql-extract-lb-items (items hl-part &optional acc) (defun nd/org-sql-extract-lb-items (items acc hl-part)
"Add data from logbook ITEMS to accumulator ACC. "Add data from logbook ITEMS to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline' HL-PART is an object as returned by `nd/org-sql-partition-headline'
and represents the headline surrounding the items." and represents the headline surrounding the items."
(if (not items) (let ((into
acc (lambda (item acc hl-part)
(let* ((cur (car items)) (let ((item-part (nd/org-sql-partition-item item hl-part)))
(rem (cdr items)) (nd/org-sql-extract-lb-entry item-part acc)))))
(item-part (nd/org-sql-partition-item cur hl-part)) (nd/org-sql-extract items into acc hl-part)))
(acc* (nd/org-sql-extract-lb-entry item-part acc)))
(nd/org-sql-extract-lb-items rem hl-part acc*))))
(defun nd/org-sql-extract-lb-one (entry hl-part &optional acc) (defun nd/org-sql-extract-lb-one (entry acc hl-part)
"Add data from logbook ENTRY to accumulator ACC. "Add data from logbook ENTRY to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline' HL-PART is an object as returned by `nd/org-sql-partition-headline'
and represents the headline surrounding the entry." and represents the headline surrounding the entry."
(let ((type (org-element-type entry))) (let ((type (org-element-type entry)))
(cond (cond
((eq type 'clock) ((eq type 'clock)
(nd/org-sql-extract-lb-clock entry hl-part acc)) (nd/org-sql-extract-lb-clock entry acc hl-part))
((eq type 'plain-list) ((eq type 'plain-list)
(let ((items (org-element-contents entry))) (let ((items (org-element-contents entry)))
(nd/org-sql-extract-lb-items items hl-part acc))) (nd/org-sql-extract-lb-items items acc hl-part)))
;; TODO add an "UNKNOWN" logbook parser ;; TODO add an "UNKNOWN" logbook parser
(t acc)))) (t acc))))
;; TODO this triggers a sql syntax error when the note is not a clock note (defun nd/org-sql-extract-lb-two (entry1 entry2 acc hl-part)
(defun nd/org-sql-extract-lb-two (entry1 entry2 hl-part &optional acc)
"Add data from logbook ENTRY1 and ENTRY2 to accumulator ACC. "Add data from logbook ENTRY1 and ENTRY2 to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline' HL-PART is an object as returned by `nd/org-sql-partition-headline'
and represents the headline surrounding the entries. This assumes the and represents the headline surrounding the entries. This assumes the
@ -3376,8 +3369,8 @@ will check if the first item in ENTRY2 is part of the clock."
(let* ((items (org-element-contents entry2)) (let* ((items (org-element-contents entry2))
(first-item (car items)) (first-item (car items))
(rem-items (cdr items)) (rem-items (cdr items))
(acc* (nd/org-sql-extract-lb-clock entry1 hl-part acc first-item))) (acc* (nd/org-sql-extract-lb-clock entry1 acc hl-part first-item)))
(nd/org-sql-extract-lb-items rem-items hl-part acc*))) (nd/org-sql-extract-lb-items rem-items acc* hl-part)))
(defun nd/org-sql-find-logbook (contents) (defun nd/org-sql-find-logbook (contents)
"Find the logbook drawer given CONTENTS from section of org headline. "Find the logbook drawer given CONTENTS from section of org headline.
@ -3391,7 +3384,7 @@ ignored."
(equal org-log-into-drawer (plist-get (car e) :drawer-name))) (equal org-log-into-drawer (plist-get (car e) :drawer-name)))
contents))) contents)))
(defun nd/org-sql-extract-lb (hl-part &optional acc) (defun nd/org-sql-extract-lb (hl-part acc)
"Add logbook data from HL-PART and add to accumulator ACC. "Add logbook data from HL-PART and add to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'." HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(let* ((sec (alist-get :section hl-part)) (let* ((sec (alist-get :section hl-part))
@ -3414,47 +3407,40 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(eq type2 'plain-list))) (eq type2 'plain-list)))
(acc* (acc*
(if try-clock-note (if try-clock-note
(nd/org-sql-extract-lb-two cur1 cur2 hl-part acc) (nd/org-sql-extract-lb-two cur1 cur2 acc hl-part)
(nd/org-sql-extract-lb-one cur1 hl-part acc))) (nd/org-sql-extract-lb-one cur1 acc hl-part)))
(rem (if try-clock-note (cddr contents) (cdr contents)))) (rem (if try-clock-note (cddr contents) (cdr contents))))
(funcall scan rem acc*)))))) (funcall scan rem acc*))))))
(funcall scan lb-contents acc))) (funcall scan lb-contents acc)))
(defun nd/org-sql-extract-properties (hl-part &optional acc) (defun nd/org-sql-extract-properties (hl-part acc)
"Add properties data from HL-PART and add to accumulator ACC. "Add properties data from HL-PART and add to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'." HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(let* ((hl (alist-get :headline hl-part)) (let* ((sec (alist-get :section hl-part))
(sec (alist-get :section hl-part))
(prop-drawer (assoc 'property-drawer sec)) (prop-drawer (assoc 'property-drawer sec))
(node-props (org-element-contents prop-drawer)) (node-props (org-element-contents prop-drawer))
(scan (into
(lambda (node-props hl-part &optional acc) (lambda (np acc hl-part)
(if (not node-props) (let ((key (org-element-property :key np)))
acc (if (member key nd/org-sql-ignored-properties)
(let* ((cur (car node-props)) acc
(rem (cdr node-props)) (let* ((hl (alist-get :headline hl-part))
(hl (alist-get :headline hl-part)) (fp (alist-get :filepath hl-part))
(fp (alist-get :filepath hl-part)) (hl-offset (org-element-property :begin hl))
(offset (org-element-property :begin hl)) (np-offset (org-element-property :begin np))
(np-offset (org-element-property :begin cur)) (val (org-element-property :value np))
(key (org-element-property :key cur)) (prop-data (list :archive_file_path fp
(val (org-element-property :value cur)) :headline_file_offset hl-offset
(prop-data (list :archive_file_path fp :property_file_offset np-offset
:headline_file_offset offset :key_text key
:property_file_offset np-offset :val_text val
:key_text key ;; TODO add inherited flag
:val_text val :inherited nil)))
;; TODO add inherited flag (nd/alist-put acc 'properties prop-data)))))))
:inherited nil)) (nd/org-sql-extract node-props into acc hl-part)))
(acc*
(if (member key nd/org-sql-ignored-properties)
acc
(nd/alist-put acc 'properties prop-data))))
(funcall scan rem hl-part acc*))))))
(nd/org-sql-extract-property node-props hl-part acc)))
(defun nd/org-sql-extract-tags (hl-part &optional acc) (defun nd/org-sql-extract-tags (hl-part acc)
"Add tags data from HL-PART and add to accumulator ACC. "Extract tags data from HL-PART and add to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'." HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(let* ((hl (alist-get :headline hl-part)) (let* ((hl (alist-get :headline hl-part))
(tags (org-element-property :tags hl)) (tags (org-element-property :tags hl))
@ -3465,66 +3451,55 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(i-tags (if nd/org-sql-use-tag-inheritance (i-tags (if nd/org-sql-use-tag-inheritance
(nd/org-element-get-parent-tags hl i-tags) (nd/org-element-get-parent-tags hl i-tags)
i-tags)) i-tags))
(scan (into
(lambda (tags hl-part &optional acc inherited) (lambda (tag acc hl-part &optional inherited)
(if (not tags) (let* ((hl (alist-get :headline hl-part))
acc (fp (alist-get :filepath hl-part))
(let* ((cur (car tags)) (offset (org-element-property :begin hl))
(rem (cdr tags)) (i (if inherited 1 0))
(hl (alist-get :headline hl-part)) (tags-data (list :archive_file_path fp
(fp (alist-get :filepath hl-part)) :headline_file_offset offset
(offset (org-element-property :begin hl)) :tag tag
(i (if inherited 1 0)) :inherited i)))
(tags-data (list :archive_file_path fp (nd/alist-put acc 'tags tags-data))))
:headline_file_offset offset (acc* (nd/org-sql-extract tags into acc hl-part)))
:tag cur (nd/org-sql-extract i-tags into acc* hl-part t)))
:inherited i))
(acc* (nd/alist-put acc 'tags tags-data)))
(funcall scan rem hl-part acc* inherited)))))
(acc* (funcall scan tags hl-part acc)))
(funcall scan i-tags hl-part acc* t)))
(defun nd/org-sql-extract-scanner (objs fun acc &rest args) (defun nd/org-sql-extract (objs fun acc &rest args)
"Recursively iterate through OBJS and add them to accumulator ACC. "Iterate through OBJS and add them to accumulator ACC using FUN.
FUN is a function that takes a single object from OBJS, processes it, FUN is a function that takes a single object from OBJS, the accumulator,
and adds it to ACC before returning a new ACC. Remaining ARGS will be and ARGS. FUN adds OBJ to ACC and returns a new ACC."
passed to FUN."
(if (not objs) (if (not objs)
acc acc
(let* ((cur (car objs)) (let* ((cur (car objs))
(rem (cdr objs)) (rem (cdr objs))
(acc* (apply fun cur acc args))) (acc* (apply fun cur acc args)))
(apply #'nd/org-sql-extract-scanner rem fun acc args)))) (apply #'nd/org-sql-extract rem fun acc* args))))
(defun nd/org-sql-extract-links (hl-part &optional acc) (defun nd/org-sql-extract-links (hl-part &optional acc)
"Add link data from headline HL-PART to accumulator ACC. "Add link data from headline HL-PART to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'." HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(let* ((sec (alist-get :section hl-part)) (let* ((sec (alist-get :section hl-part))
(links (org-element-map sec 'link #'identity)) (links (org-element-map sec 'link #'identity))
(scan (into
(lambda (links hl-part &optional acc) (lambda (ln acc hl-part)
(if (not links) (let* ((fp (alist-get :filepath hl-part))
acc
(let* ((cur (car links))
(rem (cdr links))
(fp (alist-get :filepath hl-part))
(hl (alist-get :headline hl-part)) (hl (alist-get :headline hl-part))
(hl-offset (org-element-property :begin hl)) (hl-offset (org-element-property :begin hl))
(ln-offset (org-element-property :begin cur)) (ln-offset (org-element-property :begin ln))
(ln-path (org-element-property :path cur)) (ln-path (org-element-property :path ln))
(ln-text (org-element-contents cur)) (ln-text (org-element-contents ln))
(ln-text (mapcar #'nd/strip-string ln-text)) (ln-text (mapcar #'nd/strip-string ln-text))
(ln-text (string-join ln-text)) (ln-text (string-join ln-text))
(ln-type (org-element-property :type cur)) (ln-type (org-element-property :type ln))
(ln-data (list :archive_file_path fp (ln-data (list :archive_file_path fp
:headline_file_offset hl-offset :headline_file_offset hl-offset
:link_file_offset ln-offset :link_file_offset ln-offset
:link_path ln-path :link_path ln-path
:link_text ln-text :link_text ln-text
:link_type ln-type)) :link_type ln-type)))
(acc* (nd/alist-put acc 'links ln-data))) (nd/alist-put acc 'links ln-data)))))
(funcall scan rem hl-part acc*)))))) (nd/org-sql-extract links into acc hl-part)))
(funcall scan links hl-part acc)))
(defun nd/org-sql-extract-headline (hl-part &optional acc) (defun nd/org-sql-extract-headline (hl-part &optional acc)
"Add general data from headline HL-PART to accumulator ACC. "Add general data from headline HL-PART to accumulator ACC.
@ -3567,24 +3542,22 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
:content nil))) :content nil)))
(nd/alist-put acc 'headlines hl-data))) (nd/alist-put acc 'headlines hl-data)))
(defun nd/org-sql-extract-headlines-all (headlines fp &optional acc) (defun nd/org-sql-extract-headlines (headlines acc fp)
"Extract data from HEADLINES and add to accumulator ACC. "Extract data from HEADLINES and add to accumulator ACC.
FP is the file path containing the headlines." FP is the path to the file containing the headlines."
(if (not headlines) (let ((into
acc (lambda (hl acc fp)
(let* ((cur (car headlines)) (let* ((hl-part (nd/org-sql-partition-headline hl fp))
(rem (cdr headlines)) (hl-sub (alist-get :subheadlines hl-part))
(hl-part (nd/org-sql-partition-headline cur fp)) (acc* (nd/org-sql-extract-headline hl-part acc))
(hl-sub (alist-get :subheadlines hl-part)) (acc* (nd/org-sql-extract-links hl-part acc*))
(acc* (nd/org-sql-extract-headline hl-part acc)) (acc* (nd/org-sql-extract-tags hl-part acc*))
(acc* (nd/org-sql-extract-links hl-part acc*)) (acc* (nd/org-sql-extract-properties hl-part acc*))
(acc* (nd/org-sql-extract-tags hl-part acc*)) (acc* (nd/org-sql-extract-lb hl-part acc*)))
(acc* (nd/org-sql-extract-properties hl-part acc*)) (nd/org-sql-extract-headlines hl-sub acc* fp)))))
(acc* (nd/org-sql-extract-lb hl-part acc*)) (nd/org-sql-extract headlines into acc fp)))
(acc* (nd/org-sql-extract-headlines-all hl-sub fp acc*)))
(nd/org-sql-extract-headlines-all rem fp acc*))))
(defun nd/org-sql-extract () (defun nd/org-sql-extract-files ()
"Return a plist of data to be inserted into sql database." "Return a plist of data to be inserted into sql database."
(let* ((rxv-path (expand-file-name "test.org_archive" org-directory)) (let* ((rxv-path (expand-file-name "test.org_archive" org-directory))
;; TODO files need to be already open??? ;; TODO files need to be already open???
@ -3594,16 +3567,12 @@ FP is the file path containing the headlines."
(headlines (if (eq 'section (org-element-type (car contents))) (headlines (if (eq 'section (org-element-type (car contents)))
(cdr contents) (cdr contents)
contents))) contents)))
(nd/org-sql-extract-headlines-all headlines rxv-path))) (nd/org-sql-extract-headlines headlines nil rxv-path)))
(defun nd/org-archive-to-db () (defun nd/org-archive-to-db ()
"Transfer archive files to sqlite database." "Transfer archive files to sqlite database."
(let ((sql-data (nd/org-sql-extract))) (let ((sql-data (nd/org-sql-extract-files)))
(nd/sql-insert-multi nd/org-sqlite-db-path sql-data))) (nd/sql-insert-multi nd/org-sqlite-db-path sql-data)))
;; these are obviously temporary
(setq max-lisp-eval-depth 100000
max-specpdl-size 800000)
#+END_SRC #+END_SRC
* tools * tools
** printing ** printing