-
Notifications
You must be signed in to change notification settings - Fork 2
/
metrics-tracker.el
1465 lines (1218 loc) · 71.7 KB
/
metrics-tracker.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; metrics-tracker.el --- Generate reports of personal metrics from diary entries -*- lexical-binding: t -*-
;; Copyright (C) 2019-2020 Ian Martins
;; Author: Ian Martins <[email protected]>
;; URL: https://github.com/ianxm/emacs-tracker
;; Version: 0.3.14
;; Keywords: calendar
;; Package-Requires: ((emacs "24.4") (seq "2.3"))
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; For a full copy of the GNU General Public License
;; see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; metrics-tracker.el generates tables and graphs from the personal metrics
;; data found in your diary entries.
;;; Code:
(require 'seq)
(require 'timezone)
(require 'calendar)
;; custom variables
(defgroup metrics-tracker nil
"Options for customizing Metrics Tracker reports."
:group 'diary
:tag "Metrics Tracker")
(defcustom metrics-tracker-graph-size '(700 . 500)
"Specifies the size as (width . height) to be used for graph images."
:type '(cons integer integer)
:group 'metrics-tracker)
(defcustom metrics-tracker-metric-name-whitelist nil
"List of metric names to include in reports.
If this is specified, only the metrics in this list are
considered. All others are filtered out. If this is set, then
`metrics-tracker-metric-name-blacklist' has no effect.
For example: '(\"pushups\" \"situps\")"
:type '(list :inline t string)
:group 'metrics-tracker)
(defcustom metrics-tracker-metric-name-blacklist nil
"List of metric names to exclude from reports.
This is ignored if `metrics-tracker-metric-name-whitelist' is set.
For example: '(\"pushups\" \"situps\")"
:type '(list :inline t string)
:group 'metrics-tracker)
(defcustom metrics-tracker-graph-colors '(("#1f77b4" "#ff7f0e" "#2ca02c" "#d62728" "#9467bd" "#8c564b" "#e377c2" "#7f7f7f" "#bcbd22" "#17becf")
("#4d871a" "#81871a" "#87581a" "#1a5a87" "#761a87" "#871a1a" "#833a3a" "#403a83" "#3a7f83" "#83743a"))
"Colors to use for each series in graphs. The first list is used when in light mode; the second list for dark mode."
:type '(list (list :inline t string) ; light mode colors
(list :inline t string)) ; dark mode colors
:group 'metrics-tracker)
(defcustom metrics-tracker-dark-mode nil
"If \"t\", generate graph images with dark backgrounds."
:type 'boolean
:group 'metrics-tracker)
(defcustom metrics-tracker-named-reports nil
"Pre-configured reports that can be re-rendered by name with current data.
All metrics tracker report types are supported. Add to this list
by generating the report to save and then calling
`metrics-tracker-save-last-report', or by editing this list in
`customize'.
Display a report from this list using `metrics-tracker-show-named-report'."
:type '(repeat
(choice (list :tag "Table Report"
(string :tag "Report Name")
(const :tag "Table Report" table)
(repeat :tag "Metric Names" string)
(choice :tag "Date Grouping " (const day) (const week) (const month) (const year) (const full))
(choice :tag "Value Transform" (const total) (const min) (const max) (const avg) (const count) (const percent)
(const :tag "per day" per-day) (const :tag "per week" per-week) (const :tag "per month" per-month) (const :tag "per year" per-year)
(const :tag "difference total" diff-total) (const :tag "difference min" diff-min) (const :tag "difference max" diff-max)
(const :tag "difference average" diff-avg) (const :tag "difference count" diff-count) (const :tag "difference percent" diff-percent)
(const :tag "difference per day" diff-per-day) (const :tag "difference per week" diff-per-week)
(const :tag "difference per month" diff-per-month) (const :tag "difference per year" diff-per-year)
(const :tag "accumulate" accum) (const :tag "accumulate count" accum-count))
(choice :tag "Start Date " (const :tag "first occurrence" nil) (string :tag "date string"))
(choice :tag "End Date " (const :tag "last occurrence" nil) (string :tag "date string")))
(list :tag "Calendar Report"
(string :tag "Report Name")
(const :tag "Calendar Report" cal)
(string :tag "Metric Names")
(choice :tag "Value Transform" (const total) (const count))
(choice :tag "Start Date " (const :tag "first occurrence" nil) (string :tag "date string"))
(choice :tag "End Date " (const :tag "last occurrence" nil) (string :tag "date string")))
(list :tag "Graph Report"
(string :tag "Report Name")
(const :tag "Graph Report" graph)
(repeat :tag "Metric Names" string)
(choice :tag "Date Grouping " (const day) (const week) (const month) (const year) (const full))
(choice :tag "Value Transform" (const total) (const min) (const max) (const avg) (const count) (const percent)
(const :tag "per day" per-day) (const :tag "per week" per-week) (const :tag "per month" per-month) (const :tag "per year" per-year)
(const :tag "difference total" diff-total) (const :tag "difference min" diff-min) (const :tag "difference max" diff-max)
(const :tag "difference average" diff-avg) (const :tag "difference count" diff-count) (const :tag "difference percent" diff-percent)
(const :tag "difference per day" diff-per-day) (const :tag "difference per week" diff-per-week)
(const :tag "difference per month" diff-per-month) (const :tag "difference per year" diff-per-year)
(const :tag "accumulate" accum) (const :tag "accumulate count" accum-count))
(choice :tag "Start Date " (const :tag "first occurrence" nil) (string :tag "date string"))
(choice :tag "End Date " (const :tag "last occurrence" nil) (string :tag "date string"))
(choice :tag "Graph Type " (const line) (const bar) (const stacked) (const scatter))
(choice :tag "Graph Output " (const svg) (const png) (const ascii)))))
:group 'metrics-tracker)
(defcustom metrics-tracker-derived-metrics nil
"List of metrics which are computed based on other metrics.
Metrics can be derived from other derived metrics, but circular
references are not allowed.
If not specified, `Expression' defaults to summing all base
metric values for each day. If specified, it takes an arbitrary
math expression evaluated by calc which uses $N for the Nth base
metric."
:type '(repeat
(list
(string :tag "metric name") ; the name of the derived metric
(repeat :tag "Base Metric" string) ; the names of the metrics from which it is derived
(choice :tag "Expression" ; default is "$1 + $2 + ..."
(const :tag "sum values" nil)
(string :tag "defined"))))
:group 'metrics-tracker)
;; dynamically scoped constants and variables and associated helper functions
(defvar metrics-tracker-metric-index nil
"This is the list of metrics read from the diary file.
It is a list containing: (name count first last) for each metric.
It is cleared when the metrics-tracker output buffer is killed, forcing
the diary file to be re-read if the data is needed again.")
(defvar metrics-tracker-tempfiles nil
"This is the list of tempfiles (graph images) that have been created during the current session.")
(defvar metrics-tracker-metric-names (make-vector 5 0)
"This is an obarray of all existing metric names.")
(defvar metrics-tracker-last-report-config nil
"This holds the configuration of the last report that was rendered.")
(defconst metrics-tracker-output-buffer-name "*Metrics Tracker Output*"
"The name of the output buffer.")
(define-error 'metrics-tracker-invalid-value "The given value cannot be parsed")
(defconst metrics-tracker-grouping-and-transform-options
'(day (total count accum accum-count)
week (total min max avg count percent per-day
diff-total diff-min diff-max diff-avg diff-count diff-percent diff-per-day)
month (total min max avg count percent per-day per-week
diff-total diff-min diff-max diff-avg diff-count diff-percent diff-per-day diff-per-week)
year (total min max avg count percent per-day per-week per-month
diff-total diff-min diff-max diff-avg diff-count diff-percent diff-per-day diff-per-week diff-per-month)
full (total min max avg count percent per-day per-week per-month per-year
diff-total diff-min diff-max diff-avg diff-count diff-percent diff-per-day diff-per-week diff-per-month diff-per-year))
"This is a plist of date-grouping options mapped to value-transform options.")
(defun metrics-tracker--date-grouping-options ()
"Pull the list of date-grouping options out of `metrics-tracker-grouping-and-transform-options'."
(seq-filter (lambda (x) (symbolp x)) metrics-tracker-grouping-and-transform-options))
(defun metrics-tracker--value-transform-options (date-grouping)
"Return the valid value-transforms for the given DATE-GROUPING."
(plist-get metrics-tracker-grouping-and-transform-options date-grouping))
(defconst metrics-tracker-graph-options '(line bar stacked scatter)
"The types of supported graphs.")
(defun metrics-tracker--graph-options (date-transform)
"Return the valid graph-options for the given DATE-TRANSFORM.
We have to filter graph-options based on DATE-TRANSFORM because
line and scatter graphs don't work if there's just one data
point."
(if (eq date-transform 'full)
(seq-difference metrics-tracker-graph-options '(line scatter))
metrics-tracker-graph-options))
(defconst metrics-tracker-graph-output-options '(ascii svg png)
"The graph output options.")
(defun metrics-tracker--presorted-options (options)
"Prevent Emacs from sorting OPTIONS.
Some versions of Emacs sort the given options instead of just
presenting them.
Solution taken from:
https://emacs.stackexchange.com/questions/41801/how-to-stop-completing-read-ivy-completing-read-from-sorting"
(lambda (string pred action)
(if (eq action 'metadata)
'(metadata (display-sort-function . identity)
(cycle-sort-function . identity))
(complete-with-action
action options string pred))))
(defmacro metrics-tracker--min-date (d1 d2)
"Return the earlier of the given dates D1 and D2."
`(if (time-less-p ,d1 ,d2) ,d1 ,d2))
(defmacro metrics-tracker--max-date (d1 d2)
"Return the later of the given dates D1 and D2."
`(if (time-less-p ,d1 ,d2) ,d2 ,d1))
(defun metrics-tracker--string-to-time (&optional date-str)
"Return a time value for DATE-STR if given, else for today.
Returned a time value with hours, minutes, seconds zeroed out."
(apply #'encode-time (mapcar #'(lambda (x) (or x 0)) ; convert nil to 0
(seq-take (parse-time-string (or date-str (format-time-string "%F"))) 6))))
(defmacro metrics-tracker--num-sort (col)
"Sort string numbers in column COL of a tabulated list."
`(lambda (x y) (< (string-to-number (elt (nth 1 x) ,col))
(string-to-number (elt (nth 1 y) ,col)))))
(defmacro metrics-tracker--sort-dates (dates)
"Sort a list of DATES."
`(sort ,dates (lambda (a b) (time-less-p a b))))
(defconst metrics-tracker--entry-format
(rx line-start
(group (or
(seq (= 4 digit) ?- (= 2 digit) ?- (= 2 digit)) ; YYYY-MM-DD
(seq (= 2 digit) ?/ (repeat 2 3 alpha) ?/ (= 4 digit)) ; YYYY/MMM/DD
(seq (>= 2 alpha) space (repeat 1 2 digit) ?, space (= 4 digit)) ; MMM DD, YYYY
(seq (repeat 1 2 digit) space (>= 2 alpha) space (= 4 digit)))) ; DD MMM YYYY
(opt (1+ space) (repeat 1 2 digit) ?: (= 2 digit) ; HH:MM
(opt (0+ space) (in ?A ?a ?P ?p) (in ?M ?m))) ; (am|pm)
(1+ space) (group (1+ ascii)) ; metric name
(1+ space) (group (1+ (in digit ?. ?: ?-))) ; (1.5|1:30)
(0+ space) line-end))
(defconst metrics-tracker--time-format
(rx line-start
(opt (group (repeat 1 2 digit)) ?:) ; hh:
(group (repeat 1 2 digit)) ?: (group (= 2 digit)) ; mm:ss
(opt ?. (1+ digit)) ; .ms
line-end))
(defun metrics-tracker--process-diary (filter action &optional start-date end-date)
"Parse the diary file.
For each valid metrics entry found, parse the fields and then
apply the given FILTER and ACTION.
Optionally, filter out metrics before START-DATE or after END-DATE.
Valid metrics entries look like \"DATE TIME METRICNAME VALUE\" where
- DATE looks like \"2020-01-01\" or \"Jan 1, 2020\" or \"1 Jan 2020\"
- TIME (optional, and we ignore it) looks like \"10:30\" or \"10:30a\" or \"10:30 am\"
- METRICNAME is any string, whitespace included
- VALUE is a decimal number like \"1\" or \"1.2\" or a duration value like \"10:01\" or \"1:20:32.21\""
(let (metric-date-str metric-name-str metric-value-str
metric-date metric-name metric-value)
(with-temp-buffer
(insert-file-contents diary-file)
(dolist (line (split-string (buffer-string) "\n" t))
(condition-case nil
(when (string-match metrics-tracker--entry-format line)
(setq metric-date-str (match-string 1 line) ; with emacs 28 these must be saved immediately
metric-name-str (match-string 2 line)
metric-value-str (match-string 3 line)
metric-date (apply #'encode-time (mapcar #'(lambda (x) (or x 0)) ; convert nil to 0
(seq-take (parse-time-string metric-date-str) 6)))
metric-name (intern metric-name-str metrics-tracker-metric-names)
metric-value (metrics-tracker--try-read-value metric-value-str))
(when (and (funcall filter metric-date metric-name)
(or (null start-date)
(time-less-p start-date metric-date)
(equal start-date metric-date))
(or (null end-date)
(time-less-p metric-date end-date)
(equal metric-date end-date)))
(funcall action metric-date metric-name metric-value)))
(metrics-tracker-invalid-value nil) ; the regexes aren't strict enough to filter this out, but it should be skipped
(error "Error parsing line: %s" line))))))
(defun metrics-tracker--try-read-value (string-value)
"Read a value from STRING-VALUE, or signal that no value can be read.
Any string that matches the `valid-formats' regex can end up
here, but not all can be parsed (for example \"10::21\"). In
those cases we raise the `metric-tracker-invalid-value' signal.
STRING-VALUE [string] is expected to contain a metric value. It
may be formatted as a number (10.21) or a duration (10:21). Hours
are optional for duration values."
(cond ((string-match metrics-tracker--time-format string-value) ; duration as hh:mm:ss.ms
(let ((h (if (match-string 1 string-value) (string-to-number (match-string 1 string-value)) 0))
(m (string-to-number (match-string 2 string-value)))
(s (string-to-number (match-string 3 string-value))))
(+ h (/ m 60.0) (/ s 3600.0)))) ; return duration in hours
((string-match "^[[:digit:]\.]+$" string-value) ; number like 10.21
(string-to-number string-value))
(t ; skip
(signal 'metrics-tracker-invalid-value string-value))))
(defun metrics-tracker-clear-data ()
"Clear cached data and delete tempfiles.
Clear the data cached in `metrics-tracker-metric-index' in order to force
it to be re-read from the diary file the next time it is
needed. Also delete the tempfiles (graph images) listed in
`metrics-tracker-tempfiles'."
(when (string= (buffer-name (current-buffer)) metrics-tracker-output-buffer-name)
(setq metrics-tracker-metric-index nil)
(metrics-tracker-remove-tempfiles)
(remove-hook 'kill-buffer-hook #'metrics-tracker-clear-data)))
(defun metrics-tracker-remove-tempfiles ()
"Remove any tempfiles (graph images) that were created during the current session."
(dolist (elt metrics-tracker-tempfiles)
(if (file-exists-p elt)
(delete-file elt)))
(setq metrics-tracker-tempfiles nil)
(remove-hook 'kill-emacs-hook #'metrics-tracker-remove-tempfiles))
(defun metrics-tracker--load-index ()
"Make sure the metric index has been populated.
This reads the diary file and populated in
`metrics-tracker-metric-list' if it is nil.
`metrics-tracker-metric-list' is a list of
\(metric-name count first last daysago)
sorted by 'last'. For derived metrics, each field applies to
each base metric. For example, `count' is the count of
occurrences of all base metrics, and `daysago' is the number of
days since the last occurrence of any base metric."
(unless metrics-tracker-metric-index
(let* ((metrics (make-hash-table :test 'equal)) ; hash of metric-name -> (metric-name count first last daysago)
existing-metric
(today (metrics-tracker--string-to-time))
(list-filter-fcn (cond ((not (null metrics-tracker-metric-name-whitelist))
(lambda (_date name) ; filter out non-whitelisted metrics
(seq-contains-p metrics-tracker-metric-name-whitelist (symbol-name name))))
((not (null metrics-tracker-metric-name-blacklist))
(lambda (_date name) ; filter out blacklisted metrics
(not (seq-contains-p metrics-tracker-metric-name-blacklist (symbol-name name)))))
(t ; keep all metrics
(lambda (_date _name) t))))
(list-action-fcn (lambda (date name _value)
(setq existing-metric (gethash name metrics))
(if (not existing-metric)
(puthash name
(list name 1 date date (- (time-to-days today) (time-to-days date)))
metrics)
(setcar (nthcdr 1 existing-metric) (1+ (nth 1 existing-metric)))
(setcar (nthcdr 2 existing-metric) (metrics-tracker--min-date (nth 2 existing-metric) date))
(setcar (nthcdr 3 existing-metric) (metrics-tracker--max-date (nth 3 existing-metric) date))
(setcar (nthcdr 4 existing-metric) (- (time-to-days today)
(time-to-days (nth 3 existing-metric))))))))
;; read the diary file, fill `metrics' plist with "name -> (name count first last)"
(metrics-tracker--process-diary list-filter-fcn list-action-fcn)
;; mix in the derived metrics
(let (derived-metric-name ; metric name as a symbol
derived-from ; list of metrics from which the current metric is derived
count) ; count of entries
(dolist (metric metrics-tracker-derived-metrics)
(setq derived-metric-name (intern (car metric) metrics-tracker-metric-names)
derived-from (mapcar (lambda (ii) (gethash (intern ii metrics-tracker-metric-names) metrics))
(nth 1 metric)))
(setq count (seq-reduce (lambda (count ii) (+ count (or (nth 1 ii) 0))) derived-from 0))
(if (eq 0 count) ; filter out derived metrics
(message (format "Ignoring derived metric with no entries: %s" derived-metric-name))
(puthash derived-metric-name
(list derived-metric-name
count
(seq-reduce (lambda (first ii) (if (time-less-p first (nth 2 ii)) first (nth 2 ii))) derived-from today)
(seq-reduce (lambda (last ii) (if (time-less-p last (nth 2 ii)) (nth 3 ii) last)) derived-from 0)
(seq-reduce (lambda (daysago ii) (min daysago (or (nth 4 ii) most-positive-fixnum))) derived-from most-positive-fixnum))
metrics))))
;; convert hash to list and sort by last update date
(setq metrics-tracker-metric-index (sort (hash-table-values metrics) (lambda (a b) (> (nth 4 b) (nth 4 a)))))
(add-hook 'kill-buffer-hook #'metrics-tracker-clear-data))))
(defmacro metrics-tracker--validate-input (variable choice options)
"Validate that VARIABLE was set to a CHOICE that is among the valid OPTIONS."
`(if (not (seq-contains-p ,options ,choice))
(error (concat ,variable " must be one of: " (mapconcat #'symbol-name ,options ", ")))
t))
; public
;;;###autoload
(defun metrics-tracker-index ()
"Display a list of all saved metrics along with some useful stats about each.
This reads the diary file.
Note that derived metrics are counted every time one of their
base metrics occurs. If multiple base metrics occur on the same
day, this will count it multiple times. That's fine when base
metrics are separate terms ($1+$2) but not when they're part of
the same term ($1/$2)."
(interactive)
(metrics-tracker--load-index)
(metrics-tracker--setup-output-buffer)
(tabulated-list-mode)
;; set headers
(let ((metric-name-width (seq-reduce (lambda (width ii) (max width (length ii)))
(mapcar (lambda (ii) (symbol-name (nth 0 ii))) metrics-tracker-metric-index)
10)))
(setq-local tabulated-list-format (vector (list "metric" metric-name-width t)
(list "days ago" 10 (metrics-tracker--num-sort 1))
(list "first" 12 t)
(list "last" 12 t)
(list "count" 8 (metrics-tracker--num-sort 4)))))
;; configure
(setq-local tabulated-list-padding 2)
(setq-local tabulated-list-sort-key (cons "days ago" nil))
;; populate the table data
(let (data)
(dolist (metric metrics-tracker-metric-index)
(setq data (cons (list (symbol-name (nth 0 metric))
(vector (symbol-name (nth 0 metric))
(number-to-string (nth 4 metric))
(format-time-string "%F" (nth 2 metric))
(format-time-string "%F" (nth 3 metric))
(number-to-string (nth 1 metric))))
data)))
(setq-local tabulated-list-entries data))
;; render the table
(tabulated-list-init-header)
(tabulated-list-print nil nil)
(metrics-tracker--show-output-buffer))
(defun metrics-tracker--insert-base-metrics (metric-names &optional cycle-metrics)
"Insert base metrics in front of derived metrics in METRIC-NAMES.
METRIC-NAMES [list string] names of metrics requested for this
report.
CYCLE-METRICS [list string] list of metrics that have already been
added for this report. If we have to add a metric from this list
it'll be a cycle.
Return [list string] input list but insert dependencies in front
of the derived metrics that depend on them."
(let (derived-metric result)
(dolist (metric-name metric-names)
(if (seq-contains-p cycle-metrics metric-name)
(error "Cycle detected in derived metric dependency: %s" metric-name))
(setq derived-metric (seq-find (lambda (ii) (string= metric-name (car ii)))
metrics-tracker-derived-metrics))
(if derived-metric
(setq cycle-metrics (append (list metric-name) cycle-metrics)
result (append (list metric-name)
(metrics-tracker--insert-base-metrics (nth 1 derived-metric)
cycle-metrics)
result))
(setq result (append (list metric-name) result))))
(nreverse result)))
(defun metrics-tracker--date-to-bin (date date-grouping)
"Return the start date of the bin containing DATE of size DATE-GROUPING.
DATE [time] any date, but probably the date of an occurrence.
DATE-GROUPING [symbol] defines bin size."
(if (eq date-grouping 'full)
'full
(let ((date-fields (decode-time date))
(offset (pcase date-grouping
(`day 0)
(`week (nth 6 (decode-time date)))
(`month (1- (nth 3 (decode-time date))))
(`year (1- (string-to-number (format-time-string "%j" date)))))))
(encode-time 0 0 0
(- (nth 3 date-fields) offset)
(nth 4 date-fields)
(nth 5 date-fields)))))
(defun metrics-tracker--date-to-next-bin (date date-grouping)
"Advance to the bin following DATE.
This can be used to advance through the calendar stepping by DATE-GROUPING.
DATE [time] any date.
DATE-GROUPING [symbol] defines bin size.
Return [time] the start date of the next bin."
(if (eq date-grouping 'full)
'full
(let* ((date-fields (decode-time date))
(is-dst (nth 7 date-fields))
(next-date-fields date-fields)
next-date)
(pcase date-grouping
(`day (setcar (nthcdr 3 next-date-fields) (1+ (nth 3 next-date-fields))))
(`week (setcar (nthcdr 3 next-date-fields) (+ 7 (nth 3 next-date-fields))))
(`month (setcar (nthcdr 4 next-date-fields) (1+ (nth 4 next-date-fields))))
(`year (setcar (nthcdr 5 next-date-fields) (1+ (nth 5 next-date-fields)))))
(setq next-date (apply #'encode-time next-date-fields))
(setq next-date-fields (decode-time next-date))
;; suppress daylight savings shifts
(when (and (not is-dst)
(nth 7 next-date-fields))
(setq next-date (time-convert (time-subtract next-date (seconds-to-time 3600)))))
(when (and is-dst
(not (nth 7 next-date-fields)))
(setq next-date (time-convert (time-add next-date (seconds-to-time 3600)))))
;; return next-date
next-date)))
(defun metrics-tracker--val-to-bin (value existing-value value-transform)
"Merge a new VALUE into a bin.
VALUE [number] new value to add to the bin.
EXISTING-VALUE [number|cons|nil] current bin value.
VALUE-TRANSFORM [symbol] defines an operation to apply to bin values.
Return [number|cons] bin value after merging the new value."
(cond
((seq-contains-p '(count percent diff-count diff-percent accum-count) value-transform)
(1+ (or existing-value 0)))
((or (eq value-transform 'min)
(eq value-transform 'diff-min))
(if existing-value (min value existing-value) value))
((or (eq value-transform 'max)
(eq value-transform 'diff-max))
(if existing-value (max value existing-value) value))
((or (eq value-transform 'avg) ; for avg case, put (total . count) in bin
(eq value-transform 'diff-avg))
(setq existing-value (or existing-value '(0 . 0)))
(unless (consp value)
(setq value (cons value 1)))
(cons (+ (car value) (car existing-value))
(+ (cdr value) (cdr existing-value))))
(t
(+ value (or existing-value 0)))))
(defun metrics-tracker--date-bin-format (date-grouping)
"Get the format string for the the bin based on the DATE-GROUPING.
Return [string]."
(pcase date-grouping
(`day "%Y-%m-%d")
(`week "%Y-%m-%d")
(`month "%Y-%m")
(`year "%Y")))
(defun metrics-tracker--clip-duration (bin-start span first-date last-date)
"Clip the given duration if it falls outside of first and last dates.
The bin is the interval [BIN-START BIN-START+SPAN] (inclusive).
Intersect it with the interval [FIRST-DATE
LAST-DATE] (inclusive), and return the length of the result.
SPAN [number] number of days in the initial bin.
BIN-START [time] date at the start of the bin.
FIRST-DATE [time] clip the bin to start on this date.
LAST-DATE [time] clip the bin to end on this date.
Return [number] number of days in the clipped span."
(let ((bin-end (time-add bin-start (seconds-to-time (* span 86400)))))
(cond
((time-less-p bin-start first-date) ; bin starts before first occurrence
(float (max 0 (- (time-to-days bin-end)
(time-to-days first-date)))))
((time-less-p last-date bin-end) ; bin ends after last occurrence
(float (1+ (- (time-to-days last-date)
(time-to-days bin-start)))))
(t
(float span)))))
(defun metrics-tracker--days-of-month (date)
"Find the number of days in the month containing DATE.
This depends on `timezeone'.
DATE [time] any date."
(let ((date-fields (decode-time date)))
(timezone-last-day-of-month (nth 4 date-fields) (nth 5 date-fields))))
(defun metrics-tracker--bin-to-val (value
value-transform date-grouping
bin-date first-date last-date)
"Transform and format the bin VALUE into the value used in reporting.
VALUE [number|cons|nil] is usually a number but can be a cons
containing (total . count) if the VALUE-TRANSFORM is avg, or nil
for gaps.
VALUE-TRANSFORM [symbol] and DATE-GROUPING [symbol] are used to
transform the value.
BIN-DATE [time], FIRST-DATE [time], LAST-DATE [time
value] are needed to determine the number of days in the current
bin.
Return [number|nil] transformed value of the bin."
(let ((bin-duration (pcase date-grouping
(`day 1.0)
(`week (metrics-tracker--clip-duration bin-date 7 first-date last-date))
(`month (metrics-tracker--clip-duration bin-date (metrics-tracker--days-of-month bin-date) first-date last-date))
(`year (metrics-tracker--clip-duration bin-date 365 first-date last-date))
(`full (float (- (time-to-days last-date)
(time-to-days first-date)))))))
(cond
((null value)
value)
((seq-contains-p '(total min max count diff-total diff-min diff-max diff-count accum accum-count) value-transform)
value)
((or (eq value-transform 'avg)
(eq value-transform 'diff-avg))
(if (consp value)
(/ (car value) (float (cdr value)))
value))
((or (eq value-transform 'percent)
(eq value-transform 'diff-percent))
(* (/ value bin-duration) 100))
((or (eq value-transform 'per-day)
(eq value-transform 'diff-per-day))
(* value (/ 1 bin-duration)))
((or (eq value-transform 'per-week)
(eq value-transform 'diff-per-week))
(* value (/ 7 bin-duration)))
((or (eq value-transform 'per-month)
(eq value-transform 'diff-per-month))
(* value (/ 30 bin-duration)))
((or (eq value-transform 'per-year)
(eq value-transform 'diff-per-year))
(* value (/ 365 bin-duration))))))
(defun metrics-tracker--bin-metric-data (metric-names-str date-grouping value-transform start-date end-date &optional allow-gaps-p)
"Read the requested metric data from the diary.
METRIC-NAMES-STR [list string] keep entries for these metrics.
DATE-GROUPING [symbol] defines bin size.
VALUE-TRANSFORM [symbol] defines operations to perform on bin values.
START-DATE [time] date on which report should start.
END-DATE [time] date on which report should end, and when to end gap filling.
ALLOW-GAPS-P [boolean] If t, don't fill gaps.
Return the bin data as [hash symbol->[hash time->number]]."
(let* ((bin-data-all (make-hash-table :size 4)) ; [hash symbol->[hash time->number]] bin data for all metrics
(metric-names (mapcar ; [list symbol] chosen metrics
(lambda (name) (intern name metrics-tracker-metric-names))
metric-names-str))
(metric-names-with-deps (mapcar ; [list symbol] metric-names with dependencies inserted in front of metrics that depend on them
(lambda (name) (intern name metrics-tracker-metric-names))
(metrics-tracker--insert-base-metrics metric-names-str)))
date-bin ; [time] current date bin used by bin-action-fcn
existing-value ; [number] current value used by bin-action-fcn
bin-data ; [hash time->number] current bin data used by bin-action-fcn
effective-date-grouping ; [symbol] current date-grouping for binning
(bin-filter-fcn (lambda (_date name) ; [fcn] filters diary entries
(seq-contains-p metric-names-with-deps name)))
(bin-action-fcn (lambda (date name value) ; [fcn] puts values in appropriate bins
(setq bin-data (gethash name bin-data-all)
date-bin (metrics-tracker--date-to-bin date effective-date-grouping)
existing-value (gethash date-bin bin-data))
(puthash date-bin (metrics-tracker--val-to-bin value existing-value value-transform)
bin-data)))
(derived-metric-names (mapcar ; [list symbol] list of all derived metric names
(lambda (ii) (intern (car ii) metrics-tracker-metric-names))
metrics-tracker-derived-metrics)))
;; init bin-data-all hash
(dolist (name metric-names-with-deps)
(puthash name (make-hash-table :test 'equal) bin-data-all))
;; read the diary file, fill day bins for base metrics
(setq effective-date-grouping 'day)
(metrics-tracker--process-diary bin-filter-fcn bin-action-fcn start-date end-date)
(setq effective-date-grouping date-grouping) ; revert back to chosen `date-grouping'
;; compute derived metrics
(metrics-tracker--compute-derived-metrics (seq-filter (lambda (ii) (seq-contains-p derived-metric-names ii)) metric-names-with-deps)
bin-data-all value-transform)
(unless (eq date-grouping 'day)
(metrics-tracker--translate-bins metric-names bin-data-all bin-action-fcn))
;; prune base metrics
(seq-do (lambda (ii) (remhash ii bin-data-all))
(seq-difference metric-names-with-deps metric-names))
;; fill gaps and apply value transforms for base metrics, compute values for derived metrics
(dolist (metric-name metric-names)
(let* ((first-date (nth 2 (nth 0 (seq-filter ; [time] first date of metric data as a time value
(lambda (item) (eq (car item) metric-name)) metrics-tracker-metric-index))))
(first-date-bin (metrics-tracker--date-to-bin ; [time] date bin containing first date
first-date date-grouping))
(end-date-bin (metrics-tracker--date-to-bin end-date ; [time] date bin containing the `end-date'
date-grouping))
(bin-data (gethash metric-name bin-data-all))) ; [hash time->number]
(if (eq date-grouping 'full)
(puthash 'full
(metrics-tracker--bin-to-val (gethash 'full bin-data) value-transform date-grouping 'full first-date end-date)
bin-data)
(let* ((current-date-bin first-date-bin)
(last-value (metrics-tracker--bin-to-val ; the value from the last bin we visited
(gethash current-date-bin bin-data) value-transform date-grouping current-date-bin first-date end-date))
(total-value 0) ; the total so far if we're accumulating
current-value ; the value from the bin we're currently visiting
write-value) ; the value to write for the current bin
(while (or (time-less-p current-date-bin end-date-bin)
(equal current-date-bin end-date-bin))
(when (or (gethash current-date-bin bin-data)
(not allow-gaps-p))
(setq current-value (metrics-tracker--bin-to-val ; the value for the current bin
(gethash current-date-bin bin-data 0)
value-transform date-grouping current-date-bin first-date end-date))
(cond ((seq-contains-p '(diff-total diff-min diff-max diff-avg diff-count diff-percent
diff-per-day diff-per-week diff-per-month diff-per-year)
value-transform)
(setq write-value (- current-value last-value))) ; apply diff
((seq-contains-p '(accum accum-count) value-transform)
(setq total-value (+ total-value current-value)) ; compute and use total
(setq write-value total-value))
(t
(setq write-value current-value)))
(puthash current-date-bin write-value bin-data))
(setq last-value current-value ; save last value for diff
current-date-bin (metrics-tracker--date-to-next-bin current-date-bin date-grouping))))))) ; increment to next bin
bin-data-all))
(defun metrics-tracker--compute-derived-metrics (chosen-derived-metrics bin-data-all value-transform)
"Compute derived metrics and update bins.
CHOSEN-DERIVED-METRICS [list symbol] derived metrics included in report.
BIN-DATA-ALL [hash symbol->[hash time->number]] bin data for all metrics.
VALUE-TRANSFORM [symbol] defines an operation to perform on bin values."
(dolist (derived-metric-name chosen-derived-metrics)
(let* ((derived-metric (seq-find (lambda (ii) (string= (car ii) derived-metric-name)) metrics-tracker-derived-metrics))
;; merge dates across base metrics for this derived metric
(merged-dates (seq-reduce (lambda (dates bin-data) (append (hash-table-keys bin-data) dates))
(mapcar (lambda (base-metric-name)
(gethash (intern base-metric-name metrics-tracker-metric-names) bin-data-all))
(nth 1 derived-metric))
nil))
(merged-dates (delete-dups merged-dates))
bin-data val)
;; compute for each day
(setq bin-data (gethash derived-metric-name bin-data-all))
(dolist (date merged-dates)
(setq val (metrics-tracker--compute-val derived-metric-name date bin-data-all value-transform))
(unless (null val)
(puthash date val bin-data))))))
(defun metrics-tracker--translate-bins (metric-names bin-data-all bin-action-fcn)
"Replace day bins with chosen date-group bins.
METRIC-NAMES [list symbol] metrics that are part of this report.
BIN-DATA-ALL [hash symbol->[hash time->number]] bin data for all
metrics. Initially BIN-DATA-ALL should contain bin data with
`day' as `date-grouping'. This replaces those bin data hashes
with bin data hashes with the chosen `date-grouping'.
BIN-ACTION-FCN [fcn] puts values in appropriate bins."
(let (day-bin-data bin-data)
(dolist (metric-name metric-names)
(setq day-bin-data (gethash metric-name bin-data-all)
bin-data (make-hash-table :test 'equal))
(puthash metric-name bin-data bin-data-all)
(dolist (date (hash-table-keys day-bin-data))
(funcall bin-action-fcn date metric-name (gethash date day-bin-data))))))
(defun metrics-tracker--compute-val (metric-name date-bin bin-data-all value-transform)
"Return computed value for METRIC-NAME at DATE-BIN.
METRIC-NAME [symbol] the name of a derived metric.
DATE-BIN [time|'full] the date bin to compute.
BIN-DATA-ALL [hash symbol->[hash time->number]] bin data for all metrics.
VALUE-TRANSFORM [symbol] defines an operation to perform on bin values."
(let* ((derived-metric-def (seq-find (lambda (ii) (string= (car ii) metric-name)) metrics-tracker-derived-metrics))
(dep-metrics (mapcar (lambda (ii) (intern ii metrics-tracker-metric-names))
(nth 1 derived-metric-def)))
(expression (nth 2 derived-metric-def))
(dep-values (mapcar (lambda (ii)
(let ((value (gethash date-bin (gethash ii bin-data-all))))
(if (consp value)
(/ (car value) (float (cdr value)))
value)))
dep-metrics))
float-values value-str)
;; for count or percent just sum values, otherwise apply the expression
(if (or (seq-contains-p '(count percent diff-count diff-percent accum-count) value-transform)
(null expression))
(apply '+ (seq-remove #'null dep-values))
(setq float-values (mapcar ; convert values to math-floats for calc
(lambda (val) (math-float (list 'float (floor (* (or val 0) 10000)) -4)))
dep-values)
value-str (apply 'calc-eval (append (list expression "") float-values)))
(cond ((string-match "/ 0." value-str) nil)
(t (string-to-number value-str))))))
(defun metrics-tracker--setup-output-buffer ()
"Create and clear the output buffer."
(let ((buffer (get-buffer-create metrics-tracker-output-buffer-name)))
(set-buffer buffer)
(read-only-mode)
(let ((inhibit-read-only t))
(erase-buffer))))
(defun metrics-tracker--show-output-buffer ()
"Show the output buffer."
(let ((buffer (get-buffer metrics-tracker-output-buffer-name)))
(set-window-buffer (selected-window) buffer)))
(defun metrics-tracker--check-gnuplot-exists ()
"Signal an error if gnuplot is not installed on the system."
(unless (eq 0 (call-process-shell-command "gnuplot --version"))
(error "Cannot find gnuplot")))
(defun metrics-tracker--ask-for-metrics (multp)
"Prompt for metric names.
If MULTP [boolean] is false, only ask for one metric, else loop until
\"no more\" is chosen. Return the selected list of metric names."
(let* ((all-metric-names (mapcar #'car metrics-tracker-metric-index))
(last-metric-name (completing-read "Metric: " (metrics-tracker--presorted-options all-metric-names) nil t))
(metric-names (cons last-metric-name nil)))
(setq all-metric-names (cons "no more" all-metric-names))
(while (and (not (string= last-metric-name "no more"))
multp)
(setq all-metric-names (seq-remove (lambda (elt) (string= elt last-metric-name)) all-metric-names)
last-metric-name (completing-read "Metric: " (metrics-tracker--presorted-options all-metric-names) nil t))
(if (not (string= last-metric-name "no more"))
(setq metric-names (cons last-metric-name metric-names))))
(nreverse metric-names)))
(defun metrics-tracker--ask-for-date (prompt)
"Display the PROMPT, return the response or nil if no response given.
PROMPT [string] prompt to show the user when asking for the start
date or end date."
(let ((date-str (read-string prompt)))
(if (string= "" date-str) nil date-str)))
;;;###autoload
(defun metrics-tracker-table (arg)
"Interactive way to get a tabular view of the requested metric.
This function gets user input and then delegates to
`metrics-tracker-table-render'.
ARG is optional, but if given and it is the default argument,
allow selection of multiple metrics and date ranges."
(interactive "P")
;; make sure `metrics-tracker-metric-index' has been populated
(metrics-tracker--load-index)
(let* ((ivy-sort-functions-alist nil)
;; ask for params
(extrap (equal arg '(4)))
(metric-names-str (metrics-tracker--ask-for-metrics extrap))
(date-grouping (intern (completing-read "Group dates by: " (metrics-tracker--presorted-options
(metrics-tracker--date-grouping-options))
nil t nil nil "month")))
(value-transform (intern (completing-read "Value transform: " (metrics-tracker--presorted-options
(metrics-tracker--value-transform-options date-grouping))
nil t nil nil "total")))
(start-date (and extrap (metrics-tracker--ask-for-date "Start date (optional): ")))
(end-date (and extrap (metrics-tracker--ask-for-date "End date (optional): "))))
(metrics-tracker-table-render (list metric-names-str date-grouping value-transform
start-date end-date))))
;;;###autoload
(defun metrics-tracker-table-render (table-config)
"Programmatic way to get a tabular view of the requested metric.
TABLE-CONFIG [list] should contain all inputs needed to render a table.
1. [list string] metric names.
2. [symbol] date grouping.
3. [symbol] value transform.
4. [date string] (optional) ignore occurrences before.
5. [date string] (optional) ignore occurrences after.
Date strings can be in any format `parse-time-string' can use.
For example:
'((\"metricname\") year total nil nil)"
;; make sure `metrics-tracker-metric-index' has been populated
(metrics-tracker--load-index)
(let* ((today (metrics-tracker--string-to-time))
(all-metric-names ; [list symbol] all metric names
(mapcar #'car metrics-tracker-metric-index))
(metric-names-str (nth 0 table-config)) ; [list string] chosen metric names
(metric-names ; [list symbol] chosen metric names
(mapcar (lambda (name) (intern name metrics-tracker-metric-names)) metric-names-str))
(date-grouping (nth 1 table-config)) ; [symbol] chosen date grouping
(value-transform (nth 2 table-config)) ; [symbol] chosen value transform as a symbol
(start-date (and (nth 3 table-config) ; [time] chosen start date as a time value
(metrics-tracker--string-to-time (nth 3 table-config))))
(end-date (and (nth 4 table-config) ; [time] chosen start date as a time value
(metrics-tracker--string-to-time (nth 4 table-config))))
bin-data-all) ; [hash symbol->[hash time->number]] bin data for all metrics
;; validate inputs
(dolist (metric metric-names t)
(metrics-tracker--validate-input "metric" metric all-metric-names))
(metrics-tracker--validate-input "date-grouping" date-grouping (metrics-tracker--date-grouping-options))
(metrics-tracker--validate-input "value-transform" value-transform (metrics-tracker--value-transform-options date-grouping))
(unless (or (null start-date) (null end-date) (time-less-p start-date end-date))
(error "The end date is before the start date"))
;; save the config
(setq metrics-tracker-last-report-config (cons 'table table-config))
;; load metric data into bins; hash containing `bin-data' for each metric in `metric-names' plus any needed base metrics
(setq bin-data-all (metrics-tracker--bin-metric-data metric-names-str date-grouping value-transform
start-date (if (time-less-p today end-date) today end-date)))
(if (and (eq date-grouping 'full)
(= 1 (length metric-names)))
;; if there's only one value to print, just write it to the status line
(message "Overall %s %s: %s"
(car metric-names)
(replace-regexp-in-string "-" " " (symbol-name value-transform))
(metrics-tracker--format-value (gethash 'full (car (hash-table-values bin-data-all))) ""))
;; otherwise write a table
(metrics-tracker--setup-output-buffer)
(tabulated-list-mode)
;; set table headers
(setq tabulated-list-format
(vconcat (list (list (symbol-name date-grouping) 12 t))
(let ((labels (metrics-tracker--choose-labels metric-names-str value-transform))
headers)
(dotimes (ii (length labels))
(setq headers (cons
(list (nth ii labels)
(max 10 (+ 3 (length (nth ii labels))))
(metrics-tracker--num-sort (1+ ii)))
headers)))
(nreverse headers))))
;; configure
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons (symbol-name date-grouping) nil))
;; compute and set table data
(setq-local tabulated-list-entries (metrics-tracker--format-data metric-names bin-data-all
date-grouping start-date end-date nil))
;; render the table
(let ((inhibit-read-only t))
(tabulated-list-init-header)
(tabulated-list-print nil nil))
(metrics-tracker--show-output-buffer))))