chronometrist/cl/chronometrist.org

# -*- mode: poly-org; -*-
#+TITLE: Chronometrist
#+SUBTITLE: A friendly and powerful personal time tracker and analyzer
#+DESCRIPTION: Common Lisp implementation
#+AUTHOR: contrapunctus
#+TODO: TODO TEST WIP EXTEND CLEANUP FIXME HACK REVIEW |
#+PROPERTY: header-args :tangle yes :comments link

* Introduction
:PROPERTIES:
:CUSTOM_ID: introduction
:END:
This is a book about Chronometrist, a time tracker for Emacs, written by a humble hobbyist hacker. It also happens to contain the canonical copy of the source code, and can be loaded as an Emacs Lisp program using the =literate-elisp= library.

I hope this book—when completed—passes Tim Daly's [[https://www.youtube.com/watch?v=Av0PQDVTP4A&t=8m52s]["Hawaii Test"]], in which a programmer with no knowledge of this program whatsover can read this book end-to-end, and come out as much of an expert in its maintenance as the original author.

—contrapunctus

* Explanation
:PROPERTIES:
:DESCRIPTION: The design, the implementation, and a little history
:CUSTOM_ID: explanation
:END:
** Why I wrote Chronometrist
:PROPERTIES:
:CUSTOM_ID: why-i-wrote-chronometrist
:END:
It probably started off with a desire for introspection and self-awareness - what did I do all day? How much time have I spent doing X? It is also a tool to help me stay focused on a single task at a time, and to not go overboard and work on something for 7 hours straight.

At first I tried an Android application, "A Time Tracker". The designs of Chronometrist's main buffer and the =report= buffer still resemble that of A Time Tracker. However, every now and then I'd forget to start or stop tracking. Each time I did, I had to open an SQLite database and edit UNIX timestamps to correct it, which was not fun :\

Later, I discovered John Wiegley's =timeclock=. It turned out that since it was an Emacs extension (actually, a part of Emacs), I was more likely to use it. Chronometrist started out as an "A Time Tracker"-like UI for =timeclock=, moving to an s-expression backend later.

Quite recently, after around two years of Chronometrist developement and use, I discovered that Org mode has a time tracking feature, too. Even though I've embraced some of [[#explanation-literate-programming][the joys of Org]], I'm not quite at ease with the idea of storing data in a complex text format with only one complete implementation.

** Design goals
:PROPERTIES:
:DESCRIPTION: Some vague objectives which guided the project
:CUSTOM_ID: design-goals
:END:
1. Don't make assumptions about the user's profession
   - e.g. timeclock seems to assume you're using it for a 9-to-5/contractor job
2. Incentivize use
   * Hooks allow the time tracker to automate tasks and become a useful part of your workflow
3. Make it easy to edit data using existing, familiar tools
   * We don't use an SQL database, where changing a single field is tricky [fn:1]
   * We use a text file containing s-expressions (easy for humans to read and write)
   * We use ISO-8601 for timestamps (easy for humans to read and write) rather than UNIX epoch time
4. Reduce human errors in tracking
5. Have a useful, informative, interactive interface
6. Support mouse and keyboard use equally

[fn:1] I still have doubts about this. Having SQL as a query language would be very useful in perusing the stored data. Maybe we should have tried to create a companion mode to edit SQL databases interactively?

** Terminology
:PROPERTIES:
:DESCRIPTION: Explanation of some terms used later
:CUSTOM_ID: terminology
:END:
Chronometrist records /time intervals/ (earlier called "events") as plists. Each plist contains at least a =:name "<name>"=, a =:start "<iso-timestamp>"=, and (except in case of an ongoing task) a =:stop "<iso-timestamp>"=.

+ row :: a row of a table in a =tabulated-list-mode= buffer; an element of =tabulated-list-entries=.
+ schema :: the column descriptor of a table in a =tabulated-list-mode= buffer; the value of =tabulated-list-format=.

See also [[#explanation-time-formats][Currently-Used Time Formats]]

** Overview
:PROPERTIES:
:CUSTOM_ID: overview
:END:
At its most basic, we read data from a [[#program-backend][backend]], store it in a [[#program-data-structures][hash table]], and [[#program-frontend-chronometrist][display it]] as a [[elisp:(find-library "tabulated-list-mode")][=tabulated-list-mode=]] buffer. When the file is changed—whether by the program or the user—we [[refresh-file][update the hash table]] and the [[#program-frontend-chronometrist-refresh][buffer]].

In addition, we implement a [[#program-pretty-printer][plist pretty-printer]] and some [[#program-migration][migration commands]].

Extensions exist for -
1. [[file:chronometrist-key-values.org][attaching arbitrary metadata]] to time intervals, and
2. support for the [[file:chronometrist-third.org][Third Time system]]
3. [[https://tildegit.org/contrapunctus/chronometrist-goal][time goals and alerts]]

** Optimization
:PROPERTIES:
:CUSTOM_ID: optimization
:END:
It is of great importance that Chronometrist be responsive -
+ A responsive program is more likely to be used; recall our design goal of 'incentivizing use'.
+ Being an Emacs program, freezing the UI for any human-noticeable length of time is unacceptable - it prevents the user from working on anything in their environment.
Thus, I have considered various optimization strategies, and so far implemented two.

*** Prevent excess creation of file watchers
:PROPERTIES:
:CUSTOM_ID: prevent-excess-creation-of-file-watchers
:END:
One of the earliest 'optimizations' of great importance turned out to simply be a bug - turns out, if you run an identical call to [[elisp:(describe-function 'file-notify-add-watch)][=file-notify-add-watch=]] twice, you create /two/ file watchers and your callback will be called /twice./ We were creating a file watcher /each time the =chronometrist= command was run./ 🤦 This was causing humongous slowdowns each time the file changed. 😅
+ It was fixed in v0.2.2 by making the watch creation conditional, using =-fs-watch= to store the watch object.

*** Preserve hash table state for some commands
:PROPERTIES:
:CUSTOM_ID: preserve-hash-table-state-some-commands
:END:
NOTE - this has been replaced with a more general optimization - see next section.

The next one was released in v0.5. Till then, any time the [[* chronometrist-file][=file=]] was modified, we'd clear the =events= hash table and read data into it again. The reading itself is nearly-instant, even with ~2 years' worth of data [fn:2] (it uses Emacs' [[elisp:(describe-function 'read)][=read=]], after all), but the splitting of [[#explanation-midnight-spanning-intervals][midnight-spanning events]] is the real performance killer.

After the optimization...
1. Two backend functions (=sexp-new= and =sexp-replace-last=) were modified to set a flag (=-inhibit-read-p=) before saving the file.
2. If this flag is non-nil, [[* refresh-file][=refresh-file=]] skips the expensive calls to =events-populate=, =tasks-from-table=, and =tags-history-populate=, and resets the flag.
3. Instead, the aforementioned backend functions modify the relevant variables - =events=, =task-list=, and =tags-history= - via...
   * =events-add= / =events-replace-last=
   * =task-list-add=, and
   * =tags-history-add= / =tags-history-replace-last=, respectively.

There are still some operations which [[* refresh-file][=refresh-file=]] runs unconditionally - which is to say there is scope for further optimization, if or when required.

[fn:2] As indicated by exploratory work in the =parsimonious-reading= branch, where I made a loop to only =read= and collect s-expressions from the file. It was near-instant...until I added event splitting to it.

*** Determine type of change made to file
:PROPERTIES:
:CUSTOM_ID: determine-type-of-change-made-to-file
:END:
Most changes, whether made through user-editing or by Chronometrist commands, happen at the end of the file. We try to detect the kind of change made - whether the last expression was modified, removed, or whether a new expression was added to the end - and make the corresponding change to =events=, instead of doing a full parse again (=events-populate=). The increase in responsiveness has been significant.

When =refresh-file= is run by the file system watcher, it uses =file-hash= to assign indices and a hash to =-file-state=. The next time the file changes, =file-change-type= compares this state to the current state of the file to determine the type of change made.

Challenges -
1. Correctly detecting the type of change
2. Updating =task-list= and the Chronometrist buffer, when a new task is added or the last interval for a task is removed (v0.6.4)
3. Handling changes made to an active interval after midnight
   * use the date from the plist's =:start= timestamp instead of the date today
   * =:append= - normally, add to table; for spanning intervals, invalid operation
   * =:modify= - normally, replace in table; for spanning intervals, split and replace
   * =:remove= - normally, remove from table; for spanning intervals, split and remove

Effects on the task list
1. When a plist is added, the =:name= might be new, in which case we need to add it to the task list.
2. When the last plist is modified, the =:name= may have changed -
   1. the =:name= might be new and require addition to the task list.
   2. the old plist may have been the only plist for the old =:name=, so we need to check if there are any other plists with the old =:name=. If there are none, the old =:name= needs to be removed from the task list.
3. When the last plist is removed, it may have been the only plist for the old =:name=, so we need to check if there are any other plists with the old =:name=. If there are none, the old =:name= needs to be removed from the task list.

** Midnight-spanning intervals
:PROPERTIES:
:DESCRIPTION: Events starting on one day and ending on another
:CUSTOM_ID: midnight-spanning-intervals
:END:
A unique problem in working with Chronometrist, one I had never foreseen, was tasks which start on one day and end on another. For instance, you start working on something at =2021-01-01 23:00= hours and stop on =2021-01-02 01:00=.

These mess up data consumption in all sorts of unforeseen ways, especially interval calculations and acquiring intervals for a specific date. In case of two of the most common operations throughout the program -
1. finding the intervals recorded on a given date
2. finding the time spent on a task on a given day - if the day's intervals used for this contain a midnight-spanning interval, you'll have inaccurate results - it will include yesterday's time from the interval as well as today's.

There are a few different approaches of dealing with them. (Currently, Chronometrist uses #3.)

*** Check the code of the first event of the day (timeclock format)
:PROPERTIES:
:DESCRIPTION: When the code of the first event in the day is "o", it's a midnight-spanning event.
:CUSTOM_ID: check-code-of-first-event-of-day
:END:
+ Advantage - very simple to detect
+ Disadvantage - "in" and "out" events must be represented separately

*** Split them at the file level
:PROPERTIES:
:CUSTOM_ID: split-in-file
:END:
+ Advantage - operation is performed only once for each such event + simpler data-consuming code + reduced post-parsing load.
+ What happens when the user changes their day-start-time? The split-up events are now split wrongly, and the second event may get split /again./

Possible solutions -
1. Add function to check if, for two events A and B, the =:stop= of A is the same as the =:start= of B, and that all their other tags are identical. Then we can re-split them according to the new day-start-time.
   + Implemented as [[#program-data-structures-plists-split-p][plist-split-p]]
2. Add a =:split= tag to split events. It can denote that the next event was originally a part of this one.
3. Re-check and update the file when the day-start-time changes.
   - Possible with ~add-variable-watcher~ or ~:custom-set~ in Customize (thanks bpalmer)

This strategy is implemented in the [[#program-backend-plist-group][plist-group]] backend. Custom day-start time is not yet implemented - if ever implemented, it will probably require exporting the file, with all split intervals being combined and re-split.

*** Split them at the hash-table-level
:PROPERTIES:
:CUSTOM_ID: split-in-hash-table
:END:
Handled by ~sexp-events-populate~
+ Advantage - simpler data-consuming code.

*** Split them at the data-consumer level (e.g. when calculating time for one day/getting events for one day)
:PROPERTIES:
:CUSTOM_ID: split-at-data-consumer-level
:END:
+ Advantage - reduced repetitive post-parsing load.

** Point restore behaviour
:PROPERTIES:
:DESCRIPTION: The desired behaviour of point in Chronometrist
:CUSTOM_ID: point-restore-behaviour
:END:
After hacking, always test for and ensure the following -
1. Toggling the buffer via [[#program-frontend-chronometrist-command][chronometrist]]/[[#program-frontend-report-command][report]]/[[#program-frontend-statistics-command][statistics]] should preserve point
2. The timer function should preserve point when the buffer is current
3. The timer function should preserve point when the buffer is not current, but is visible in another window
4. The next/previous week keys and buttons should preserve point.

** report date range logic
:PROPERTIES:
:DESCRIPTION: Deriving dates in the current week
:CUSTOM_ID: report-date-range-logic
:END:
A quick description, starting from the first time [[#program-frontend-report-command][report]] is run in an Emacs session -
1. We get the current date as a =ts= struct, using date.
2. The variable =week-start-day= stores the day we consider the week to start with. The default is "Sunday".

   We check if the date from #2 is on the week start day, else decrement it till we are, using =(previous-week-start)=.
3. We store the date from #3 in the global variable =-ui-date=.
4. By counting up from =-ui-date=, we get dates for the days in the next 7 days using =(date->dates-in-week)=. We store them in =-ui-week-dates=.

   The dates in =-ui-week-dates= are what is finally used to query the data displayed in the buffer.
5. To get data for the previous/next weeks, we decrement/increment the date in =-ui-date= by 7 days and repeat the above process (via =(previous-week)= / =(next-week)=).

** Literate programming
:PROPERTIES:
:CUSTOM_ID: literate-programming
:END:
The shift from a bunch of Elisp files to a single Org literate program was born out of frustration with programs stored as text files, which are expensive to restructure (especially in the presence of a VCS). While some dissatisfactions remain, I generally prefer the outcome - tree and source-block folding, tags, properties, and =org-match= have made it trivial to get different views of the program, and literate programming may allow me to express the "explanation" documentation in the same context as the program, without having to try to link between documentation and source.

*** Tangling
:PROPERTIES:
:CUSTOM_ID: tangling
:END:
At first, I tried tangling. Back when I used =benchmark.el= to test it, =org-babel-tangle= took about 30 seconds to tangle this file. Thus, I wrote a little sed one-liner (in the file-local variables) to do the tangling, which was nearly instant. It emitted anything between lines matching the exact strings ="#+BEGIN_SRC lisp"= and ="#+END_SRC"= -

#+BEGIN_SRC org :tangle no
# eval: (progn (make-local-variable 'after-save-hook) (add-hook 'after-save-hook (lambda () (start-process-shell-command "sed-tangle" "sed-tangle" "sed -n -e '/#+BEGIN_SRC lisp$/,/#+END_SRC$/{//!p;};/#+END_SRC/i\\ ' chronometrist.org | sed -E 's/^ +$//' > chronometrist.el"))))
#+END_SRC

*** literate-elisp-load
:PROPERTIES:
:CUSTOM_ID: literate-elisp-load
:END:
Later, we switched from tangling to using the =literate-elisp= package to loading this Org file directly - a file =chronometrist.el= would be used to load =chronometrist.org=.

#+BEGIN_SRC lisp :tangle no :load no
(literate-elisp-load
 (format "%schronometrist.org" (file-name-directory load-file-name)))
#+END_SRC

This way, source links (e.g. help buffers, stack traces) would lead to this Org file, and this documentation was available to each user, within the comfort of their Emacs. The presence of the =.el= file meant that users of =use-package= did not need to make any changes to their configuration.

*** Reject modernity, return to tangling
:PROPERTIES:
:CUSTOM_ID: reject-modernity,-return-to-tangling
:END:
For all its benefits, the previous approach broke autoloads and no sane way could be devised to make them work, so back we came to tangling. =org-babel-tangle-file= seems to be quicker when run as a Git pre-commit hook - a few seconds' delay before I write a commit message.

Certain tools like =checkdoc= remain a pain to use with any kind of literate program. This will probably continue to be the case until these tools are fixed or extended.

*** Definition metadata
:PROPERTIES:
:CUSTOM_ID: definition-metadata
:END:
Each definition has its own heading. The type of definition is stored in tags -
1. custom group
2. [custom|hook|internal] variable
3. keymap (use variable instead?)
4. macro
5. function
   * does not refer to external state
   * primarily used for the return value
6. reader
   * reads external state without modifying it
   * primarily used for the return value
7. writer
   * modifies external state, namely a data structure or file
   * primarily used for side-effects
8. procedure
   * any other impure function
   * usually affects the display
   * primarily used for side-effects
9. major/minor mode
10. command

Further details are stored in properties -
1. :INPUT: (for functions)
2. :VALUE: list|hash table|...
   * for functions, this is the return value
3. :STATE: <external file or data structure read or written to>

*** TODO Issues [40%]
:PROPERTIES:
:CUSTOM_ID: issues
:END:
1. [X] When opening this file, Emacs may freeze at the prompt for file-local variable values; if so, C-g will quit the prompt, and permanently marking them as safe will make the freezing stop. [fn:3]
2. [ ] I like =visual-fill-column-mode= for natural language, but I don't want it applied to code blocks. =polymode.el= may hold answers.
3. [X] Is there a tangling solution which requires only one command (e.g. currently we use two =sed= s) but is equally fast? [fn:3]
   * Perhaps we can get rid of the requirement of adding newlines after each source block, and add the newlines ourselves. That gives us control, and also makes it possible to insert Org text in the middle of a definition without unnecessary newlines.
4. [ ] =nameless-insert-name= does not work in source blocks.
5. [ ] Some source blocks don't get syntax highlighted.
   * A workaround is to press =M-o M-o=

[fn:3] No longer a problem since we switched to =literate-elisp=

** Currently-Used Time Formats
:PROPERTIES:
:CUSTOM_ID: currently-used-time-formats
:END:

*** ts
:PROPERTIES:
:CUSTOM_ID: ts
:END:
  ts.el struct
  * Used by nearly all internal functions

*** iso-timestamp
:PROPERTIES:
:CUSTOM_ID: iso-timestamp
:END:
 ="YYYY-MM-DDTHH:MM:SSZ"=
  * Used in the s-expression file format
  * Read by sexp-events-populate
  * Used in the plists in the events hash table values

*** iso-date
:PROPERTIES:
:CUSTOM_ID: iso-date
:END:
 ="YYYY-MM-DD"=
  * Used as hash table keys in events - can't use ts structs for keys, you'd have to make a hash table predicate which uses ts=

*** seconds
:PROPERTIES:
:CUSTOM_ID: seconds
:END:
  integer seconds as duration
  * Used for most durations
  * May be changed to floating point to allow larger durations. The minimum range of =most-positive-fixnum= is 536870911, which seems to be enough to represent durations of 17 years.
  * Used for update intervals (update-interval, change-update-interval)

*** minutes
:PROPERTIES:
:CUSTOM_ID: minutes
:END:
  integer minutes as duration
  * Used by [[https://tildegit.org/contrapunctus/chronometrist-goal][goal]] (goals-list, get-goal) - minutes seems like the ideal unit for users to enter

*** list-duration
:PROPERTIES:
:CUSTOM_ID: list-duration
:END:
 =(hours minute seconds)=
  * Only returned by =seconds-to-hms=, called by =format-time=

** Backend protocol
:PROPERTIES:
:CREATED:  2022-01-05T19:00:12+0530
:CUSTOM_ID: backend-protocol
:END:
The protocol as of now, with remarks -
1. =backend-run-assertions (backend)=
2. =view-backend (backend)=
3. =edit-backend (backend)= - these two would make sense if there was only one way to view/edit a backend. But if we want [[file:TODO.org::#viewing-editing-frontends][viewing/editing frontends]], there would be many.
4. =backend-empty-p (backend)=
5. =backend-modified-p (backend)=
6. =create-file (backend &optional file)=
7. =latest-date-records (backend)=
8. =insert (backend plist)=
9. =remove-last (backend)=
10. =latest-record (backend)=
11. =task-records-for-date (backend task date-ts)=
12. =replace-last (backend plist)=
13. =to-file (input-hash-table output-backend output-file)=
14. =on-add (backend)=
15. =on-modify (backend)=
16. =on-remove (backend)=
17. =on-change (backend)=
18. =verify (backend)=
19. =reset-backend (backend)= - probably rename to "initialize"
20. =memory-layer-empty-p (backend)= - needs a more generic name; perhaps "initialized-p", to go with #20
21. =to-hash-table (backend)=
22. =to-list (backend)=

There are many operations which are file-oriented, whereas I have tried to treat files as implementation details. =create-file=, for instance, is used by =to-file=; I could make creation of files implicit by moving it into =initialize-instance=, but that would mean creation of files in =to-file= would require creation of a backend object. That seems to me to be an abuse of implicit behaviour; and what would backends which are not file-backed do in =to-file=, then? There's probably a way to do it, but I had other things I preferred to tackle first.

** generic loop interface for iterating over records
:PROPERTIES:
:CUSTOM_ID: generic-loop-interface-iterating-over-records
:END:
Of all the ways to work with Chronometrist data, both as part of the program and as part of my occasional "queries", my favorite was to use =cl-loop=.

First, there was the =loop-file= macro, which handled the sole backend at that time - the plist backend. It took care of the common logic (=read= ing each plist in the file, checking loop termination conditions), and let the client code specify (with the terseness of =cl-loop=) what they wanted to do with the data.

During the migration to the CLOS-based backend design began the quest to make =loop-file= work with generic backends - it eventually became =loop-records= and =loop-days=. The idea was to call a generic function (=record-iterator= and =day-iterator=) which would return a new record on each call. Internal state of each of these generic functions was stored in backend slots. No list would be built up, unless the client code specified an accumulation clause.

Most recently, gilberth of #lispcafe suggested an alternate approach - trying to build a list of records first, and using =cl-loop= (or any other iteration mechanism) on that. Testing the two approaches yielded a clear advantage for this new suggestion. The test was to generate key-values suitable for completion history from my full Chronometrist data to date (the plist backend had ~6.6k plists in a 1.2M file), using almost identical =cl-loop= client code for both cases. Here was the output from =(benchmark 1 ...)= -

| approach | backend     | benchmark output                                 |
|----------+-------------+--------------------------------------------------|
| current  | plist       | "Elapsed time: 5.322056s (0.709023s in 4 GCs)"   |
| current  | plist-group | "Elapsed time: 107.159170s (1.064125s in 6 GCs)" |
| new      | plist       | "Elapsed time: 0.559264s (0.172344s in 1 GCs)"   |
| new      | plist-group | "Elapsed time: 0.671106s (0.179435s in 1 GCs)"   |

In addition, with this approach, client code can use any kind of iteration constructs they fancy - not just =cl-loop= but also =dolist=, higher-order functions (including those from =dash= and =seq=), =loopy=, etc.

The macro still exists in its non-generic form as =loop-sexp-file=, providing a common way to loop over s-expressions in a text file, used by =to-list= in both backends and =to-hash-table= in the plist group backend.

* How-to guides for maintainers
:PROPERTIES:
:CUSTOM_ID: how-to-guides-maintainers
:END:
** How to set up Emacs to contribute
:PROPERTIES:
:CUSTOM_ID: how-to-set-up-emacs-to-contribute
:END:
# Different approaches to this setup -
# 1. Document it and let contributors do it voluntarily.
#    * Downside - if a contributor does not do it, it can lead to inconsistency and an additional headache for the maintainer.
# 2. Put it in file variables and/or =.dir-locals.el=.
#    * Downside - if the contributor does not have a dependency installed (e.g. nameless), Emacs will create an error. That's not the UX I want for someone opening the file for the first time - it does not tell them that they need to install something.
#      + Technically, a friendlier error message could be displayed. But you want to read/edit a document and it asks you to install something first...kind of a flow breaker.
# 3. Use a tool which installs developement dependencies for you, e.g. Cask, Eldev.
#    * May look into this in the future. But as of now I don't even foresee any contributors 😓

1. Install [[https://github.com/Malabarba/Nameless][nameless-mode]] for easier reading of Emacs Lisp code, and [[https://github.com/jingtaozf/literate-elisp][literate-elisp]] to load this file directly without tangling.

   #+BEGIN_SRC lisp :tangle no :load no
     (mapcar #'package-install '(nameless literate-elisp))
   #+END_SRC

2. Create a =.dir-locals-2.el= in the project root, containing -

      #+BEGIN_SRC lisp :tangle no :load no
        ((org-mode
          .
          ((eval . (nameless-mode))
           (eval . (progn
             (make-local-variable 'after-save-hook)
             ;; you can't `defun' in one `eval' and use the
             ;; function in another `eval', apparently
             (add-hook
              'after-save-hook
              (defun tangle ()
                (interactive)
                (compile
                 (mapconcat #'shell-quote-argument
                            `("emacs" "-q" "-Q" "--batch"
                              "--eval=(require 'ob-tangle)"
                              ,(format "--eval=(org-babel-tangle-file \"%s\")"
                                       (buffer-file-name)))
                            " ")))))))))
      #+END_SRC

3. Set up compiling, linting, and testing with =makem.sh=. First, define this command -

   #+BEGIN_SRC lisp :tangle no :load no
   (defun run-makem ()
     (interactive)
     (cd (locate-dominating-file default-directory "makem.sh"))
     (compile "./makem.sh compile lint test-ert"))
   #+END_SRC

   Then, run it after staging the files -
   #+BEGIN_SRC lisp :tangle no :load no
   (add-hook 'magit-post-stage-hook #'run-makem)
   #+END_SRC

   Or after tangling ends -
   #+BEGIN_SRC lisp :tangle no :load no
     (add-hook 'org-babel-post-tangle-hook #'run-makem)
   #+END_SRC

** How to tangle this file
:PROPERTIES:
:CUSTOM_ID: how-to-tangle-this-file
:END:
Use =org-babel= (=org-babel-tangle= / =org-babel-tangle-file=), /not/ =literate-elisp-tangle=. The file emitted by the latter does not contain comments - thus, it does not contain library headers or abide by =checkdoc='s comment conventions.

* The Program
:PROPERTIES:
:CUSTOM_ID: program
:END:
** chronometrist                                                   :package:
:PROPERTIES:
:CUSTOM_ID: chronometrist
:END:
#+BEGIN_SRC lisp
(in-package :cl)
(defpackage :chronometrist
  (:use :cl :trivia)
  (:import-from :uiop
   :xdg-config-home :xdg-data-home
   :strcat :split-string)
  (:import-from :local-time
   :parse-timestring :now :today :timestamp-to-unix :adjust-timestamp
   :timestamp< :format-timestring)
  (:export
   ;; customizable variables
   :*user-configuration-file* :*user-data-file*
   :*day-start-time* :*week-start-day*
   :*weekday-number-alist* :*active-backend*
   :*sexp-pretty-print-function* :*task-list*
   :*sqlite-properties-function*
   ;; classes
   :backend
   :day :date :intervals :events :properties
   :interval :name :interval-start :interval-stop
   :event :event-time
   ;; protocol
   :*backends-alist* :active-backend :register-backend
   :backend-file
   :task-list
   :view-backend :edit-backend
   :backend-empty-p :backend-modified-p
   :backend-run-assertions
   :create-file
   :get-day :insert-day :remove-day
   :on-change :on-add :on-modify :on-remove
   :to-file :to-hash-table :to-list :list-tasks
   :active-days :count-records
   :file-backend-mixin :elisp-sexp-backend
   ;; extended protocol
   :remove-last :replace-last
   :latest-record :task-records-for-date :latest-date-records
   ;; helpers
   :make-hash-table-1 :split-plist :iso-to-date :plist-key-values
   :task-duration-one-day
   ;; debugging
   :*debug-enable*
   :*debug-buffer*))
(in-package :chronometrist)
#+END_SRC

** Common definitions
:PROPERTIES:
:CUSTOM_ID: common-definitions
:END:
*** create XDG directories
:PROPERTIES:
:CUSTOM_ID: create-xdg-directories
:END:
#+BEGIN_SRC lisp
(defvar *xdg-config-dir*
  (merge-pathnames "chronometrist/" (uiop:xdg-config-home)))
(defvar *xdg-data-dir*
  (merge-pathnames "chronometrist/" (uiop:xdg-data-home)))
(mapcar #'ensure-directories-exist
        (list *xdg-config-dir* *xdg-data-dir*))
#+END_SRC

*** *user-configuration-file*                             :custom:variable:
:PROPERTIES:
:CUSTOM_ID: user-configuration-file
:END:
#+BEGIN_SRC lisp
(defvar *user-configuration-file*
  (merge-pathnames "config.lisp" *xdg-config-dir*))
#+END_SRC

*** *user-data-file*                                      :custom:variable:
:PROPERTIES:
:CUSTOM_ID: user-data-file
:END:
#+BEGIN_SRC lisp
(defvar *user-data-file* (merge-pathnames "chronometrist" *xdg-data-dir*)
  "Absolute path and file name (without extension) for the Chronometrist database.")
#+END_SRC

*** make-hash-table-1                                            :function:
:PROPERTIES:
:CUSTOM_ID: make-hash-table-1
:END:
#+BEGIN_SRC lisp
(defun make-hash-table-1 ()
  "Return an empty hash table with `equal' as test."
  (make-hash-table :test #'equal))
#+END_SRC

*** *day-start-time*                                      :custom:variable:
:PROPERTIES:
:CUSTOM_ID: day-start-time
:END:
=chronometrist-events-maybe-split= refers to this, but I'm not sure this has the desired effect at the moment—haven't even tried using it.
#+BEGIN_SRC lisp
(defvar *day-start-time* "00:00:00"
  "The time at which a day is considered to start, in \"HH:MM:SS\".

The default is midnight, i.e. \"00:00:00\".")
#+END_SRC

*** plist-remove                                                 :function:
:PROPERTIES:
:CUSTOM_ID: plist-remove
:END:
#+BEGIN_SRC lisp
(defun plist-remove (plist &rest keys)
  "Return PLIST with KEYS and their associated values removed."
  (loop for key in keys do (remf plist key))
  plist)
#+END_SRC

**** tests
:PROPERTIES:
:CUSTOM_ID: tests
:END:
#+BEGIN_SRC lisp :tangle chronometrist-tests.el :load test
(ert-deftest plist-remove ()
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :a)
          '(:b 2 :c 3 :d 4)))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :b)
          '(:a 1 :c 3 :d 4)))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :c)
          '(:a 1 :b 2 :d 4)))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :d)
          '(:a 1 :b 2 :c 3)))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :a :b)
          '(:c 3 :d 4)))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :a :d)
          '(:b 2 :c 3)))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :c :d)
          '(:a 1 :b 2)))
  (should (equal
           (plist-remove '(:a 1 :b 2 :c 3 :d 4) :a :b :c :d)
           nil))
  (should
   (equal (plist-remove '(:a 1 :b 2 :c 3 :d 4) :d :a)
          '(:b 2 :c 3))))

#+END_SRC

*** plist-key-values                                             :function:
:PROPERTIES:
:CUSTOM_ID: plist-key-values
:END:
#+BEGIN_SRC lisp
(defun plist-key-values (plist)
  "Return user key-values from PLIST."
  (plist-remove plist :name :tags :start :stop))
#+END_SRC

*** plist-p                                                      :function:
:PROPERTIES:
:CUSTOM_ID: plist-p
:END:
[[file:../tests/chronometrist-tests.org::#tests-common-plist-p][tests]]

#+BEGIN_SRC lisp
(defun plist-p (list)
  "Return non-nil if LIST is a property list, i.e. (:KEYWORD VALUE ...)"
  (when list
    (while (consp list)
      (setq list (if (and (keywordp (cl-first list)) (consp (cl-rest list)))
                     (cddr list)
                   'not-plist)))
    (null list)))
#+END_SRC

** Data structures
:PROPERTIES:
:CUSTOM_ID: data-structures
:END:
Reading directly from the file could be difficult, especially when your most common query is "get all intervals recorded on <date>" [fn:4] - and so, we maintain the hash table =chronometrist-events=, where each key is a date in the ISO-8601 format. The plists in this hash table are free of [[#explanation-midnight-spanning-intervals][midnight-spanning intervals]], making code which consumes it easier to write.

The data from =chronometrist-events= is used by most (all?) interval-consuming functions, but is never written to the user's file itself.

[fn:4] it might be the case that the [[#program-backend][file format]] is not suited to our most frequent operation...

*** apply-time                                                   :function:
:PROPERTIES:
:CUSTOM_ID: apply-time
:END:
#+BEGIN_SRC lisp
(defun apply-time (time timestamp)
  "Return TIMESTAMP with time modified to TIME.
TIME must be a string in the form \"HH:MM:SS\"

TIMESTAMP must be a time string in the ISO-8601 format.

Return value is a ts struct (see `ts.el')."
  (let-match (((list h m s)
               (mapcar #'parse-integer (split-string time :separator ":"))))
    (adjust-timestamp (parse-timestring timestamp)
      (set :hour h) (set :minute m) (set :sec s))))
#+END_SRC

**** tests
:PROPERTIES:
:CUSTOM_ID: tests-1
:END:
#+BEGIN_SRC lisp :tangle chronometrist-tests.el :load test
(ert-deftest apply-time ()
  (should
   (equal (ts-format "%FT%T%z" (apply-time "01:02:03" "2021-02-17T01:20:18+0530"))
          "2021-02-17T01:02:03+0530")))
#+END_SRC

*** split-plist                                                  :function:
:PROPERTIES:
:CUSTOM_ID: split-plist
:END:
#+BEGIN_SRC lisp
(defun split-plist (plist)
  "Return a list of two split plists if PLIST spans a midnight, else nil."
  (when (getf plist :stop)
    (let ((split-time (split-time (getf plist :start)
                                  (getf plist :stop)
 *day-start-time*)))
      (when split-time
        (let-match* (((plist :start start-1 :stop stop-1) (first  split-time))
                     ((plist :start start-2 :stop stop-2) (second split-time))
                     ;; `plist-put' modifies lists in-place. The
                     ;; resulting bugs left me puzzled for a while.
                     (event-1      (copy-list plist))
                     (event-2      (copy-list plist)))
          (setf (getf event-1 :start) start-1
                (getf event-1 :stop)  stop-1
                (getf event-2 :start) start-2
                (getf event-2 :stop)  stop-2)
          (list event-1 event-2))))))
#+END_SRC

**** tests
:PROPERTIES:
:CUSTOM_ID: tests-2
:END:
#+BEGIN_SRC lisp :tangle chronometrist-tests.el :load test
(ert-deftest split-plist ()
  (should
   (null (split-plist
          '(:name  "Task"
                   :start "2021-02-17T01:33:12+0530"
                   :stop  "2021-02-17T01:56:08+0530"))))
  (should
   (equal (split-plist
           '(:name  "Guitar"
                    :tags  (classical warm-up)
                    :start "2021-02-12T23:45:21+0530"
                    :stop  "2021-02-13T00:03:46+0530"))
          '((:name "Guitar"
                   :tags (classical warm-up)
                   :start "2021-02-12T23:45:21+0530"
                   :stop "2021-02-13T00:00:00+0530")
            (:name "Guitar"
                   :tags (classical warm-up)
                   :start "2021-02-13T00:00:00+0530"
                   :stop "2021-02-13T00:03:46+0530")))))
#+END_SRC

*** ht-update                                                      :writer:
:PROPERTIES:
:CUSTOM_ID: ht-update
:END:
#+BEGIN_SRC lisp
(defun ht-update (plist hash-table &optional replace)
  "Return HASH-TABLE with PLIST added as the latest interval.
If REPLACE is non-nil, replace the last interval with PLIST."
  (let* ((date (->> (getf plist :start)
                    (parse-timestring )
                    (ts-format "%F" )))
         (events-today (gethash date hash-table)))
    (--> (if replace (-drop-last 1 events-today) events-today)
         (append it (list plist))
         (puthash date it hash-table))
    hash-table))
#+END_SRC

*** ht-last-date                                                   :reader:
:PROPERTIES:
:CUSTOM_ID: ht-last-date
:END:
#+BEGIN_SRC lisp
(defun ht-last-date (hash-table)
  "Return an ISO-8601 date string for the latest date present in `chronometrist-events'."
  (--> (hash-table-keys hash-table)
       (sort it #'string-lessp)
       (last it)
       (first it)))
#+END_SRC

*** ht-last                                                        :reader:
:PROPERTIES:
:CUSTOM_ID: ht-last
:END:
#+BEGIN_SRC lisp
(defun ht-last (&optional (backend (chronometrist:active-backend)))
  "Return the last plist from `chronometrist-events'."
  (let* ((hash-table (chronometrist-backend-hash-table backend))
         (last-date  (ht-last-date hash-table)))
    (--> (gethash last-date hash-table)
         (last it)
         (car it))))
#+END_SRC

*** ht-subset                                                      :reader:
:PROPERTIES:
:VALUE:    hash table
:CUSTOM_ID: ht-subset
:END:
#+BEGIN_SRC lisp
(defun ht-subset (start end hash-table)
  "Return a subset of HASH-TABLE.
The subset will contain values between dates START and END (both
inclusive).

START and END must be ts structs (see `ts.el'). They will be
treated as though their time is 00:00:00."
  (let ((subset (make-hash-table-1))
        (start  (date-ts start))
        (end    (date-ts end)))
    (maphash (lambda (key value)
               (when (ts-in start end (parse-timestring key))
                 (puthash key value subset)))
             hash-table)
    subset))
#+END_SRC

*** task-duration-one-day                                          :reader:
:PROPERTIES:
:CUSTOM_ID: task-duration-one-day
:END:
#+BEGIN_SRC lisp
(defun task-duration-one-day (task &optional
                                     (date (timestamp-to-unix (today)))
                                     (backend (active-backend)))
  "Return total time spent on TASK today or on DATE.
The return value is seconds, as an integer."
  (let ((task-intervals (task-records-for-date backend task date)))
    (if task-intervals
        (reduce #'+ (mapcar #'interval-to-duration task-intervals))
        ;; no events for this task on DATE, i.e. no time spent
        0)))
#+END_SRC

*** active-time-on                                                 :reader:
:PROPERTIES:
:CUSTOM_ID: active-time-on
:END:
#+BEGIN_SRC lisp
(defvar *task-list*)
(defun active-time-on (&optional (date (date-ts)))
  "Return the total active time today, or on DATE.
Return value is seconds as an integer."
  (->> (--map (task-duration-one-day it date) (*task-list*))
       (-reduce #'+)
       (truncate)))
#+END_SRC

*** count-active-days                                            :function:
:PROPERTIES:
:CUSTOM_ID: count-active-days
:END:
#+BEGIN_SRC lisp
(defun statistics-count-active-days (task table)
  "Return the number of days the user spent any time on TASK.
  TABLE must be a hash table - if not supplied, `chronometrist-events' is used.

  This will not return correct results if TABLE contains records
which span midnights."
  (loop for events being the hash-values of table
    count (seq-find (lambda (event)
                      (equal task (getf event :name)))
                    events)))
#+END_SRC

*** *task-list*                                           :custom:variable:
:PROPERTIES:
:VALUE:    list
:CUSTOM_ID: task-list
:END:
#+BEGIN_SRC lisp
(defvar *task-list* nil
  "List of tasks to be displayed by the Chronometrist frontend.
Value may be either nil or a list of strings.

If nil, the task list is generated from user data in
`*user-data-file*' and stored in the task-list slot of the
active backend.")
#+END_SRC

** Time functions
:PROPERTIES:
:CUSTOM_ID: time-functions
:END:
*** date-iso                                                     :function:
:PROPERTIES:
:CUSTOM_ID: date-iso
:END:
#+BEGIN_SRC lisp
(defun date-iso (&optional (ts (ts-now)))
  (ts-format "%F" ts))
#+END_SRC

*** date-ts                                                      :function:
:PROPERTIES:
:CUSTOM_ID: date-ts
:END:
#+BEGIN_SRC lisp
(defun date-ts (&optional (ts (ts-now)))
  "Return a ts struct representing the time 00:00:00 on today's date.
If TS is supplied, use that date instead of today.
TS should be a ts struct (see `ts.el')."
  (ts-apply :hour 0 :minute 0 :second 0 ts))
#+END_SRC

*** format-time-iso8601                                          :function:
:PROPERTIES:
:CUSTOM_ID: format-time-iso8601
:END:
#+BEGIN_SRC lisp
(defun format-time-iso8601 (&optional unix-time)
  "Return current date and time as an ISO-8601 timestamp.
Optional argument UNIX-TIME should be a time value (see
`current-time') accepted by `format-time-string'."
  (format-timestring nil (or unix-time (now))
                     :format '((:year 4) "-" (:month 2) "-" (:day 2) "T"
                               (:hour 2) ":" (:min 2) ":" (:sec 2) :gmt-offset-or-z)))
#+END_SRC

*** FIXME split-time                                               :reader:
:PROPERTIES:
:CUSTOM_ID: split-time
:END:
It does not matter here that the =:stop= dates in the returned plists are different from the =:start=, because =chronometrist-events-populate= uses only the date segment of the =:start= values as hash table keys. (The hash table keys form the rest of the program's notion of "days", and that of which plists belong to which day.)

Note - this assumes that an event never crosses >1 day. This seems sufficient for all conceivable cases.

#+BEGIN_SRC lisp
(defun split-time (start-time stop-time day-start-time)
  "If START-TIME and STOP-TIME intersect DAY-START-TIME, split them into two intervals.
START-TIME and STOP-TIME must be ISO-8601 timestamps e.g. \"YYYY-MM-DDTHH:MM:SSZ\".

DAY-START-TIME must be a string in the form \"HH:MM:SS\" (see
`*day-start-time*')

Return a list in the form
\((:start START-TIME
  :stop <day-start time on initial day>)
 (:start <day start time on second day>
  :stop STOP-TIME))"
  ;; FIXME - time zones are ignored; may cause issues with
  ;; time-zone-spanning events

  ;; The time on which the first provided day starts (according to `*day-start-time*')
  (let* ((stop-ts         (parse-timestring stop-time))
         (first-day-start (apply-time day-start-time start-time))
         (next-day-start  (adjust-timestamp first-day-start (offset :hour 24))))
    ;; Does the event stop time exceed the next day start time?
    (when (timestamp< next-day-start stop-ts)
      (let ((split-time (format-time-iso8601 next-day-start)))
        (list `(:start ,start-time :stop ,split-time)
              `(:start ,split-time :stop ,stop-time))))))
#+END_SRC

**** tests
:PROPERTIES:
:CUSTOM_ID: tests-3
:END:
#+BEGIN_SRC lisp :tangle chronometrist-tests.el :load test
(ert-deftest split-time ()
  (should
   (null
    (split-time "2021-02-17T01:33:12+0530"
                 "2021-02-17T01:56:08+0530"
                 "00:00:00")))
  (should
   (equal
    (split-time "2021-02-19T23:45:36+0530"
                 "2021-02-20T00:18:40+0530"
                 "00:00:00")
    '((:start "2021-02-19T23:45:36+0530"
              :stop "2021-02-20T00:00:00+0530")
      (:start "2021-02-20T00:00:00+0530"
              :stop "2021-02-20T00:18:40+0530"))))
  (should
   (equal
    (split-time "2021-02-19T23:45:36+0530"
                 "2021-02-20T03:18:40+0530"
                 "01:20:30")
    '((:start "2021-02-19T23:45:36+0530"
              :stop "2021-02-20T01:20:30+0530")
      (:start "2021-02-20T01:20:30+0530"
              :stop "2021-02-20T03:18:40+0530")))))
#+END_SRC

*** seconds-to-hms                                               :function:
:PROPERTIES:
:CUSTOM_ID: seconds-to-hms
:END:
#+BEGIN_SRC lisp
(defun seconds-to-hms (seconds)
  "Convert SECONDS to a vector in the form [HOURS MINUTES SECONDS].
SECONDS must be a positive integer."
  (let* ((seconds (truncate seconds))
         (s       (% seconds 60))
         (m       (% (/ seconds 60) 60))
         (h       (/ seconds 3600)))
    (list h m s)))
#+END_SRC

*** interval                                                     :function:
:PROPERTIES:
:CUSTOM_ID: interval
:END:
#+BEGIN_SRC lisp
(defun interval (plist)
  "Return the period of time covered by EVENT as a time value.
EVENT should be a plist (see `*user-data-file*')."
  (let* ((start-ts  (parse-timestring (getf plist :start)))
         (stop-iso  (getf plist :stop))
         ;; Add a stop time if it does not exist.
         (stop-ts   (if stop-iso (parse-timestring stop-iso) (now))))
    (ts-diff stop-ts start-ts)))
#+END_SRC

*** format-duration-long                                         :function:
:PROPERTIES:
:CUSTOM_ID: format-duration-long
:END:
#+BEGIN_SRC lisp
(defun format-duration-long (seconds)
  "Return SECONDS as a human-friendly duration string.
e.g. \"2 hours, 10 minutes\". SECONDS must be an integer. If
SECONDS is less than 60, return a blank string."
  (let* ((hours         (/ seconds 60 60))
         (minutes       (% (/ seconds 60) 60))
         (hour-string   (if (= 1 hours) "hour" "hours"))
         (minute-string (if (= 1 minutes) "minute" "minutes")))
    (cond ((and (zerop hours) (zerop minutes)) "")
          ((zerop hours)
           (format "%s %s" minutes minute-string))
          ((zerop minutes)
           (format "%s %s" hours hour-string))
          (t (format "%s %s, %s %s"
                     hours hour-string
                     minutes minute-string)))))
#+END_SRC

**** tests
:PROPERTIES:
:CUSTOM_ID: tests-4
:END:
#+BEGIN_SRC lisp :tangle ../tests/chronometrist-tests.el :load test
(ert-deftest format-duration-long ()
  (should (equal (format-duration-long 5) ""))
  (should (equal (format-duration-long 65) "1 minute"))
  (should (equal (format-duration-long 125) "2 minutes"))

  (should (equal (format-duration-long 3605) "1 hour"))
  (should (equal (format-duration-long 3660) "1 hour, 1 minute"))
  (should (equal (format-duration-long 3725) "1 hour, 2 minutes"))

  (should (equal (format-duration-long 7200) "2 hours"))
  (should (equal (format-duration-long 7260) "2 hours, 1 minute"))
  (should (equal (format-duration-long 7320) "2 hours, 2 minutes")))
#+END_SRC

*** iso-to-date                                                  :function:
:PROPERTIES:
:CUSTOM_ID: iso-to-date
:END:
#+BEGIN_SRC lisp
(defun iso-to-date (timestamp)
  (first (split-string timestamp :separator "T")))
#+END_SRC

** Backends
:PROPERTIES:
:CUSTOM_ID: backends
:END:
*** protocol
:PROPERTIES:
:CUSTOM_ID: protocol
:END:
**** backend                                                       :class:
:PROPERTIES:
:CUSTOM_ID: backend
:END:
The backend may use no files, a single file, or multiple files. Thus, =backend= makes no reference to files, and [[#file-backend-mixin][=file-backend-mixin=]] may be used by single file backends.

#+BEGIN_SRC lisp
(defclass backend ()
  ((task-list :initform nil
              :initarg :task-list
              :accessor backend-task-list)))
#+END_SRC

**** *backends-alist*                                           :variable:
:PROPERTIES:
:CUSTOM_ID: backends-alist
:END:
#+BEGIN_SRC lisp
(defvar *backends-alist* nil
  "Alist of Chronometrist backends.
Each element must be in the form `(KEYWORD TAG OBJECT)', where
TAG is a string used as a tag in customization, and OBJECT is an
EIEIO object such as one returned by `make-instance'.")
#+END_SRC

**** *active-backend*                                    :custom:variable:
:PROPERTIES:
:CUSTOM_ID: active-backend-variable
:END:
#+BEGIN_SRC lisp
(defvar *active-backend* :sqlite
  "The backend currently in use.
Value must be a keyword corresponding to a key in
`*backends-alist*'.")
#+END_SRC

**** active-backend                                               :reader:
:PROPERTIES:
:CUSTOM_ID: active-backend-function
:END:
#+BEGIN_SRC lisp
(defun active-backend ()
  "Return an object representing the currently active backend."
  (third (assoc *active-backend* *backends-alist*)))
#+END_SRC

**** register-backend                                             :writer:
:PROPERTIES:
:CUSTOM_ID: register-backend
:END:
#+BEGIN_SRC lisp
(defun register-backend (keyword tag object)
  "Add backend to `*backends-alist*'.
For values of KEYWORD, TAG, and OBJECT, see `*backends-alist*'.

If a backend with KEYWORD already exists, the existing entry will
be replaced."
  (setq *backends-alist* (remove keyword *backends-alist* :key #'car))
  (pushnew (list keyword tag object) *backends-alist*))
#+END_SRC

**** task-list                                                  :function:
:PROPERTIES:
:CUSTOM_ID: task-list-1
:END:
#+BEGIN_SRC lisp
(defun task-list ()
  "Return the list of tasks to be used.
If `task-list' is non-nil, return its value; else,
return a list of tasks from the active backend."
  (let ((backend (active-backend)))
    ;; (format *debug-io* "active backend: ~s~%" backend)
    (with-slots (task-list) backend
      (or *task-list* task-list (setf task-list (list-tasks backend))))))
#+END_SRC

**** day                                                           :class:
:PROPERTIES:
:CUSTOM_ID: day
:END:
#+BEGIN_SRC lisp
(defclass day ()
  ((properties :initarg :properties :accessor properties)
   (date :initarg :date
         :accessor date
         :type integer
         :documentation "The date as an integer representing the UNIX epoch time.")
   (intervals :initarg :intervals
              :accessor intervals
              :documentation "The intervals associated with this day.")
   (events :initarg :events
           :accessor events
           :documentation "The events associated with this day.")))
#+END_SRC

**** interval                                                      :class:
:PROPERTIES:
:CUSTOM_ID: interval-1
:END:
#+BEGIN_SRC lisp
(defclass interval ()
  ((properties :initarg :properties :accessor properties)
   (name :initarg :name
         :accessor name
         :type string
         :documentation "The name of the task executed during this interval.")
   (start :initarg :start
          :accessor interval-start
          :type integer
          :documentation "The time at which this interval started, as
          an integer representing the UNIX epoch time.")
   (stop :initarg :stop
         :accessor interval-stop
         :type integer
         :documentation "The time at which this interval ended, as an
         integer representing the UNIX epoch time."))
  (:documentation "A time range spent on a specific task, with
  optional properties."))
#+END_SRC

***** make-interval                                :constructor:function:
:PROPERTIES:
:CUSTOM_ID: make-interval
:END:
#+BEGIN_SRC lisp
(defun make-interval (name start &optional stop properties-string)
  (make-instance 'chronometrist:interval
                 :name name :start start :stop stop
                 :properties (when properties-string
                               (read-from-string properties-string))))
#+END_SRC

***** interval-to-duration                                     :function:
:PROPERTIES:
:CUSTOM_ID: interval-to-duration
:END:
#+BEGIN_SRC lisp
(defun interval-to-duration (interval)
  (with-slots (start stop) interval
    (let ((stop (or stop (timestamp-to-unix (now)))))
      (- stop start))))
#+END_SRC

**** event                                                         :class:
:PROPERTIES:
:CUSTOM_ID: event
:END:
#+BEGIN_SRC lisp
(defclass event ()
  ((properties :initarg :properties :accessor properties)
   (name :initarg :name
         :accessor name
         :type string
         :documentation "The name of this event.")
   (time :initarg :time
         :accessor event-time
         :type integer
         :documentation "The time at which this interval started, as
         an integer representing the UNIX epoch time."))
  (:documentation "A named timestamp with optional properties."))
#+END_SRC

**** run-assertions                                     :generic:function:
:PROPERTIES:
:CUSTOM_ID: run-assertions
:END:
#+BEGIN_SRC lisp
(defgeneric backend-run-assertions (backend)
  (:documentation "Check common preconditions for any operations on BACKEND.
Signal errors for any unmet preconditions."))
#+END_SRC

**** view-backend                                       :generic:function:
:PROPERTIES:
:CUSTOM_ID: view-backend
:END:
#+BEGIN_SRC lisp
(defgeneric view-backend (backend)
  (:documentation "Open BACKEND for interactive viewing."))
#+END_SRC

**** edit-backend                                       :generic:function:
:PROPERTIES:
:CUSTOM_ID: edit-backend
:END:
#+BEGIN_SRC lisp
(defgeneric edit-backend (backend)
  (:documentation "Open BACKEND for interactive editing."))
#+END_SRC

**** backend-empty-p                                    :generic:function:
:PROPERTIES:
:CUSTOM_ID: backend-empty-p
:END:
#+BEGIN_SRC lisp
(defgeneric backend-empty-p (backend)
  (:documentation "Return non-nil if BACKEND contains no records, else nil."))
#+END_SRC

**** backend-modified-p                                 :generic:function:
:PROPERTIES:
:CUSTOM_ID: backend-modified-p
:END:
#+BEGIN_SRC lisp
(defgeneric backend-modified-p (backend)
  (:documentation "Return non-nil if BACKEND is being modified.
For instance, a file-based backend could be undergoing editing by
a user."))
#+END_SRC

**** create-file                                        :generic:function:
:PROPERTIES:
:CUSTOM_ID: create-file
:END:
[[file:../tests/tests.org::#tests-backend-create-file][tests]]

#+BEGIN_SRC lisp
(defgeneric create-file (backend &optional file)
  (:documentation "Create file associated with BACKEND.
Use FILE as a path, if provided.
Return path of new file if successfully created, and nil if it already exists."))
#+END_SRC

**** get-day                                            :generic:function:
:PROPERTIES:
:CUSTOM_ID: get-day
:END:
#+BEGIN_SRC lisp
(defgeneric get-day (date backend)
  (:documentation "Return day associated with DATE from BACKEND, or nil if no such day exists.
DATE should be an integer representing the UNIX epoch time at the start of the day."))
#+END_SRC

**** insert-day                                         :generic:function:
:PROPERTIES:
:CUSTOM_ID: insert-day
:END:
#+BEGIN_SRC lisp
(defgeneric insert-day (day backend &key &allow-other-keys)
  (:documentation "Insert PLIST as new record in BACKEND.
Return non-nil if record is inserted successfully.

PLIST may be an interval which crosses days."))

#+(or)
(defmethod insert :before ((_backend t) plist &key &allow-other-keys)
  (unless (typep plist 'plist)
    (error "Not a valid plist: %S" plist)))
#+END_SRC

**** remove-day                                         :generic:function:
:PROPERTIES:
:CUSTOM_ID: remove-day
:END:
#+BEGIN_SRC lisp
(defgeneric remove-day (date backend)
  (:documentation "Remove day associated with DATE from BACKEND, or nil if no such day exists.
DATE should be an integer representing the UNIX epoch time at the start of the day."))
#+END_SRC

**** remove-last                                        :generic:function:
:PROPERTIES:
:CUSTOM_ID: remove-last
:END:
#+BEGIN_SRC lisp
(defgeneric remove-last (backend &key &allow-other-keys)
  (:documentation "Remove last record from BACKEND.
Return non-nil if record is successfully removed.
Signal an error if there is no record to remove."))
#+END_SRC

**** latest-record                                      :generic:function:
:PROPERTIES:
:CUSTOM_ID: latest-record
:END:
#+BEGIN_SRC lisp
(defgeneric latest-record (backend)
  (:documentation "Return the latest record from BACKEND as a plist, or nil if BACKEND contains no records.
Return value may be active, i.e. it may or may not have a `:stop'
key-value.

If the latest record starts on one day and ends on another, the
entire (unsplit) record must be returned."))
#+END_SRC

**** task-records-for-date                              :generic:function:
:PROPERTIES:
:CUSTOM_ID: task-records-date
:END:
#+BEGIN_SRC lisp
(declaim (ftype (function (chronometrist:backend
                           string integer &key &allow-other-keys))
                chronometrist:task-records-for-date))
(defgeneric task-records-for-date (backend task date &key &allow-other-keys)
  (:documentation "From BACKEND, return records for TASK on DATE-TS as a list of plists.
DATE-TS must be a `ts.el' struct.

Return nil if BACKEND contains no records.")
  (:method ((backend chronometrist:backend)
            (task string)
            (date integer)
            &key &allow-other-keys)
    (loop for interval in (intervals (get-day date backend))
          when (equal task (name interval))
            collect interval)))
#+END_SRC

***** task-records-for-date                               :before:method:
:PROPERTIES:
:CUSTOM_ID: before-task-records-for-date
:END:
#+BEGIN_SRC lisp
#+(or)
(defmethod task-records-for-date :before
    ((_backend t) task date-ts &key &allow-other-keys)
  (unless (typep task 'string)
    (error "task %S is not a string" task))
  (unless (typep date-ts 'ts)
    (error "date-ts %S is not a `ts' struct" date-ts)))
#+END_SRC

**** replace-last                                       :generic:function:
:PROPERTIES:
:CUSTOM_ID: replace-last
:END:
#+BEGIN_SRC lisp
(defgeneric replace-last (backend plist &key &allow-other-keys)
  (:documentation "Replace last record in BACKEND with PLIST.
Return non-nil if successful."))

(defmethod replace-last :before ((_backend t) plist &key &allow-other-keys)
  (unless (typep plist 'plist)
    (error "Not a valid plist: %S" plist)))
#+END_SRC

**** to-file                                            :generic:function:
:PROPERTIES:
:CUSTOM_ID: to-file
:END:
#+BEGIN_SRC lisp
(defgeneric to-file (input-hash-table output-backend output-file)
  (:documentation "Save data from INPUT-HASH-TABLE to OUTPUT-FILE, in OUTPUT-BACKEND format.
Any existing data in OUTPUT-FILE is overwritten."))
#+END_SRC

**** on-add                                             :generic:function:
:PROPERTIES:
:CUSTOM_ID: on-add
:END:
#+BEGIN_SRC lisp
(defgeneric on-add (backend)
  (:documentation "Function called when data is added to BACKEND.
This may happen within Chronometrist (e.g. via
`insert') or outside it (e.g. a user editing the
backend file).

NEW-DATA is the data that was added."))
#+END_SRC

**** on-modify                                          :generic:function:
:PROPERTIES:
:CUSTOM_ID: on-modify
:END:
#+BEGIN_SRC lisp
(defgeneric on-modify (backend)
  (:documentation "Function called when data in BACKEND is modified (rather than added or removed).
This may happen within Chronometrist (e.g. via
`replace-last') or outside it (e.g. a user editing
the backend file).

OLD-DATA and NEW-DATA is the data before and after the changes,
respectively."))
#+END_SRC

**** on-remove                                          :generic:function:
:PROPERTIES:
:CUSTOM_ID: on-remove
:END:
#+BEGIN_SRC lisp
(defgeneric on-remove (backend)
  (:documentation "Function called when data is removed from BACKEND.
This may happen within Chronometrist (e.g. via
`remove-last') or outside it (e.g. a user editing
the backend file).

OLD-DATA is the data that was modified."))
#+END_SRC

**** on-change                                          :generic:function:
:PROPERTIES:
:CUSTOM_ID: on-change
:END:
#+BEGIN_SRC lisp
(defgeneric on-change (backend &rest args)
  (:documentation "Function to be run when BACKEND changes on disk.
This may happen within Chronometrist (e.g. via
`insert') or outside it (e.g. a user editing the
backend file)."))
#+END_SRC

**** verify                                             :generic:function:
:PROPERTIES:
:CUSTOM_ID: verify
:END:
#+BEGIN_SRC lisp
(defgeneric verify (backend)
  (:documentation "Check BACKEND for errors in data.
Return nil if no errors are found.

If an error is found, return (LINE-NUMBER . COLUMN-NUMBER) for file-based backends."))
#+END_SRC

**** on-file-path-change                                :generic:function:
:PROPERTIES:
:CUSTOM_ID: on-file-path-change
:END:
#+BEGIN_SRC lisp
(defgeneric on-file-path-change (backend old-path new-path)
  (:documentation "Function run when the value of `file' is changed.
OLD-PATH and NEW-PATH are the old and new values of
`file', respectively."))
#+END_SRC

**** reset-backend                                      :generic:function:
:PROPERTIES:
:CUSTOM_ID: reset-backend
:END:
#+BEGIN_SRC lisp
(defgeneric reset-backend (backend)
  (:documentation "Reset data structures for BACKEND."))
#+END_SRC

**** to-hash-table                                      :generic:function:
:PROPERTIES:
:CUSTOM_ID: to-hash-table
:END:
#+BEGIN_SRC lisp
(defgeneric to-hash-table (backend)
  (:documentation "Return data in BACKEND as a hash table in chronological order.
Hash table keys are ISO-8601 date strings. Hash table values are
lists of records, represented by plists. Both hash table keys and
hash table values must be in chronological order."))
#+END_SRC

**** to-list                                            :generic:function:
:PROPERTIES:
:CUSTOM_ID: to-list
:END:
#+BEGIN_SRC lisp
(defgeneric to-list (backend)
  (:documentation "Return all records in BACKEND as a list of plists."))
#+END_SRC

**** memory-layer-empty-p                               :generic:function:
:PROPERTIES:
:CUSTOM_ID: memory-layer-empty-p
:END:
#+BEGIN_SRC lisp
(defgeneric memory-layer-empty-p (backend)
  (:documentation "Return non-nil if memory layer of BACKEND contains no records, else nil."))
#+END_SRC

**** extended protocol
:PROPERTIES:
:CUSTOM_ID: extended-protocol
:END:
These can be implemented in terms of the minimal protocol above.

***** list-tasks                                       :generic:function:
:PROPERTIES:
:CUSTOM_ID: list-tasks
:END:
#+BEGIN_SRC lisp
(defgeneric list-tasks (backend)
  (:documentation "Return all tasks recorded in BACKEND as a list of strings."))
#+END_SRC

***** active-days (unimplemented)                      :generic:function:
:PROPERTIES:
:CUSTOM_ID: active-days-(unimplemented)
:END:
#+BEGIN_SRC lisp
(defgeneric active-days (backend task &key start end)
  (:documentation "From BACKEND, return number of days on which TASK had recorded time."))
#+END_SRC

***** count-records (unimplemented)                    :generic:function:
:PROPERTIES:
:CUSTOM_ID: count-records-(unimplemented)
:END:
#+BEGIN_SRC lisp
(defgeneric count-records (backend)
  (:documentation "Return number of records in BACKEND."))
#+END_SRC

*** Common definitions for s-expression backends
:PROPERTIES:
:CUSTOM_ID: common-definitions-sexp-backends
:END:
**** file-backend-mixin                                      :mixin:class:
:PROPERTIES:
:CUSTOM_ID: file-backend-mixin
:END:

#+BEGIN_SRC lisp
(defclass file-backend-mixin ()
  ((file :initform nil
         :initarg :file
         :type (or pathname null)
         :documentation
         "Pathname for backend file, without extension. Do not access this
         directly - use `backend-file' instead.")
   (extension :initform nil
              :initarg :extension
              :accessor backend-ext
              :type string
              :documentation
              "Extension of backend file.")
   (hash-table :initform (make-hash-table-1)
               :initarg :hash-table
               :accessor backend-hash-table)
   (file-watch :initform nil
               :initarg :file-watch
               :accessor backend-file-watch
               :documentation "Filesystem watch object, as returned by `file-notify-add-watch'."))
  (:documentation "Mixin for backends storing data in a single file."))
#+END_SRC

**** backend-file                                               :function:
:PROPERTIES:
:CUSTOM_ID: backend-file
:END:
#+BEGIN_SRC lisp
(defmethod backend-file ((backend file-backend-mixin))
  "Return the value of the file slot from BACKEND, or a file name
based on `*user-data-file*' and the BACKEND extension slot."
  (with-slots (file extension) backend
    ;; (format t "file: ~a extension: ~a" file extension)
    (make-pathname :type extension
                   :defaults (or file *user-data-file*))))
#+END_SRC

**** setup-file-watch                                             :writer:
:PROPERTIES:
:CUSTOM_ID: setup-file-watch
:END:
#+BEGIN_SRC lisp
(defun setup-file-watch (&optional (callback #'refresh-file))
  "Arrange for CALLBACK to be called when the backend file changes."
  (let* ((backend    (active-backend))
         (file       (chronometrist:backend-file backend))
         (file-watch (backend-file-watch backend)))
    (unless file-watch
      (setq file-watch
            (file-notify-add-watch file '(change) callback)))))
#+END_SRC

**** edit-backend                                                 :method:
:PROPERTIES:
:CUSTOM_ID: edit-backend-1
:END:
#+BEGIN_SRC lisp
(defmethod edit-backend ((backend file-backend-mixin))
  (find-file-other-window (chronometrist:backend-file backend))
  (goto-char (point-max)))
#+END_SRC

**** reset-backend                                         :writer:method:
:PROPERTIES:
:CUSTOM_ID: reset-backend-1
:END:
#+BEGIN_SRC lisp
(defmethod reset-backend ((backend file-backend-mixin))
  (with-slots (hash-table file-watch
               rest-start rest-end rest-hash
               file-length last-hash) backend
    (reset-task-list backend)
    (when file-watch
      (file-notify-rm-watch file-watch))
    (setf hash-table  (to-hash-table backend)
          file-watch  nil
          rest-start  nil
          rest-end    nil
          rest-hash   nil
          file-length nil
          last-hash   nil)
    (setup-file-watch)))
#+END_SRC

**** backend-empty-p                                       :reader:method:
:PROPERTIES:
:CUSTOM_ID: backend-empty-p-1
:END:
#+BEGIN_SRC lisp
(defmethod backend-empty-p ((backend file-backend-mixin))
  (let ((file (chronometrist:backend-file backend)))
    (or (not (file-exists-p file))
        (file-empty-p file))))
#+END_SRC

**** memory-layer-empty-p                                  :reader:method:
:PROPERTIES:
:CUSTOM_ID: memory-layer-empty-p-1
:END:
#+BEGIN_SRC lisp
(defmethod memory-layer-empty-p ((backend file-backend-mixin))
  (with-slots (hash-table) backend
    (zerop (hash-table-count hash-table))))
#+END_SRC

**** backend-modified-p                                    :reader:method:
:PROPERTIES:
:CUSTOM_ID: backend-modified-p-1
:END:
#+BEGIN_SRC lisp
(defmethod backend-modified-p ((backend file-backend-mixin))
  (with-slots (file) backend
    (buffer-modified-p
     (get-buffer-create
      (find-file-noselect file)))))
#+END_SRC

**** elisp-sexp-backend                                            :class:
:PROPERTIES:
:CUSTOM_ID: elisp-sexp-backend
:END:
#+BEGIN_SRC lisp
(defclass elisp-sexp-backend (backend file-backend-mixin)
  ((rest-start :initarg :rest-start
               :initform nil
               :accessor backend-rest-start
               :documentation "Integer denoting start of first
               s-expression in file.")
   (rest-end :initarg :rest-end
             :initform nil
             :accessor backend-rest-end
             :documentation "Integer denoting end of second-last
             s-expression in file.")
   (rest-hash :initarg :rest-hash
              :initform nil
              :accessor backend-rest-hash
              :documentation "Hash of content between rest-start and
              rest-end.")
   (file-length :initarg :file-length
                :initform nil
                :accessor backend-file-length
                :documentation "Integer denoting length of file, as
                returned by `(point-max)'.")
   (last-hash :initarg :last-hash
              :initform nil
              :accessor backend-last-hash
              :documentation "Hash of content between rest-end and
              file-length."))
  (:documentation "Base class for any text file backend which stores
  s-expressions readable by Emacs Lisp."))
#+END_SRC

**** create-file                                           :writer:method:
:PROPERTIES:
:CUSTOM_ID: create-file-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:create-file ((backend elisp-sexp-backend) &optional file)
  (let ((file (or file (chronometrist:backend-file backend))))
    (unless (file-exists-p file)
      (with-current-buffer (find-file-noselect file)
        (erase-buffer)
        (goto-char (point-min))
        (insert ";;; -*- mode: sexp; -*-\n\n")
        (write-file file))
      file)))
#+END_SRC

**** in-file                                                       :macro:
:PROPERTIES:
:CUSTOM_ID: in-file
:END:
#+BEGIN_SRC lisp
(defmacro sexp-in-file (file &rest body)
  "Run BODY in a buffer visiting FILE, restoring point afterwards."
  (declare (indent defun) (debug t))
  `(with-current-buffer (find-file-noselect ,file)
     (save-excursion ,@body)))
#+END_SRC

**** pre-read-check                                            :procedure:
:PROPERTIES:
:CUSTOM_ID: pre-read-check
:END:
#+BEGIN_SRC lisp
(defun sexp-pre-read-check (buffer)
  "Return non-nil if there is an s-expression before point in BUFFER.
Move point to the start of this s-expression."
  (with-current-buffer buffer
    (and (not (bobp))
         (backward-list)
         (or (not (bobp))
             (not (looking-at-p "^[[:blank:]]*;"))))))
#+END_SRC

**** loop-sexp-file                                                :macro:
:PROPERTIES:
:CUSTOM_ID: loop-sexp-file
:END:
#+BEGIN_SRC lisp
(defmacro loop-sexp-file (_for sexp _in file &rest loop-clauses)
  "`loop' LOOP-CLAUSES over s-expressions in FILE.
SEXP is bound to each s-expressions in reverse order (last
expression first)."
  (declare (indent defun) (debug 'loop))
  `(sexp-in-file ,file
     (goto-char (point-max))
     (loop with ,sexp
       while (and (sexp-pre-read-check (current-buffer))
                  (setq ,sexp (ignore-errors (read (current-buffer))))
                  (backward-list))
       ,@loop-clauses)))
#+END_SRC

**** backend-empty-p                                       :reader:method:
:PROPERTIES:
:CUSTOM_ID: backend-empty-p-2
:END:
#+BEGIN_SRC lisp
(defmethod backend-empty-p ((backend elisp-sexp-backend))
  (sexp-in-file (chronometrist:backend-file backend)
    (goto-char (point-min))
    (not (ignore-errors
           (read (current-buffer))))))
#+END_SRC

**** indices and hashes
:PROPERTIES:
:CUSTOM_ID: indices-hashes
:END:
#+BEGIN_SRC lisp
(defun rest-start (file)
  (sexp-in-file file
    (goto-char (point-min))
    (forward-list)
    (backward-list)
    (point)))

(defun rest-end (file)
  (sexp-in-file file
    (goto-char (point-max))
    (backward-list 2)
    (forward-list)
    (point)))
#+END_SRC

**** file-hash                                                    :reader:
:PROPERTIES:
:CUSTOM_ID: file-hash
:END:
#+BEGIN_SRC lisp
(defun file-hash (start end &optional (file (chronometrist:backend-file (active-backend))))
  "Calculate hash of `file' between START and END."
  (sexp-in-file file
    (secure-hash 'sha1
                 (buffer-substring-no-properties start end))))
#+END_SRC

***** tests
:PROPERTIES:
:CUSTOM_ID: tests-5
:END:
#+BEGIN_SRC lisp :tangle tests.el :load test
(ert-deftest file-hash ()
  (let-match* ((file test-file)
               ((list last-start last-end)
                (file-hash :before-last nil nil file))
               ((list rest-start rest-end rest-hash)
                (file-hash nil :before-last t file)))
    (message "chronometrist - file-hash test - file path is %s" file)
    (should (= 1 rest-start))
    (should (= 1254 rest-end))
    (should (= 1256 last-start))
    (should (= 1426 last-end))))
#+END_SRC

**** file-change-type                                             :reader:
:PROPERTIES:
:CUSTOM_ID: file-change-type
:END:
+ rest-start - start of first sexp
+ rest-end - end of second last sexp
+ file-length - end of file

+ rest-hash - hash of content between rest-start and rest-end
+ last-hash - hash of content between rest-end and file-length

+ ht-last-sexp - last sexp in memory
+ file-sexp-after-rest - sexp after rest-end
+ file-last-sexp - last sexp in file

| situation    | rest-hash | last-hash | file-sexp-after-rest | file-last-sexp                          | file-length                  |
|--------------+-----------+-----------+----------------------+-----------------------------------------+------------------------------|
| no change    | same      | same      | same as ht-last-sexp | same as ht-last-sexp and file-last-sexp | same                         |
| append       | same      | same      | -                    | (new s-expression)                      | always greater               |
| modify       | same      | changed   | changed              | changed                                 | may be smaller               |
| remove       | same      | changed   | nil                  | same as second last sexp                | always smaller               |
| other change | changed   | -         |                      | -                                       | may be smaller than rest-end |

We avoid comparing s-expressions in the file with the contents of the hash table, since the last s-expression might be represented differently in the hash tables of different elisp-sexp backends. Additionally, in =:modify= as well as =nil= situations, there is no s-expression after old-file-length.

#+BEGIN_SRC lisp
(defun file-change-type (backend)
  "Determine the type of change made to BACKEND's file.
    Return
    :append  if a new s-expression was added to the end,
    :modify  if the last s-expression was modified,
    :remove  if the last s-expression was removed,
        nil  if the contents didn't change, and
          t  for any other change."
  (with-slots
      (file file-watch
            ;; The slots contain the old state of the file.
            hash-table
            rest-start rest-end rest-hash
            file-length last-hash) backend
    (let* ((new-length    (file-length file))
           (new-rest-hash (when (and (>= new-length rest-start)
                                     (>= new-length rest-end))
                            (file-hash rest-start rest-end file)))
           (new-last-hash (when (and (>= new-length rest-end)
                                     (>= new-length file-length))
                            (file-hash rest-end file-length file))))
      ;; (debug-message "File indices - old rest-start: %s rest-end: %s file-length: %s new-length: %s"
      ;;          rest-start rest-end file-length new-length)
      (cond ((and (= file-length new-length)
                  (equal rest-hash new-rest-hash)
                  (equal last-hash new-last-hash))
             nil)
            ((or (< new-length rest-end) ;; File has shrunk so much that we cannot compare rest-hash.
                 (not (equal rest-hash new-rest-hash)))
             t)
            ;; From here on, it is implicit that the change has happened at the end of the file.
            ((and (< file-length new-length) ;; File has grown.
                  (equal last-hash new-last-hash))
             :append)
            ((and (< new-length file-length) ;; File has shrunk.
                  (not (sexp-in-file file
                         (goto-char rest-end)
                         (ignore-errors
                           (read (current-buffer)))))) ;; There is no sexp after rest-end.
             :remove)
            (t :modify)))))
#+END_SRC

***** tests
:PROPERTIES:
:CUSTOM_ID: tests-6
:END:
#+BEGIN_SRC lisp :tangle tests.el :load test
(ert-deftest file-change-type ()
  (with-slots (file hash-table file-state) plist-test-backend
    (let* ((b plist-test-backend)
           (test-contents (with-current-buffer (find-file-noselect file)
                            (buffer-substring (point-min) (point-max)))))
      (reset-backend b)
      (setf file-state
            (list :last (file-hash :before-last nil)
                  :rest (file-hash nil :before-last t)))
      (unwind-protect
          (progn
            (should
             (eq nil (file-change-type file-state)))
            (should
             (eq :append
                 (progn
                   (insert plist-test-backend
                             '(:name "Append Test"
                                     :start "2021-02-01T13:06:46+0530"
                                     :stop "2021-02-01T13:06:49+0530"))
                   (tests--change-type-and-update file-state file))))
            (should
             (eq :modify
                 (progn
                   (replace-last plist-test-backend
                                   '(:name "Modify Test"
                                           :tags (some tags)
                                           :start "2021-02-01T13:06:46+0530"
                                           :stop "2021-02-01T13:06:49+0530"))
                   (tests--change-type-and-update file-state file))))
            (should
             (eq :remove
                 (progn
                   (sexp-in-file file
                     (goto-char (point-max))
                     (backward-list 1)
                     (sexp-delete-list 1)
                     (save-buffer))
                   (tests--change-type-and-update file-state file))))
            (should
             (eq t
                 (progn
                   (sexp-in-file file
                     (goto-char (point-min))
                     (plist-pp '(:name "Other Change Test"
                                         :start "2021-02-02T17:39:40+0530"
                                         :stop "2021-02-02T17:39:44+0530")
                                 (current-buffer))
                     (save-buffer))
                   (tests--change-type-and-update file-state file)))))
        (with-current-buffer
            (find-file-noselect file)
          (delete-region (point-min) (point-max))
          (insert test-contents)
          (save-buffer))
        (reset-backend b)))))
#+END_SRC

**** reset-task-list                                              :writer:
:PROPERTIES:
:CUSTOM_ID: reset-task-list
:END:
#+BEGIN_SRC lisp
(defun reset-task-list (backend)
  "Regenerate BACKEND's task list from its data.
Only takes effect if `task-list' is nil (i.e. the
user has not defined their own task list)."
  (unless task-list
    (setf (backend-task-list backend) (list-tasks backend))))
#+END_SRC

**** add-to-task-list                                             :writer:
:PROPERTIES:
:CUSTOM_ID: add-to-task-list
:END:
#+BEGIN_SRC lisp
(defun add-to-task-list (task backend)
  "Add TASK to BACKEND's task list, if it is not already present.
Only takes effect if `task-list' is nil (i.e. the
user has not defined their own task list)."
  (with-slots (task-list) backend
    (unless (and (not task-list)
                 (member task task-list :test #'equal))
      (setf task-list
            (sort (cons task task-list)
                  #'string-lessp)))))
#+END_SRC

**** remove-from-task-list                                        :writer:
:PROPERTIES:
:CUSTOM_ID: remove-from-task-list
:END:
#+BEGIN_SRC lisp
(defun remove-from-task-list (task backend)
  "Remove TASK from BACKEND's task list if necessary.
TASK is removed if it does not occur in BACKEND's hash table, or
if it only occurs in the newest plist of the same.

Only takes effect if `task-list' is nil (i.e. the
user has not defined their own task list).

Return new value of BACKEND's task list, or nil if
unchanged."
  (with-slots (hash-table task-list) backend
    (unless task-list
      (let (;; number of plists in hash table
            (ht-plist-count (loop with count = 0
                              for intervals being the hash-values of hash-table
                              do (loop for _interval in intervals
                                   do (incf count))
                              finally (return count)))
            ;; index of first occurrence of TASK in hash table, or nil if not found
            (ht-task-first-result (loop with count = 0
                                    for intervals being the hash-values of hash-table
                                    when (loop for interval in intervals
                                           do (incf count)
                                           when (equal task (getf interval :name))
                                           return t)
                                    return count)))
        (when (or (not ht-task-first-result)
                  (= ht-task-first-result ht-plist-count))
          ;; The only interval for TASK is the last expression
          (setf task-list (remove task task-list)))))))
#+END_SRC

**** on-change                                             :writer:method:
:PROPERTIES:
:CUSTOM_ID: on-change-1
:END:
#+BEGIN_SRC lisp
(defmethod on-change ((backend elisp-sexp-backend) &rest fs-event)
  "Function called when BACKEND file is changed.
This may happen within Chronometrist (through the backend
protocol) or outside it (e.g. a user editing the backend file).

FS-EVENT is the event passed by the `filenotify' library (see `file-notify-add-watch')."
  (with-slots (file hash-table file-watch
               rest-start rest-end rest-hash
               file-length last-hash) backend
    (let-match* (((list _ action _ _) fs-event)
                 (file-state-bound-p (and rest-start rest-end rest-hash
                                          file-length last-hash))
                 (change      (when file-state-bound-p
                                (file-change-type backend)))
                 (reset-watch-p (or (eq action 'deleted)
                                    (eq action 'renamed))))
      (debug-message "[Method] on-change: file change type %s" change)
      ;; If only the last plist was changed, update hash table and
      ;; task list, otherwise clear and repopulate hash table.
      (cond ((or reset-watch-p
                 (not file-state-bound-p) ;; why?
                 (eq change t))
             (reset-backend backend))
            (file-state-bound-p
             (case change
               ;; A new s-expression was added at the end of the file
               (:append (on-add backend))
               ;; The last s-expression in the file was changed
               (:modify (on-modify backend))
               ;; The last s-expression in the file was removed
               (:remove (on-remove backend))
               ;; `case' returns nil if the KEYFORM is nil
               )))
      (setf rest-start  (rest-start file)
            rest-end    (rest-end file)
            file-length (file-length file)
            last-hash   (file-hash rest-end file-length file)
            rest-hash   (file-hash rest-start rest-end file)))))
#+END_SRC

*** plist group backend
:PROPERTIES:
:CUSTOM_ID: plist-group-backend
:END:
This is largely like the plist backend, but plists are grouped by date by wrapping them in a tagged list -

#+BEGIN_SRC lisp :tangle no :load no
("<ISO-8601 date>"
 (:name "Task Name"
  [:keyword <value>]*
  :start "<ISO-8601 time>"
  :stop "<ISO-8601 time>")
 ...)
#+END_SRC

This makes it easy and computationally cheap to perform our most common query - getting the plists on a given day. [[#explanation-midnight-spanning-intervals][Midnight-spanning intervals]] are split in the file itself. The downside is that the user, if editing it by hand, must take care to split the intervals.

Note that migrating from the plist backend to the plist group backend is inherently likely to result in more plists compared to the source, as each midnight-spanning plist is split into two.

Concerns specific to the plist group backend -
1. the last plist may be split across two days. In such a situation -
   * changing key-values for the last plist would only apply to the most recent one
   * +deleting the last plist via =remove-last= would only delete the recent part of the split plist+ fixed
   * resetting is unaffected, since that only applies to the last interval, whether or not it's a split plist
   * restarting is unaffected, since that only applies to the active interval, and split intervals are always inactive ones

**** chronometrist.plist-group                                   :package:
:PROPERTIES:
:CUSTOM_ID: chronometrist.plist-group
:END:
#+BEGIN_SRC lisp
(in-package :cl)
(defpackage :chronometrist.plist-group
  (:use :cl :trivia)
  (:import-from :chronometrist
   ;; protocol
   :backend :file-backend-mixin :elisp-sexp-backend
   :register-backend
   :backend-file
   ;; customizable variables
   :*user-data-file*
   ;; helpers
   :make-hash-table-1)
  (:export
   :plist-group-backend
   :make-plist-group-backend
   ;; customizable variables
   ))
(in-package :chronometrist.plist-group)
#+END_SRC

**** plist-group-backend                                           :class:
:PROPERTIES:
:CUSTOM_ID: plist-group-backend-1
:END:
#+BEGIN_SRC lisp
(defclass plist-group-backend (elisp-sexp-backend) ()
  (:default-initargs :extension "plg"))

(chronometrist:register-backend
 :plist-group "Store records as plists grouped by date."
 (make-instance 'plist-group-backend))
#+END_SRC

**** backward-read-sexp                                           :reader:
:PROPERTIES:
:CUSTOM_ID: backward-read-sexp
:END:
#+BEGIN_SRC lisp
(defun backward-read-sexp (buffer)
  (backward-list)
  (save-excursion (read buffer)))
#+END_SRC

**** run-assertions                                        :reader:method:
:PROPERTIES:
:CUSTOM_ID: run-assertions-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:backend-run-assertions ((backend file-backend-mixin))
  (with-slots (file) backend
    (unless (file-exists-p file)
      (error "Backend file %S does not exist" file))))
#+END_SRC

**** latest-date-records                                   :reader:method:
:PROPERTIES:
:CUSTOM_ID: latest-date-records
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:latest-date-records ((backend plist-group-backend))
  (backend-run-assertions backend)
  (sexp-in-file (chronometrist:backend-file backend)
    (goto-char (point-max))
    (ignore-errors
      (backward-read-sexp (current-buffer)))))
#+END_SRC

**** HACK insert                                           :writer:method:
:PROPERTIES:
:CUSTOM_ID: insert
:END:
<<hack-note-plist-group-insert>>
We just want to insert a plist, but as a hack to avoid updating the pretty-printer to handle indentation of plists being inserted into an outer list, we =append= the plist to a plist group and insert/replace the plist group instead.

Situations -
1. new inactive day-crossing record
   1. first record - split, insert into two new groups
   2. not first record - split, insert into existing group + new group
2. new active record, or new non-day-crossing inactive record
   1. first record - insert into new plist group
   2. not first record
      1. latest recorded date = today - insert into existing group
      2. insert into new group

#+BEGIN_SRC lisp
#+(or)
(defmethod insert ((backend plist-group-backend) plist
                   &key (save t)
                   &allow-other-keys)
  ;; (check-type plist plist)
  (debug-message "[Method] insert: %S" plist)
  (backend-run-assertions backend)
  (if (not plist)
      (error "%s" "`insert' was called with an empty plist")
      (sexp-in-file
       (chronometrist:backend-file backend)
       (let-match* (((list plist-1 plist-2)   (split-plist plist))
                    ;; Determine if we need to insert a new plist group
                    (latest-plist-group  (latest-date-records backend))
                    (backend-latest-date (first latest-plist-group))
                    (date-today          (date-iso))
                    (insert-new-group    (not (equal date-today backend-latest-date)))
                    (start-date          (iso-to-date (getf plist :start)))
                    (new-plist-group-1   (if latest-plist-group
                                             (append latest-plist-group
                                                     (list (or plist-1 plist)))
                                             (list start-date (or plist-1 plist))))
                    (new-plist-group-2   (when (or plist-2 insert-new-group)
                                           (list date-today (or plist-2 plist)))))
         (goto-char (point-max))
         (when (not latest-plist-group)
           ;; first record
           (while (forward-comment 1) nil))
         (if (and plist-1 plist-2)
             ;; inactive, day-crossing record
             (progn
               (when latest-plist-group
                 ;; not the first record
                 (sexp-pre-read-check (current-buffer))
                 (sexp-delete-list))
               (funcall sexp-pretty-print-function new-plist-group-1 (current-buffer))
               (dotimes (_ 2) (default-indent-new-line))
               (funcall sexp-pretty-print-function new-plist-group-2 (current-buffer)))
             ;; active, or non-day-crossing inactive record
             ;; insert into new group
             (if (or (not latest-plist-group) ;; first record
                     insert-new-group)
                 (progn
                   (default-indent-new-line)
                   (funcall sexp-pretty-print-function new-plist-group-2 (current-buffer)))
                 ;; insert into existing group
                 (progn
                   (sexp-pre-read-check (current-buffer))
                   (sexp-delete-list)
                   (funcall sexp-pretty-print-function
                            new-plist-group-1
                            (current-buffer)))))
         (when save (save-buffer))
         t))))
#+END_SRC

**** plists-split-p                                             :function:
:PROPERTIES:
:CUSTOM_ID: plists-split-p
:END:
[[file:../tests/tests.org::#tests-common-plists-split-p][tests]]

#+BEGIN_SRC lisp
(defun plists-split-p (old-plist new-plist)
  "Return t if OLD-PLIST and NEW-PLIST are split plists.
Split plists means the :stop time of old-plist must be the same as
the :start time of new-plist, and they must have identical
keyword-values (except :start and :stop)."
  (let-match* (;; ((plist :stop  old-stop)  old-plist)
          ;; ((plist :start new-start) new-plist)
          (old-stop-unix     (parse-timestring old-stop))
          (new-start-unix    (parse-timestring new-start))
          (old-plist-no-time (plist-remove old-plist :start :stop))
          (new-plist-no-time (plist-remove new-plist :start :stop)))
    (and (time-equal-p old-stop-unix
                       new-start-unix)
         (equal old-plist-no-time
                new-plist-no-time))))
#+END_SRC

**** last-two-split-p                                          :procedure:
:PROPERTIES:
:CUSTOM_ID: last-two-split-p
:END:
#+BEGIN_SRC lisp
(defun last-two-split-p (file)
  "Return non-nil if the latest two plists in FILE are split.
FILE must be a file containing plist groups, as created by
`plist-backend'.

Return value is either a list in the form
(OLDER-PLIST NEWER-PLIST), or nil."
  (sexp-in-file file
    (let* ((newer-group (progn (goto-char (point-max))
                               (backward-list)
                               (read (current-buffer))))
           (older-group (and (= 2 (length newer-group))
                             (backward-list 2)
                             (read (current-buffer))))
           ;; in case there was just one plist-group in the file
           (older-group (unless (equal older-group newer-group)
                          older-group))
           (newer-plist (second newer-group))
           (older-plist (first (last older-group))))
      (when (and older-plist newer-plist
                 (plists-split-p older-plist newer-plist))
        (list older-plist newer-plist)))))
#+END_SRC

**** plist-unify                                                :function:
:PROPERTIES:
:CUSTOM_ID: plist-unify
:END:
#+BEGIN_SRC lisp
(defun plist-unify (old-plist new-plist)
  "Return a plist with the :start of OLD-PLIST and the :stop of NEW-PLIST."
  (let ((old-plist-wo-time (plist-remove old-plist :start :stop))
        (new-plist-wo-time (plist-remove new-plist :start :stop)))
    (cond ((not (and old-plist new-plist)) nil)
          ((equal old-plist-wo-time new-plist-wo-time)
           (let* ((plist    (copy-list old-plist))
                  (new-stop (getf new-plist :stop)))
             ;; Usually, a split plist has a `:stop' key. However, a
             ;; user may clock out and delete the stop time, resulting
             ;; in a split record without a `:stop' key.
             (if new-stop
                 (plist-put plist :stop new-stop)
               (plist-remove plist :stop))))
          (t (error "Attempt to unify plists with non-identical key-values")))))
#+END_SRC

**** remove-last                                           :writer:method:
:PROPERTIES:
:CUSTOM_ID: remove-last-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:remove-last ((backend plist-group-backend) &key (save t) &allow-other-keys)
  (with-slots (file) backend
    (sexp-in-file
     file
     (goto-char (point-max))
     (when (backend-empty-p backend)
       (error "remove-last has nothing to remove in %s"
              (eieio-object-class-name backend)))
     (when (last-two-split-p file) ;; cannot be checked after changing the file
       ;; latest plist-group has only one plist, which is split - delete the group
       (backward-list)
       (sexp-delete-list))
     ;; remove the last plist in the last plist-group
     ;; if the plist-group has only one plist, delete the group
     (let ((plist-group (save-excursion (backward-list)
                                        (read (current-buffer)))))
       (if (= 2 (length plist-group))
           (progn (backward-list)
                  (sexp-delete-list))
           (progn
             (down-list -1)
             (backward-list)
             (sexp-delete-list)
             (join-line)))
       (when save (save-buffer))
       t))))
#+END_SRC

**** to-list                                               :reader:method:
:PROPERTIES:
:CUSTOM_ID: to-list-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:to-list ((backend plist-group-backend))
  (backend-run-assertions backend)
  (loop-sexp-file for expr in (chronometrist:backend-file backend)
    append (reverse (rest expr))))
#+END_SRC

**** to-hash-table                                         :reader:method:
:PROPERTIES:
:CUSTOM_ID: to-hash-table-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:to-hash-table ((backend plist-group-backend))
  (let ((file (chronometrist:backend-file backend)))
    ;; (format t "file: ~a" file)
    (with-open-file (in file)
      (loop for sexp = (read in nil :eof)
            until (eq sexp :eof)
            collect sexp into list
            finally
               (return
                 (loop with ht = (make-hash-table-1)
                       for plist-group in list
                       do (setf (gethash (first plist-group) ht)
                                (rest plist-group))
                       finally (return ht)))))))
#+END_SRC

**** to-file                                               :writer:method:
:PROPERTIES:
:CUSTOM_ID: to-file-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:to-file (hash-table (backend plist-group-backend) file)
  (check-type hash-table hash-table)
  (delete-file file)
  (create-file backend file)
  (reset-backend backend)
  (sexp-in-file
   file
   (goto-char (point-max))
   (loop for date being the hash-keys in hash-table
           using (hash-value plists)
         do (insert (plist-pp (apply #'list date plists)) "\n")
         finally (save-buffer))))
#+END_SRC

**** on-add                                                :writer:method:
:PROPERTIES:
:CUSTOM_ID: on-add-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:on-add ((backend plist-group-backend))
  "Function run when a new plist-group is added at the end of a
`plist-group-backend' file."
  (with-slots (hash-table) backend
    (let-match (((cons date plist) (latest-date-records backend)))
      (setf (gethash date hash-table) plist)
      (add-to-task-list (getf plist :name) backend))))
#+END_SRC

**** on-modify                                             :writer:method:
:PROPERTIES:
:CUSTOM_ID: on-modify-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:on-modify ((backend plist-group-backend))
  "Function run when the newest plist-group in a
`plist-group-backend' file is modified."
  (with-slots (hash-table) backend
    (let-match* (((cons date plists) (latest-date-records backend))
                 (old-date        (ht-last-date hash-table))
                 (old-plists      (gethash old-date hash-table)))
      (puthash date plists hash-table)
      (loop for plist in old-plists
            do (remove-from-task-list (getf plist :name) backend))
      (loop for plist in plists
            do (add-to-task-list (getf plist :name) backend)))))
#+END_SRC

**** on-remove                                             :writer:method:
:PROPERTIES:
:CUSTOM_ID: on-remove-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:on-remove ((backend plist-group-backend))
  "Function run when the newest plist-group in a
`plist-group-backend' file is deleted."
  (with-slots (hash-table) backend
    (let* ((old-date   (ht-last-date hash-table))
           (old-plists (gethash old-date hash-table)))
      (loop for plist in old-plists
            do (remove-from-task-list (getf plist :name) backend))
      (puthash old-date nil hash-table))))
#+END_SRC

**** verify                                                :reader:method:
:PROPERTIES:
:CUSTOM_ID: verify-1
:END:
#+BEGIN_SRC lisp :load no :tangle no
(defmethod chronometrist:verify ((backend plist-group-backend))
  (with-slots (file hash-table) backend
    ;; incorrectly ordered groups check
    (loop-sexp-file for group in file
      with old-date-iso with old-date-unix
      with new-date-iso with new-date-unix
      ;; while (not (bobp))
      do (setq new-date-iso  (first group)
               new-date-unix (parse-timestring new-date-iso))
      when (and old-date-unix
                (time-less-p old-date-unix
                             new-date-unix))
      do (return (format "%s appears before %s on line %s"
                         new-date-iso old-date-iso (line-number-at-pos)))
      else do (setq old-date-iso  new-date-iso
                    old-date-unix new-date-unix)
      finally (return "Yay, no errors! (...that I could find 💀)"))))
#+END_SRC

**** extended protocol
:PROPERTIES:
:CUSTOM_ID: extended-protocol-1
:END:
***** list-tasks                                                 :method:
:PROPERTIES:
:CUSTOM_ID: list-tasks-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:list-tasks ((backend backend))
  (loop for plist in (to-list backend)
        collect (getf plist :name) into names
        finally (return
                  (sort (remove-duplicates names :test #'equal)
                        #'string-lessp))))
#+END_SRC

***** latest-record                                       :reader:method:
:PROPERTIES:
:CUSTOM_ID: latest-record-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:latest-record ((backend plist-group-backend))
  (with-slots (file) backend
    (if (last-two-split-p file)
        (apply #'plist-unify (last-two-split-p (chronometrist:backend-file (active-backend))))
      (first (last (latest-date-records backend))))))
#+END_SRC

***** task-records-for-date                               :reader:method:
:PROPERTIES:
:CUSTOM_ID: plist-group-task-records-for-date
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:task-records-for-date
    ((backend plist-group-backend) task date-ts &key &allow-other-keys)
  (check-type task string)
  (check-type date-ts ts)
  (backend-run-assertions backend)
  (loop for plist in (gethash (date-iso date-ts)
                              (backend-hash-table backend))
        when (equal task (getf plist :name))
          collect plist))
#+END_SRC

***** TODO active-days                           :reader:method:noexport:
:PROPERTIES:
:CUSTOM_ID: active-days
:END:
#+BEGIN_SRC lisp :tangle no
(defmethod chronometrist:active-days ((backend plist-group-backend) task &key start end)
  (check-type task string)
  (backend-run-assertions backend))
#+END_SRC

***** replace-last                                        :writer:method:
:PROPERTIES:
:CUSTOM_ID: replace-last-1
:END:
=replace-last= is what is used for clocking out, so we split midnight-spanning intervals in this operation.

We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method, removing and inserting the plist group instead of just the specific plist, to avoid having to update the pretty printer.

#+BEGIN_SRC lisp
(defmethod chronometrist:replace-last
    ((backend plist-group-backend) plist &key &allow-other-keys)
  ;; (check-type plist plist)
  (when (backend-empty-p backend)
    (error "No record to replace in %s" (eieio-object-class-name backend)))
  (sexp-in-file (chronometrist:backend-file backend)
    (remove-last backend :save nil)
    (delete-trailing-whitespace)
    (insert backend plist :save nil)
    (save-buffer)
    t))
#+END_SRC

***** count-records                              :reader:method:noexport:
:PROPERTIES:
:CUSTOM_ID: count-records
:END:
#+BEGIN_SRC lisp :tangle no
(defmethod chronometrist:count-records ((backend plist-group-backend)))
#+END_SRC

*** sqlite backend
:PROPERTIES:
:CUSTOM_ID: sqlite-backend
:END:
**** chronometrist.sqlite                                        :package:
:PROPERTIES:
:CUSTOM_ID: chronometrist.sqlite
:END:
#+BEGIN_SRC lisp
(in-package :cl)
(defpackage :chronometrist.sqlite
  (:use :cl)
  (:import-from :alexandria
   :hash-table-keys)
  (:import-from :uiop
   :strcat)
  (:import-from :local-time
   :parse-timestring :timestamp-to-unix)
  (:import-from :sqlite
   :connect :disconnect
   :execute-non-query :execute-single :execute-to-list)
  (:import-from :sxql
   :yield
   :create-table :foreign-key :unique-key
   :insert-into :select := :set= :from :order-by :where
   :left-join :limit)
  (:import-from :alexandria
   :flatten)
  (:import-from :trivia
   :let-match :let-match* :plist)
  (:import-from :chronometrist
   :make-interval)
  (:export :sqlite-backend
   ;; customizable variables
   ))
(in-package :chronometrist.sqlite)
#+END_SRC

**** aliases
:PROPERTIES:
:CUSTOM_ID: aliases
:END:
#+BEGIN_SRC lisp :load no
(loop for (fn . alias) in '((sqlite:execute-non-query . execute-statement)
                            (sqlite:execute-single . query-cell)
                            (sqlite:execute-single . query-row)
                            (sqlite:execute-single . query-row))
      do (setf (fdefinition alias) (symbol-function fn)))
#+END_SRC

**** sqlite-backend                                                :class:
:PROPERTIES:
:CUSTOM_ID: sqlite-backend-1
:END:
#+BEGIN_SRC lisp
(defclass sqlite-backend (chronometrist:backend chronometrist:file-backend-mixin)
  ((connection :initform nil
               :initarg :connection
               :accessor backend-connection))
  (:default-initargs :extension "sqlite"))
#+END_SRC

**** initialize-instance                                          :method:
:PROPERTIES:
:CUSTOM_ID: initialize-instance
:END:
#+BEGIN_SRC lisp
(defmethod initialize-instance :after ((backend sqlite-backend) &rest initargs)
  "Initialize connection for BACKEND based on its file."
  (declare (ignore initargs))
  (with-slots (connection file) backend
    (let ((file (chronometrist:backend-file backend)))
      (when (not connection)
        (setf connection (connect file)
              file file)))))

(chronometrist:register-backend
 :sqlite "Store records in SQLite database."
 (make-instance 'sqlite-backend))
#+END_SRC

**** execute-sxql                                               :function:
:PROPERTIES:
:CUSTOM_ID: execute-sxql
:END:
#+BEGIN_SRC lisp
(defun execute-sxql (exec-fn sxql database)
  "Execute SXQL statement on DATABASE using EXEC-FN.

EXEC-FN must be a function accepting DATABASE, an SQL query string,
and zero or more arguments to the query. `sqlite:execute-single' and
`sqlite:execute-to-list' are two examples of such a function.

SXQL must be an SXQL-statement object acceptable to `sxql:yield'.

DATABASE must be a database object acceptable to the EXEC-FN, such as
that returned by `sqlite:connect'."
  (multiple-value-bind (string values)
      (yield sxql)
    (apply exec-fn database string values)))
#+END_SRC

**** create-file                                           :writer:method:
:PROPERTIES:
:CUSTOM_ID: create-file-2
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:create-file ((backend sqlite-backend) &optional file)
  "Create file for BACKEND if it does not already exist.
Return the connection object from `emacsql-sqlite'."
  (let* ((file (or file (chronometrist:backend-file backend)))
         (db   (or (backend-connection backend)
                   (setf (backend-connection backend)
                         (connect file)))))
    (loop
      for expr in
      (list
       ;; Properties are user-defined key-values stored as JSON.
        (create-table :properties
            ((prop_id    :type 'integer :primary-key t)
             (properties :type 'text :unique t :not-null t)))
        ;; An event is a timestamp with a name and optional properties.
        (create-table :event_names
            ((name_id :type 'integer :primary-key t)
             (name    :type 'text :unique t :not-null t)))
        (create-table :events
            ((event_id :type 'integer :primary-key t)
             (name_id  :type 'integer :not-null t)
             (time     :type 'integer :unique t :not-null t)
             (prop_id  :type 'integer))
          (foreign-key '(name_id) :references '(event_names name_id))
          (foreign-key '(prop_id) :references '(properties prop_id)))
        ;; An interval is a time range with a name and optional properties.
        (create-table :interval_names
            ((name_id :type 'integer :primary-key t)
             (name    :type 'text :unique t :not-null t)))
        (create-table :intervals
            ((interval_id :type 'integer :primary-key t)
             (name_id     :type 'integer :not-null t)
             (start_time  :type 'integer :not-null t)
             (stop_time   :type 'integer)
             (prop_id     :type 'integer))
          (foreign-key '(name_id) :references '(interval_names name_id))
          (foreign-key '(prop_id) :references '(properties prop_id))
          (unique-key '(name_id start_time stop_time)))
        ;; A date contains one or more events and intervals. It may
        ;; also contain properties.
        (create-table :dates
            ((date_id :type 'integer :primary-key t)
             (date    :type 'integer :unique t :not-null t)
             (prop_id :type 'integer))
          (foreign-key '(prop_id) :references '(properties prop_id)))
        (create-table :date_events
            ((date_id  :type 'integer :not-null t)
             (event_id :type 'integer :not-null t))
          (foreign-key '(date_id) :references '(dates date_id))
          (foreign-key '(event_id) :references '(events event_id)))
        (create-table :date_intervals
            ((date_id     :type 'integer :not-null t)
             (interval_id :type 'integer :not-null t))
          (foreign-key '(date_id)     :references '(dates date_id))
          (foreign-key '(interval_id) :references '(intervals interval_id))))
      do (execute-non-query db (yield expr))
      finally
         (execute-non-query
          db
          "CREATE VIEW view_intervals AS
SELECT
  interval_id,
  name,
  datetime(start_time, 'unixepoch', 'localtime'),
  datetime(stop_time, 'unixepoch', 'localtime'),
  properties
FROM intervals
LEFT JOIN interval_names USING (name_id)
LEFT JOIN properties USING (prop_id)
ORDER BY interval_id DESC;")
         (return db))))
#+END_SRC

**** get-day                                                      :method:
:PROPERTIES:
:CUSTOM_ID: get-day-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:get-day (date (backend sqlite-backend))
  (let-match*
      ((connection  (backend-connection backend))
       (day         (make-instance 'chronometrist:day))
       ((list (or (list date-id prop-id) nil))
        (execute-to-list
         connection "SELECT date_id, prop_id FROM dates WHERE date = ?;" date))
       (properties
        (when prop-id
          (execute-sxql #'execute-single
                        (select (:properties)
                          (from :properties)
                          (where (:= :prop_id prop-id)))
                        connection))))
    (setf (chronometrist:date day) date
          (chronometrist:intervals day)
          (loop for (name start stop prop-string)
                  in (execute-sxql
                      #'execute-to-list
                      (select (:name :start_time :stop_time :properties)
                        (from :intervals)
                        (left-join :interval_names :using (:name_id))
                        (left-join :properties :using (:prop_id))
                        (where (:in :interval_id
                                    (select (:interval_id)
                                      (from :date_intervals)
                                      (where (:= :date_id date-id))))))
                      connection)
                collect (make-interval name start stop prop-string))
          (chronometrist:events day)
          (loop for (name time properties)
                  in (execute-sxql
                      #'execute-to-list
                      (select (:name :time :properties)
                        (from :events)
                        (left-join :event_names :using (:name_id))
                        (left-join :properties :using (:prop_id))
                        (where (:in :event_id
                                    (select (:event_id)
                                      (from :date_events)
                                      (where (:= :date_id date-id))))))
                      connection)
                collect (make-instance 'chronometrist:event
                                       :name name
                                       :time time
                                       :properties (when properties
                                                     (read-from-string properties))))
          (chronometrist:properties day)
          (when properties
            (read-from-string properties)))
    day))
#+END_SRC

**** iso-to-unix                                                :function:
:PROPERTIES:
:CUSTOM_ID: iso-to-unix
:END:
#+BEGIN_SRC lisp
(defun iso-to-unix (timestamp)
  (timestamp-to-unix (parse-timestring timestamp)))
#+END_SRC

**** to-file                                               :writer:method:
:PROPERTIES:
:CUSTOM_ID: to-file-2
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:to-file (hash-table (backend sqlite-backend) file)
  (with-slots (connection) backend
    (delete-file file)
    (disconnect connection)
    (setf connection nil)
    (chronometrist:create-file backend file)
    (loop for date in (sort (hash-table-keys hash-table) #'string-lessp) do
      ;; insert date if it does not exist
      (execute-non-query connection
                         "INSERT OR IGNORE INTO dates (date) VALUES (?);"
                         (iso-to-unix date))
      (loop for plist in (gethash date hash-table) do
        (chronometrist:insert-day backend plist)))))
#+END_SRC

**** to-list                                               :reader:method:
:PROPERTIES:
:CUSTOM_ID: to-list-2
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:to-list ((backend sqlite-backend))
  (with-slots (connection) backend
    ))
#+END_SRC

**** insert-properties                                            :writer:
:PROPERTIES:
:CUSTOM_ID: insert-properties
:END:
#+BEGIN_SRC lisp
(defun sqlite-insert-properties (backend plist)
  "Insert properties from PLIST to (SQLite) BACKEND.
Properties are key-values excluding :name, :start, and :stop.

Insert nothing if the properties already exist. Return the
prop-id of the inserted or existing property."
  (with-slots (connection) backend
    (let* ((plist  (chronometrist:plist-key-values plist))
           (encoded-properties
             (if (functionp *sqlite-properties-function*)
                 (funcall *sqlite-properties-function* plist)
                 (write-to-string plist :escape t :pretty nil :readably t))))
      ;; (format t "properties: ~s~%" encoded-properties)
      (when plist
        (execute-non-query connection
                           "INSERT OR IGNORE INTO properties (properties) VALUES (?);"
                           encoded-properties)
        (execute-single connection
                        "SELECT (prop_id) FROM properties WHERE properties = ?;"
                        encoded-properties)))))
#+END_SRC

***** properties-to-json                                       :function:
:PROPERTIES:
:CUSTOM_ID: properties-to-json
:END:
#+BEGIN_SRC lisp
(defun sqlite-properties-to-json (plist)
  "Return PLIST as a JSON string."
  (json-encode
   ;; `json-encode' throws an error when it thinks
   ;; it sees "alists" which have numbers as
   ;; "keys", so we convert any cons cells and any
   ;; lists starting with a number to vectors
   (-tree-map (lambda (elt)
                (cond ((pp-pair-p elt)
                       (vector (car elt) (cdr elt)))
                      ((consp elt)
                       (vconcat elt))
                      (t elt)))
              plist)))
#+END_SRC

***** properties-function                               :custom:variable:
:PROPERTIES:
:CUSTOM_ID: properties-function
:END:
#+BEGIN_SRC lisp
(defvar *sqlite-properties-function* nil
  "Function used to control the encoding of user key-values.
The function must accept a single argument, the plist of key-values.

Any non-function value results in key-values being inserted as
s-expressions in a text column.")
#+END_SRC

**** insert                                                :writer:method:
:PROPERTIES:
:CUSTOM_ID: insert-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:insert-day
    ((backend sqlite-backend) plist &key &allow-other-keys)
  (let-match (((or (list plist-1 plist-2) nil)
               (chronometrist:split-plist plist))
              (connection  (backend-connection backend)))
    (loop
      for plist in (if (and plist-1 plist-2)
                       (list plist-1 plist-2)
                       (list plist))
      do (let-match* (((plist :name name :start start :stop stop) plist)
                      (date-unix   (iso-to-unix (chronometrist:iso-to-date start)))
                      (start-unix  (iso-to-unix start))
                      (stop-unix   (and stop (iso-to-unix stop)))
                      ;; insert interval properties if they do not exist
                      (prop-id     (sqlite-insert-properties backend plist))
                      (name-id)
                      (interval-id)
                      (date-id))
           ;; insert name if it does not exist
           (execute-non-query
            connection
            "INSERT OR IGNORE INTO interval_names (name) VALUES (?);"
            name)
           (setq name-id
                 (execute-single
                  connection
                  "SELECT (name_id) FROM interval_names WHERE name = ?;"
                  name))
           ;; insert an interval...
           (execute-non-query
            connection
            "INSERT OR IGNORE INTO intervals (name_id, start_time, stop_time, prop_id) VALUES (?, ?, ?, ?);"
            name-id start-unix stop-unix prop-id)
           (setq interval-id
                 (execute-single connection
                                 "SELECT (interval_id) FROM intervals WHERE start_time = ?;"
                                 start-unix))
           ;; ...and associate it with the date
           (execute-non-query connection
                              "INSERT OR IGNORE INTO dates (date) VALUES (?);"
                              date-unix)
           (setq date-id
                 (execute-single connection
                                 "SELECT (date_id) FROM dates WHERE date = ?;"
                                 date-unix))
           (execute-non-query connection
                              "INSERT INTO date_intervals (date_id, interval_id) VALUES (?, ?);"
                              date-id interval-id)))))
#+END_SRC

**** list-tasks                                            :reader:method:
:PROPERTIES:
:CUSTOM_ID: list-tasks-2
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:list-tasks ((backend sqlite-backend))
  ;; (format *debug-io* "list-tasks (sqlite)")
  (with-slots (connection) backend
    (flatten (execute-to-list connection
                              (yield (select :name
                                       (from :interval_names)
                                       (order-by (:asc :name))))))))
#+END_SRC

**** open-file
:PROPERTIES:
:CUSTOM_ID: open-file
:END:
#+BEGIN_SRC lisp
(defmethod edit-backend ((backend sqlite-backend))
  (require 'sql)
  (switch-to-buffer
   (sql-comint-sqlite 'sqlite (list file))))
#+END_SRC

**** latest-record
:PROPERTIES:
:CUSTOM_ID: latest-record-2
:END:
#+BEGIN_SRC lisp
;; SELECT * FROM TABLE WHERE ID = (SELECT MAX(ID) FROM TABLE);
;; SELECT * FROM tablename ORDER BY column DESC LIMIT 1;
(defmethod chronometrist:latest-record ((backend sqlite-backend))
  (emacsql db ;; [:select * :from events :order-by rowid :desc :limit 1]
           ))
#+END_SRC

**** task-records-for-date
:PROPERTIES:
:CUSTOM_ID: sqlite-task-records-for-date
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:task-records-for-date
    ((backend sqlite-backend) task date &key &allow-other-keys)
  (let ((list (execute-sxql
               #'execute-to-list
               (select (:name :start_time :stop_time :properties)
                 (from :intervals)
                 (left-join :interval_names :using (:name_id))
                 (left-join :properties :using (:prop_id))
                 (where (:and
                         (:in :interval_id
                              (select (:interval_id)
                                (from :date_intervals)
                                (where (:= :date_id
                                           (select (:date_id)
                                             (from :dates)
                                             (where (:= :date date)))))))
                         (:= :name task))))
               (backend-connection backend))))
    (loop for (name start stop prop-string) in list
          collect (make-interval name start stop prop-string))))
#+END_SRC

**** active-days
:PROPERTIES:
:CUSTOM_ID: active-days-1
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:active-days ((backend sqlite-backend) task &key start end))
#+END_SRC

**** replace-last
:PROPERTIES:
:CUSTOM_ID: replace-last-2
:END:
#+BEGIN_SRC lisp
(defmethod chronometrist:replace-last ((backend sqlite-backend)
                                       plist &key &allow-other-keys)
  (emacsql db ;; [:delete-from events :where ]
           ))
#+END_SRC

** Migration
:PROPERTIES:
:CUSTOM_ID: migration
:END:
*** remove-prefix                                                :function:
:PROPERTIES:
:CUSTOM_ID: remove-prefix
:END:
#+BEGIN_SRC lisp
(defun remove-prefix (string)
  (replace-regexp-in-string "^" "" string))
#+END_SRC
** Frontends
:PROPERTIES:
:CUSTOM_ID: frontends
:END:
*** CLIM
:PROPERTIES:
:CUSTOM_ID: clim
:END:
**** chronometrist.clim                                          :package:
:PROPERTIES:
:CUSTOM_ID: chronometrist.clim
:END:
#+BEGIN_SRC lisp
(in-package :cl)
(defpackage :chronometrist.clim
  (:use :clim :clim-lisp)
  (:import-from :local-time :now :today :timestamp-to-unix)
  (:import-from :format-seconds :format-seconds)
  (:import-from :chronometrist :task-list :task-duration-one-day)
  (:export :run-chronometrist))
(in-package :chronometrist.clim)
#+END_SRC

**** *duration-format-string*                                   :variable:
:PROPERTIES:
:CUSTOM_ID: duration-format-string
:END:
#+BEGIN_SRC lisp
(defvar *duration-format-string* "~2h:~2,'0m:~2,'0s"
  "Format string used for durations, acceptable to `format-seconds'.")
#+END_SRC

**** chronometrist                                     :application:frame:
:PROPERTIES:
:CUSTOM_ID: chronometrist-1
:END:
#+BEGIN_SRC lisp
(define-application-frame chronometrist () ()
  (:pointer-documentation t)
  (:panes (task-duration :application
                         :height (graft-height (find-graft))
                         :width  (graft-width (find-graft))
                         :display-function 'display
                         :background +black+
                         :foreground +white+)
          (int :interactor
               :background +black+
               :foreground +white+))
  (:layouts (default (vertically () task-duration int))))
#+END_SRC

**** task-duration table pane
:PROPERTIES:
:CUSTOM_ID: task-duration-table-pane
:END:
***** column-specifier                                            :class:
:PROPERTIES:
:CUSTOM_ID: column-specifier
:END:
#+BEGIN_SRC lisp
(defclass column-specifier ()
  ((name  :initarg :name  :type keyword :accessor column-name)
   (label :initarg :label :type string  :accessor column-label)))
#+END_SRC

***** make-column-specifier                        :constructor:function:
:PROPERTIES:
:CUSTOM_ID: make-column-specifier
:END:
#+BEGIN_SRC lisp
(defun make-column-specifier (name label)
  (make-instance 'column-specifier :name name :label label))
#+END_SRC

***** cell-data                                                  :method:
:PROPERTIES:
:CUSTOM_ID: cell-data
:END:
#+BEGIN_SRC lisp
(defgeneric cell-data (name index task date)
  (:documentation "Function to determine the data of cell NAME.
NAME must be a keyword.
INDEX is a 1-indexed integer for the row.
TASK is the name of the task in this row, as a string.
DATE is the date, as integer seconds since the UNIX epoch."))
(defmethod cell-data ((name (eql :index))
                      (index integer)
                      (task string)
                      (date integer))
  index)
(defmethod cell-data ((name (eql :task))
                      (index integer)
                      (task string)
                      (date integer))
  task)
(defmethod cell-data ((name (eql :duration))
                      (index integer)
                      (task string)
                      (date integer))
  (task-duration-one-day task date))
#+END_SRC

***** cell-print                                                 :method:
:PROPERTIES:
:CUSTOM_ID: cell-print
:END:
#+BEGIN_SRC lisp
(defgeneric cell-print (name index task date cell-data frame pane)
  (:documentation "Function to determine the data of cell NAME.
NAME must be a keyword.
INDEX is a 1-indexed integer for the row.
TASK is the name of the task in this row, as a string.
DATE is the date, as integer seconds since the UNIX epoch.
CELL-DATA is the return value of `cell-data'
FRAME and PANE are the CLIM frame and pane as passed to the display function."))
(defmethod cell-print ((name (eql :index))
                       (index integer) (task string) (date integer)
                       cell-data-index
                       frame pane)
  (format t "~2@A" cell-data-index))
(defmethod cell-print ((name (eql :task))
                       (index integer) (task string) (date integer)
                       cell-data-task
                       frame pane)
  (with-output-as-presentation (pane cell-data-task 'task-name)
    (format t "~A" cell-data-task)))
(defmethod cell-print ((name (eql :duration))
                       (index integer) (task string) (date integer)
                       duration
                       frame pane)
  (with-output-as-presentation (pane duration 'number)
    (if (zerop duration)
        (format t "~10@A" "-")
        (format-seconds t *duration-format-string* duration))))
#+END_SRC

***** *task-duration-table-spec*                        :custom:variable:
:PROPERTIES:
:CUSTOM_ID: task-duration-table-spec
:END:
#+BEGIN_SRC lisp
(defvar *task-duration-table-spec*
  (loop for (keyword . string) in '((:index    . "#")
                                    (:task     . "Task")
                                    (:duration . "Time")
                                    ;; (:activity . "Active")
                                    )
        collect (make-column-specifier keyword string))
  "List of table `column-specifier' instances.")
#+END_SRC

***** task-duration-table-function                             :function:
:PROPERTIES:
:CUSTOM_ID: task-duration-table-function
:END:
#+BEGIN_SRC lisp
(defun task-duration-table-function (table-specification)
  "Return a table (a list of lists) based on TABLE-SPECIFICATION."
  (loop with date = (timestamp-to-unix (today))
        for task in (task-list)
        for index from 0
        when (zerop index)
          collect (mapcar #'column-label table-specification)
        else
          collect (loop for column-spec in table-specification
                        collect (cell-data (column-name column-spec)
                                           index task date))))
#+END_SRC

**** display
:PROPERTIES:
:CUSTOM_ID: display
:END:
***** display                                                  :function:
:PROPERTIES:
:CUSTOM_ID: display-1
:END:
#+BEGIN_SRC lisp
(defun display (frame stream)
  (display-pane frame stream (pane-name stream)))
#+END_SRC

***** task-name                                                   :class:
:PROPERTIES:
:CUSTOM_ID: task-name
:END:
#+BEGIN_SRC lisp
(defclass task-name () ())
#+END_SRC

***** display-pane                                     :generic:function:
:PROPERTIES:
:CUSTOM_ID: display-pane
:END:
#+BEGIN_SRC lisp
(defgeneric display-pane (frame stream pane-name)
  (:documentation "Display a Chronometrist application pane."))
#+END_SRC

***** display-pane                                               :method:
:PROPERTIES:
:CUSTOM_ID: display-pane-1
:END:
#+BEGIN_SRC lisp
(defmethod display-pane (frame pane (pane-name (eql 'task-duration)))
  "Display the task-duration pane, using `*task-duration-table-spec*'."
  (declare (ignorable frame pane pane-name))
  ;; (format *debug-io* "*application-frame*: ~a~%" *application-frame*)
  (let ((stream *standard-output*))
    (formatting-table (stream)
      (loop
        with date = (timestamp-to-unix (today))
        for task in (task-list)
        for row in (task-duration-table-function *task-duration-table-spec*)
        for index from 0 do
          (formatting-row (stream)
            (if (zerop index)
                (loop for string in row
                      do (formatting-cell (stream)
                           (format t "~A" string)))
                (loop for data in row
                      for col-spec in *task-duration-table-spec*
                      do (formatting-cell (stream)
                           (cell-print (column-name col-spec)
                                       index task date data frame pane)))))))))
#+END_SRC

**** refresh                                                     :command:
:PROPERTIES:
:CUSTOM_ID: refresh
:END:
#+BEGIN_SRC lisp
(define-chronometrist-command (com-refresh :name t) ())
#+END_SRC

**** run-chronometrist
:PROPERTIES:
:CUSTOM_ID: run-chronometrist
:END:
#+BEGIN_SRC lisp
(defun run-chronometrist (&optional dir)
  (run-frame-top-level (make-application-frame 'chronometrist)))
#+END_SRC