#+TITLE: chronometrist-sqlite #+AUTHOR: contrapunctus #+SUBTITLE: SQLite backend for Chronometrist #+PROPERTY: header-args :tangle yes :load yes * Library headers and commentary #+BEGIN_SRC emacs-lisp ;;; chronometrist-sqlite.el --- SQLite backend for Chronometrist -*- lexical-binding: t; -*- ;; Author: contrapunctus ;; Maintainer: contrapunctus ;; 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 #+END_SRC "Commentary" is displayed when the user clicks on the package's entry in =M-x list-packages=. #+BEGIN_SRC emacs-lisp ;;; Commentary: ;; ;; This package provides an SQLite 3 backend for Chronometrist. #+END_SRC * Dependencies #+BEGIN_SRC emacs-lisp ;;; Code: (require 'chronometrist) (require 'emacsql-sqlite) #+END_SRC * Code ** class #+BEGIN_SRC emacs-lisp (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)) #+END_SRC ** initialize-instance :method: #+BEGIN_SRC emacs-lisp (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))))) #+END_SRC ** create-file #+BEGIN_SRC emacs-lisp (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))) #+END_SRC ** iso-to-unix :function: #+BEGIN_SRC emacs-lisp (defun chronometrist-iso-to-unix (timestamp) (truncate (float-time (parse-iso8601-time-string timestamp)))) #+END_SRC ** to-file :method: #+BEGIN_SRC emacs-lisp (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))))) #+END_SRC ** insert-properties :writer: #+BEGIN_SRC emacs-lisp (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))))) #+END_SRC *** properties-to-json :function: #+BEGIN_SRC emacs-lisp (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))) #+END_SRC *** properties-function :custom:variable: #+BEGIN_SRC emacs-lisp (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"))) #+END_SRC ** insert #+BEGIN_SRC emacs-lisp (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))))) #+END_SRC ** open-file #+BEGIN_SRC emacs-lisp (cl-defmethod chronometrist-edit-backend ((backend chronometrist-sqlite-backend)) (require 'sql) (switch-to-buffer (sql-comint-sqlite 'sqlite (list file)))) #+END_SRC ** latest-record #+BEGIN_SRC emacs-lisp ;; 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])) #+END_SRC ** task-records-for-date #+BEGIN_SRC emacs-lisp (cl-defmethod chronometrist-task-records-for-date ((backend chronometrist-sqlite-backend) task date-ts)) #+END_SRC ** active-days #+BEGIN_SRC emacs-lisp (cl-defmethod chronometrist-active-days ((backend chronometrist-sqlite-backend) task)) #+END_SRC ** replace-last #+BEGIN_SRC emacs-lisp (cl-defmethod chronometrist-replace-last ((backend chronometrist-sqlite-backend) plist) (emacsql db [:delete-from events :where ])) #+END_SRC ** Provide #+BEGIN_SRC emacs-lisp (provide 'chronometrist-sqlite) ;;; chronometrist-sqlite.el ends here #+END_SRC * Local variables :noexport: # Local Variables: # eval: (when (or (package-installed-p 'emacsql) (featurep 'emacsql)) (require 'emacsql) (emacsql-fix-vector-indentation)) # eval: (when (or (package-installed-p 'literate-elisp) (featurep 'literate-elisp)) (require 'literate-elisp) (literate-elisp-load (buffer-file-name))) # End: