From d33c1d0609ee8161924b9515274ae692484a057e Mon Sep 17 00:00:00 2001 From: contrapunctus Date: Wed, 12 Jan 2022 02:51:37 +0530 Subject: [PATCH] Implement record-incomplete check, extensible verification framework --- TODO.org | 16 +++--- elisp/chronometrist.el | 103 ++++++++++++++++++++++++++++---------- elisp/chronometrist.org | 108 ++++++++++++++++++++++++++++++---------- 3 files changed, 171 insertions(+), 56 deletions(-) diff --git a/TODO.org b/TODO.org index 05e2fb0..613b96d 100644 --- a/TODO.org +++ b/TODO.org @@ -835,14 +835,18 @@ Command to delete the interval currently being recorded. (bind to 'k') ** fix handling of tagged alist group values :bug: ** put each list element on its own line if length of list exceeds fill-column :feature: -* verify command [16%] :feature: +* verify command [33%] :feature: +1. [X] Iterate over errors +2. [ ] Next/previous error +3. [ ] Quit iteration +4. [ ] Action to fix errors + With different checks, for different levels of speed/thoroughness - 1. [X] (plist group) Sequence of plist group dates -2. [ ] Check that every record (except the last) has a =:stop= -3. [ ] Intersecting timestamps -4. [ ] Sequence of records -5. [ ] (plist group) Midnight spanning interval check (first and last intervals) -6. [ ] (plist group) Check that plist timestamps have the correct date. Only applicable [[dates-in-timestamps][as long as they have a date.]] +2. [X] Check that every record (except the last) has a =:stop= +3. [ ] Check that every record's =:stop= is greater than or equal to the last one's =:start= +4. [ ] (plist group) Midnight spanning interval check (first and last intervals) +5. [ ] (plist group) Check that plist timestamps have the correct date. Only applicable [[dates-in-timestamps][as long as they have a date.]] There are two approaches I can think of - 1. an interactive Emacs command like =checkdoc= diff --git a/elisp/chronometrist.el b/elisp/chronometrist.el index 54e6ee5..7ef7572 100644 --- a/elisp/chronometrist.el +++ b/elisp/chronometrist.el @@ -1037,9 +1037,12 @@ hash table values must be in chronological order.") ;; setup-file-watch:1 ends here ;; [[file:chronometrist.org::*edit-backend][edit-backend:1]] -(cl-defmethod chronometrist-edit-backend ((backend chronometrist-file-backend-mixin)) - (find-file-other-window (chronometrist-backend-file backend)) - (goto-char (point-max))) +(cl-defmethod chronometrist-edit-backend ((backend chronometrist-file-backend-mixin) &key position) + (with-slots (file) backend + (let ((buffer (find-file-noselect file))) + (with-current-buffer buffer + (goto-char (or position (point-max)))) + (pop-to-buffer buffer)))) ;; edit-backend:1 ends here ;; [[file:chronometrist.org::*initialize-instance][initialize-instance:1]] @@ -1552,17 +1555,18 @@ This is meant to be run in `chronometrist-file' when using an s-expression backe (defclass chronometrist-plist-group-backend (chronometrist-elisp-sexp-backend chronometrist-file-backend-mixin) ((extension :initform "plg" :accessor chronometrist-backend-ext - :custom 'string))) + :custom 'string) + (verify-functions :initform '(chronometrist-verify-backend-group-order + chronometrist-verify-backend-record-incomplete) + :accessor chronometrist-backend-verify-functions-alist))) -(chronometrist-register-backend - :plist-group "Store records as plists grouped by date." - (make-instance 'chronometrist-plist-group-backend - :path chronometrist-file)) +(chronometrist-register-backend :plist-group "Store records as plists grouped by date." + (make-instance 'chronometrist-plist-group-backend :path chronometrist-file)) ;; backend:1 ends here ;; [[file:chronometrist.org::*backward-read-sexp][backward-read-sexp:1]] (defun chronometrist-backward-read-sexp (buffer) - (backward-list) + (backward-sexp) (save-excursion (read buffer))) ;; backward-read-sexp:1 ends here @@ -1770,32 +1774,81 @@ Return value is either a list in the form ;; on-remove:1 ends here ;; [[file:chronometrist.org::*verify][verify:1]] -(cl-defmethod chronometrist-verify-backend ((backend chronometrist-plist-group-backend)) - (with-slots (file hash-table) backend - ;; incorrectly ordered groups check +(defclass chronometrist-verify-error () + ((format-string :initarg :format-string) + (format-args :initarg :format-args) + (error-location + :initform nil + :initarg :error-location + :documentation "Position of error. For file backends, the value of `point'.")) + :documentation "docstring") + +(cl-defmethod chronometrist-verify-backend-group-order ((backend chronometrist-plist-group-backend)) + "Check BACKEND for incorrectly-ordered groups. +Return a list of `chronometrist-verify-error' objects, or nil if +there were no errors." + (with-slots (file) backend (chronometrist-loop-sexp-file for group in file with old-iso with old-unix with new-iso with new-unix ;; dates do (setq new-iso (cl-first group) new-unix (parse-iso8601-time-string new-iso)) when (and old-unix (time-less-p old-unix new-unix)) - do (let ((line (line-number-at-pos))) - (message "%S appears before %S" new-iso old-iso) - (cl-return line)) - else do (setq old-iso new-iso old-unix new-unix) - finally return "Yay, no errors! (...that I could find 💀)"))) + collect + (make-instance 'chronometrist-verify-error + :format-string "%S appears before %S" + :format-args (list new-iso old-iso) + :error-location (point)) + do (setq old-iso new-iso + old-unix new-unix)))) +(cl-defmethod chronometrist-verify-backend-record-incomplete ((backend chronometrist-plist-group-backend)) + "Check if records in BACKEND are complete. +All records except the most recent one must have a :stop key. + +Return a list of `chronometrist-verify-error' objects, or nil if +there were no errors." + (with-slots (file) backend + (chronometrist-sexp-in-file file + (goto-char (point-max)) + (cl-loop with sexp with first = t + while (not (bobp)) + ;; do (message "position: %s" (point)) + when (not sexp) do (down-list -1) ;; initial move + do (setq sexp (chronometrist-backward-read-sexp (current-buffer))) + ;; moving between groups + when (stringp sexp) + do (up-list -1) + (unless (progn (backward-sexp) (bobp)) ;; termination check + (forward-sexp) + (down-list -1)) + else when (or (not (plist-get sexp :start)) + (and (not first) + (or (not (plist-get sexp :start)) + (not (plist-get sexp :stop))))) + collect + (make-instance 'chronometrist-verify-error + :format-string "Plist does not contain :start and/or :stop - %S" + :format-args (list sexp) + :error-location (point)) + when first do (setq first nil))))) + +(cl-defmethod chronometrist-verify-backend ((backend chronometrist-plist-group-backend)) + (with-slots (verify-functions) backend + (cl-loop for fn in verify-functions + when (funcall fn backend) append it))) + +;; TODO - with prefix arg, prompt (`completing-read-multiple') to select tests to run (defun chronometrist-verify () (interactive) (let* ((backend (chronometrist-active-backend)) - (line (chronometrist-verify-backend backend)) - (file (chronometrist-backend-file backend)) - (buffer (find-file-noselect file))) - (when line - (with-current-buffer buffer - (goto-char (point-min)) - (forward-line (1- line))) - (pop-to-buffer buffer)))) + (errors (chronometrist-verify-backend backend))) + (if errors + (cl-loop for error in errors do + (with-slots (format-string format-args error-location) error + (chronometrist-edit-backend backend :position error-location) + (apply #'message format-string format-args))) + (message "Yay, no errors! (...that I could find 💀)")))) ;; verify:1 ends here ;; [[file:chronometrist.org::*latest-record][latest-record:1]] diff --git a/elisp/chronometrist.org b/elisp/chronometrist.org index bb177ad..8b936cd 100644 --- a/elisp/chronometrist.org +++ b/elisp/chronometrist.org @@ -1683,9 +1683,12 @@ These can be implemented in terms of the minimal protocol above. **** edit-backend :method: #+BEGIN_SRC emacs-lisp -(cl-defmethod chronometrist-edit-backend ((backend chronometrist-file-backend-mixin)) - (find-file-other-window (chronometrist-backend-file backend)) - (goto-char (point-max))) +(cl-defmethod chronometrist-edit-backend ((backend chronometrist-file-backend-mixin) &key position) + (with-slots (file) backend + (let ((buffer (find-file-noselect file))) + (with-current-buffer buffer + (goto-char (or position (point-max)))) + (pop-to-buffer buffer)))) #+END_SRC **** initialize-instance :method: @@ -2457,18 +2460,19 @@ Concerns specific to the plist group backend - (defclass chronometrist-plist-group-backend (chronometrist-elisp-sexp-backend chronometrist-file-backend-mixin) ((extension :initform "plg" :accessor chronometrist-backend-ext - :custom 'string))) + :custom 'string) + (verify-functions :initform '(chronometrist-verify-backend-group-order + chronometrist-verify-backend-record-incomplete) + :accessor chronometrist-backend-verify-functions-alist))) -(chronometrist-register-backend - :plist-group "Store records as plists grouped by date." - (make-instance 'chronometrist-plist-group-backend - :path chronometrist-file)) +(chronometrist-register-backend :plist-group "Store records as plists grouped by date." + (make-instance 'chronometrist-plist-group-backend :path chronometrist-file)) #+END_SRC **** backward-read-sexp :reader: #+BEGIN_SRC emacs-lisp (defun chronometrist-backward-read-sexp (buffer) - (backward-list) + (backward-sexp) (save-excursion (read buffer))) #+END_SRC @@ -2702,33 +2706,87 @@ Return value is either a list in the form #+END_SRC **** verify :reader:method: +1. Each =verify-function= checks the backend independently, each for a specific issue +2. =verify-backend= collects errors from =verify-functions= +3. =verify= walks through errors, displaying the error message based on the format-string and jumping to the position of each error + 1. Use =edit-backend= to display the backend, rather than accessing slots. Extend =edit-backend= to take an optional =position= argument. + #+BEGIN_SRC emacs-lisp -(cl-defmethod chronometrist-verify-backend ((backend chronometrist-plist-group-backend)) - (with-slots (file hash-table) backend - ;; incorrectly ordered groups check +(defclass chronometrist-verify-error () + ((format-string :initarg :format-string) + (format-args :initarg :format-args) + (error-location + :initform nil + :initarg :error-location + :documentation "Position of error. For file backends, the value of `point'.")) + :documentation "docstring") + +(cl-defmethod chronometrist-verify-backend-group-order ((backend chronometrist-plist-group-backend)) + "Check BACKEND for incorrectly-ordered groups. +Return a list of `chronometrist-verify-error' objects, or nil if +there were no errors." + (with-slots (file) backend (chronometrist-loop-sexp-file for group in file with old-iso with old-unix with new-iso with new-unix ;; dates do (setq new-iso (cl-first group) new-unix (parse-iso8601-time-string new-iso)) when (and old-unix (time-less-p old-unix new-unix)) - do (let ((line (line-number-at-pos))) - (message "%S appears before %S" new-iso old-iso) - (cl-return line)) - else do (setq old-iso new-iso old-unix new-unix) - finally return "Yay, no errors! (...that I could find 💀)"))) + collect + (make-instance 'chronometrist-verify-error + :format-string "%S appears before %S" + :format-args (list new-iso old-iso) + :error-location (point)) + do (setq old-iso new-iso + old-unix new-unix)))) +(cl-defmethod chronometrist-verify-backend-record-incomplete ((backend chronometrist-plist-group-backend)) + "Check if records in BACKEND are complete. +All records except the most recent one must have a :stop key. + +Return a list of `chronometrist-verify-error' objects, or nil if +there were no errors." + (with-slots (file) backend + (chronometrist-sexp-in-file file + (goto-char (point-max)) + (cl-loop with sexp with first = t + while (not (bobp)) + ;; do (message "position: %s" (point)) + when (not sexp) do (down-list -1) ;; initial move + do (setq sexp (chronometrist-backward-read-sexp (current-buffer))) + ;; moving between groups + when (stringp sexp) + do (up-list -1) + (unless (progn (backward-sexp) (bobp)) ;; termination check + (forward-sexp) + (down-list -1)) + else when (or (not (plist-get sexp :start)) + (and (not first) + (or (not (plist-get sexp :start)) + (not (plist-get sexp :stop))))) + collect + (make-instance 'chronometrist-verify-error + :format-string "Plist does not contain :start and/or :stop - %S" + :format-args (list sexp) + :error-location (point)) + when first do (setq first nil))))) + +(cl-defmethod chronometrist-verify-backend ((backend chronometrist-plist-group-backend)) + (with-slots (verify-functions) backend + (cl-loop for fn in verify-functions + when (funcall fn backend) append it))) + +;; TODO - with prefix arg, prompt (`completing-read-multiple') to select tests to run (defun chronometrist-verify () (interactive) (let* ((backend (chronometrist-active-backend)) - (line (chronometrist-verify-backend backend)) - (file (chronometrist-backend-file backend)) - (buffer (find-file-noselect file))) - (when line - (with-current-buffer buffer - (goto-char (point-min)) - (forward-line (1- line))) - (pop-to-buffer buffer)))) + (errors (chronometrist-verify-backend backend))) + (if errors + (cl-loop for error in errors do + (with-slots (format-string format-args error-location) error + (chronometrist-edit-backend backend :position error-location) + (apply #'message format-string format-args))) + (message "Yay, no errors! (...that I could find 💀)")))) #+END_SRC **** extended protocol