feat(spark): create task-durations-month

This commit is contained in:
contrapunctus 2021-06-24 06:07:35 +05:30
parent e7561cf0bb
commit 8f664fd4e2
2 changed files with 69 additions and 9 deletions

View File

@ -102,5 +102,28 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
;; when being enabled/disabled, `chronometrist-spark-minor-mode' will already be t/nil here
(if chronometrist-spark-minor-mode (chronometrist-spark-setup) (chronometrist-spark-teardown)))
(defun chronometrist-task-durations-month (task iso-year-month)
(let* ((start-ts (chronometrist-iso-date-to-ts (concat iso-year-month "-01")))
;; last date of month
(stop-ts (ts-adjust 'month 1 'day -1 start-ts))
(start-dow (ts-dow start-ts))
(stop-dow (ts-dow stop-ts)))
(cl-loop with current = start-ts
while (not (ts> current stop-ts))
collect
(cl-loop
with row
;; pad with nils if not starting from Sunday
initially ;; could be moved to the outer loop? 🤔
(when (and (ts= current start-ts)
(not (zerop start-dow)))
(setq row (make-list start-dow nil)))
for day from (ts-dow current) to 6
;; do (message (ts-format "%a, %d %h %Y" current))
collect (chronometrist-task-time-one-day task current) into row
do (setq current (ts-adjust 'day 1 current))
;; finally (message "row - %S" row)
finally return row))))
(provide 'chronometrist-spark)
;;; chronometrist-spark.el ends here

View File

@ -38,28 +38,28 @@
(require 'spark)
#+END_SRC
* Code
** custom group :custom:group:
** custom group :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-spark nil
"Show sparklines in `chronometrist'."
:group 'applications)
#+END_SRC
** length :custom:variable:
** length :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-spark-length 7
"Length of each sparkline in number of days."
:type 'integer)
#+END_SRC
** show-range :custom:variable:
** show-range :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-spark-show-range t
"If non-nil, display range of each sparkline."
:type 'boolean)
#+END_SRC
** range :function:
** range :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-range (durations)
"Return range for DURATIONS as a string.
@ -86,7 +86,7 @@ DURATIONS must be a list of integer seconds."
(should (equal (chronometrist-spark-range '(60 0 0)) "(1m)"))
(should (equal (chronometrist-spark-range '(60 0 120)) "(1m~2m)")))
#+END_SRC
** TODO row-transformer :function:
** TODO row-transformer :function:
if larger than 7
add space after (% length 7)th element
then add space after every 7 elements
@ -121,7 +121,7 @@ ROW must be a valid element of the list specified by
#+END_SRC
** TODO schema-transformer :function:
** TODO schema-transformer :function:
calculate length while accounting for space
#+BEGIN_SRC emacs-lisp
@ -136,7 +136,7 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
t)]))
#+END_SRC
** setup :writer:
** setup :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-setup ()
"Add `chronometrist-sparkline' functions to `chronometrist' hooks."
@ -144,7 +144,7 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
(add-to-list 'chronometrist-schema-transformers #'chronometrist-spark-schema-transformer))
#+END_SRC
** teardown :writer:
** teardown :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-teardown ()
"Remove `chronometrist-sparkline' functions from `chronometrist' hooks."
@ -154,7 +154,7 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
(remove #'chronometrist-spark-schema-transformer chronometrist-schema-transformers)))
#+END_SRC
** minor-mode :minor:mode:
** minor-mode :minor:mode:
#+BEGIN_SRC emacs-lisp
(define-minor-mode chronometrist-spark-minor-mode
nil nil nil nil
@ -162,6 +162,43 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
(if chronometrist-spark-minor-mode (chronometrist-spark-setup) (chronometrist-spark-teardown)))
#+END_SRC
** month view
*** prompt
*** task-durations-month
#+BEGIN_SRC emacs-lisp
(defun chronometrist-task-durations-month (task iso-year-month)
(let* ((start-ts (chronometrist-iso-date-to-ts (concat iso-year-month "-01")))
;; last date of month
(stop-ts (ts-adjust 'month 1 'day -1 start-ts))
(start-dow (ts-dow start-ts))
(stop-dow (ts-dow stop-ts)))
(cl-loop with current = start-ts
while (not (ts> current stop-ts))
collect
(cl-loop
with row
;; pad with nils if not starting from Sunday
initially ;; could be moved to the outer loop? 🤔
(when (and (ts= current start-ts)
(not (zerop start-dow)))
(setq row (make-list start-dow nil)))
for day from (ts-dow current) to 6
;; do (message (ts-format "%a, %d %h %Y" current))
collect (chronometrist-task-time-one-day task current) into row
do (setq current (ts-adjust 'day 1 current))
;; finally (message "row - %S" row)
finally return row))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-spark-tests.el :load test
(ert-deftest chronometrist-task-durations-month ()
(should (--every-p
(= 7 (length it))
(chronometrist-task-durations-month "Anything" "2021-01")))
(should (--every-p
(= 7 (length it))
(chronometrist-task-durations-month "Anything" "2021-02"))))
#+END_SRC
* Provide
#+BEGIN_SRC emacs-lisp
(provide 'chronometrist-spark)