11 KiB
11 KiB
chronometrist-sqlite
Library headers and commentary
;;; chronometrist-sqlite.el --- SQLite backend for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabjab.de>
;; Maintainer: contrapunctus <xmpp:contrapunctus@jabjab.de>
;; Keywords: calendar
;; Homepage: https://tildegit.org/contrapunctus/chronometrist
;; Package-Requires: ((emacs "24.3") (chronometrist "0.9.0") (emacsql-sqlite "1.0.0"))
;; Version: 0.1.0
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
"Commentary" is displayed when the user clicks on the package's entry in M-x list-packages.
;;; Commentary:
;;
;; This package provides an SQLite 3 backend for Chronometrist.Dependencies
;;; Code:
(require 'chronometrist)
(require 'emacsql-sqlite)Code
class
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
((extension :initform "sqlite"
:accessor chronometrist-backend-ext
:custom 'string)
(connection :initform nil
:initarg :connection
:accessor chronometrist-backend-connection)))
(chronometrist-register-backend
:sqlite "Store records in SQLite database."
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))initialize-instance method
(cl-defmethod initialize-instance :after ((backend chronometrist-sqlite-backend)
&rest _initargs)
"Initialize connection for BACKEND based on its file."
(with-slots (file connection) backend
(when (and file (not connection))
(setf connection (emacsql-sqlite file)))))create-file
(cl-defmethod chronometrist-create-file ((backend chronometrist-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 (chronometrist-backend-connection backend)
(setf (chronometrist-backend-connection backend)
(emacsql-sqlite file)))))
(cl-loop
for query in
'(;; Properties are user-defined key-values stored as JSON.
[:create-table properties
([(prop-id integer :primary-key)
(properties text :unique :not-null)])]
;; An event is a timestamp with a name and optional properties.
[:create-table event-names
([(name-id integer :primary-key)
(name text :unique :not-null)])]
[:create-table events
([(event-id integer :primary-key)
(name-id integer :not-null :references event-names [name-id])])]
;; An interval is a time range with a name and optional properties.
[:create-table interval-names
([(name-id integer :primary-key)
(name text :unique :not-null)])]
[:create-table intervals
([(interval-id integer :primary-key)
(name-id integer :not-null :references interval-names [name-id])
(start-time integer :not-null)
;; The latest interval may be ongoing, so the stop time may be NULL.
(stop-time integer)
(prop-id integer :references properties [prop-id])]
(:unique [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 integer :primary-key)
(date integer :unique :not-null)
(prop-id integer :references properties [prop-id])])]
[:create-table date-events
([(date-id integer :not-null :references dates [date-id])
(event-id integer :not-null :references events [event-id])])]
[:create-table date-intervals
([(date-id integer :not-null :references dates [date-id])
(interval-id integer :not-null :references intervals [interval-id])])])
do (emacsql db query)
finally return db)))iso-to-unix function
(defun chronometrist-iso-to-unix (timestamp)
(truncate (float-time (parse-iso8601-time-string timestamp))))to-file method
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
(with-slots (connection) backend
(delete-file file)
(when connection (emacsql-close connection))
(setf connection nil)
(chronometrist-create-file backend file)
(cl-loop for date in (sort (hash-table-keys hash-table) #'string-lessp) do
;; insert date if it does not exist
(emacsql connection [:insert-or-ignore-into dates [date] :values [$s1]]
(chronometrist-iso-to-unix date))
(cl-loop for plist in (gethash date hash-table) do
(chronometrist-insert backend plist)))))insert-properties writer
(defun chronometrist-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))
(props (if (functionp chronometrist-sqlite-properties-function)
(funcall chronometrist-sqlite-properties-function plist)
plist)))
(emacsql connection
[:insert-or-ignore-into properties [properties] :values [$s1]]
props)
(caar (emacsql connection [:select [prop-id]
:from properties
:where (= properties $s1)]
props)))))properties-to-json function
(defun chronometrist-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 ((chronometrist-pp-pair-p elt)
(vector (car elt) (cdr elt)))
((consp elt)
(vconcat elt))
(t elt)))
plist)))properties-function custom variable
(defcustom chronometrist-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."
:type '(choice function (sexp :tag "Insert as s-expressions")))insert
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
(-let (((plist-1 plist-2) (chronometrist-split-plist plist))
(db (chronometrist-backend-connection backend)))
(cl-loop for plist in (if (and plist-1 plist-2)
(list plist-1 plist-2)
(list plist))
do
(-let* (((&plist :name name :start start :stop stop) plist)
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
(start-unix (chronometrist-iso-to-unix start))
(stop-unix (and stop (chronometrist-iso-to-unix stop)))
name-id interval-id prop-id)
;; insert name if it does not exist
(emacsql db [:insert-or-ignore-into interval-names [name]
:values [$s1]]
name)
;; insert interval properties if they do not exist
(setq prop-id (chronometrist-sqlite-insert-properties backend plist))
;; insert interval and associate it with the date
(setq name-id
(caar (emacsql db [:select [name-id]
:from interval-names
:where (= name $s1)]
name)))
(emacsql db [:insert-or-ignore-into intervals
[name-id start-time stop-time prop-id]
:values [$s1 $s2 $s3 $s4]]
name-id start-unix stop-unix prop-id)
(emacsql db [:insert-or-ignore-into dates [date]
:values [$s1]] date-unix)
(setq date-id
(caar (emacsql db [:select [date-id] :from dates
:where (= date $s1)]
date-unix))
interval-id
(caar (emacsql db [:select (funcall max interval-id) :from intervals])))
(emacsql db [:insert-into date-intervals [date-id interval-id]
:values [$s1 $s2]]
date-id interval-id)))))open-file
(cl-defmethod chronometrist-edit-backend ((backend chronometrist-sqlite-backend))
(require 'sql)
(switch-to-buffer
(sql-comint-sqlite 'sqlite (list file))))latest-record
;; SELECT * FROM TABLE WHERE ID = (SELECT MAX(ID) FROM TABLE);
;; SELECT * FROM tablename ORDER BY column DESC LIMIT 1;
(cl-defmethod chronometrist-latest-record ((backend chronometrist-sqlite-backend) db)
(emacsql db [:select * :from events :order-by rowid :desc :limit 1]))task-records-for-date
(cl-defmethod chronometrist-task-records-for-date ((backend chronometrist-sqlite-backend) task date-ts))active-days
(cl-defmethod chronometrist-active-days ((backend chronometrist-sqlite-backend) task))replace-last
(cl-defmethod chronometrist-replace-last ((backend chronometrist-sqlite-backend) plist)
(emacsql db [:delete-from events :where ]))Provide
(provide 'chronometrist-sqlite)
;;; chronometrist-sqlite.el ends here