Rough (broken) generic loop-records implementation and test loop

This commit is contained in:
contrapunctus 2021-09-05 19:37:00 +05:30
parent b8b0967e18
commit b48ecb67a6
2 changed files with 82 additions and 0 deletions

View File

@ -420,6 +420,29 @@ Hash table keys are ISO-8601 date strings. Hash table values are lists of record
(cl-defgeneric chronometrist-list-records (backend)
"Return all records in BACKEND as a list of plists, in reverse chronological order.")
(cl-defgeneric chronometrist--loop-records (backend var loop-clauses)
"Call `cl-loop' with LOOP-CLAUSES over each record in BACKEND.
VAR is a symbol to be bound to a plist representing each record, in reverse chronological order. LOOP-CLAUSES is a list of forms to be passed to `cl-loop`.")
(defmacro chronometrist-loop-records (_for expr _in backend &rest loop-clauses)
(declare (indent defun)
(debug nil)
;; FIXME
;; (debug ("for" form "in" form &rest &or sexp form))
)
`(chronometrist--loop-records ,backend (quote ,expr) (quote ,loop-clauses)))
(chronometrist-loop-records for plist in (chronometrist-active-backend)
with count = 0
when (equal (plist-get plist :name) "Programming")
sum (chronometrist-interval plist) into seconds
and do (cl-incf count)
finally return
(unless (zerop seconds)
(format "%s over %s days."
(ts-human-format-duration seconds)
count)))
(cl-defgeneric chronometrist-on-file-change (backend)
"Function to be run when file for BACKEND changes.")
@ -449,6 +472,23 @@ STREAM (which is the value of `current-buffer')."
`(with-current-buffer (find-file-noselect ,file)
(save-excursion ,@body)))
(cl-defmethod chronometrist--loop-records ((backend chronometrist-plist-backend) expr &rest loop-clauses)
(declare (indent defun)
(debug nil)
;; FIXME
;; (debug ("for" form "in" form &rest &or sexp form))
)
(chronometrist-sexp-in-file (chronometrist-backend-file backend)
(goto-char (point-max))
(apply #'cl-loop with expr
while (and (not (bobp))
(backward-list)
(or (not (bobp))
(not (looking-at-p "^[[:blank:]]*;")))
(setq ,expr (ignore-errors (read (current-buffer))))
(backward-list))
,@loop-clauses)))
(defmacro chronometrist-loop-file (_for expr _in file &rest loop-clauses)
"`cl-loop' LOOP-CLAUSES over s-expressions in FILE, in reverse.
EXPR is bound to each s-expression."

View File

@ -1034,6 +1034,31 @@ Hash table keys are ISO-8601 date strings. Hash table values are lists of record
(cl-defgeneric chronometrist-list-records (backend)
"Return all records in BACKEND as a list of plists, in reverse chronological order.")
#+END_SRC
**** loop-records :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist--loop-records (backend var loop-clauses)
"Call `cl-loop' with LOOP-CLAUSES over each record in BACKEND.
VAR is a symbol to be bound to a plist representing each record, in reverse chronological order. LOOP-CLAUSES is a list of forms to be passed to `cl-loop`.")
(defmacro chronometrist-loop-records (_for expr _in backend &rest loop-clauses)
(declare (indent defun)
(debug nil)
;; FIXME
;; (debug ("for" form "in" form &rest &or sexp form))
)
`(chronometrist--loop-records ,backend (quote ,expr) (quote ,loop-clauses)))
(chronometrist-loop-records for plist in (chronometrist-active-backend)
with count = 0
when (equal (plist-get plist :name) "Programming")
sum (chronometrist-interval plist) into seconds
and do (cl-incf count)
finally return
(unless (zerop seconds)
(format "%s over %s days."
(ts-human-format-duration seconds)
count)))
#+END_SRC
**** on-file-change :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-on-file-change (backend)
@ -1173,6 +1198,23 @@ STREAM (which is the value of `current-buffer')."
#+END_SRC
**** loop-file :macro:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist--loop-records ((backend chronometrist-plist-backend) expr &rest loop-clauses)
(declare (indent defun)
(debug nil)
;; FIXME
;; (debug ("for" form "in" form &rest &or sexp form))
)
(chronometrist-sexp-in-file (chronometrist-backend-file backend)
(goto-char (point-max))
(apply #'cl-loop with expr
while (and (not (bobp))
(backward-list)
(or (not (bobp))
(not (looking-at-p "^[[:blank:]]*;")))
(setq ,expr (ignore-errors (read (current-buffer))))
(backward-list))
,@loop-clauses)))
(defmacro chronometrist-loop-file (_for expr _in file &rest loop-clauses)
"`cl-loop' LOOP-CLAUSES over s-expressions in FILE, in reverse.
EXPR is bound to each s-expression."