Rename `get` to `get-day`, implement SQLite method (WIP)
This commit is contained in:
contrapunctus
parent
998ea0f94e
commit
94e7a78404
|
|
@ -409,20 +409,25 @@ Use =org-babel= (=org-babel-tangle= / =org-babel-tangle-file=), /not/ =literate-
|
|||
:*weekday-number-alist* :*active-backend*
|
||||
:*sexp-pretty-print-function* :*task-list*
|
||||
:*sqlite-properties-function*
|
||||
;; classes
|
||||
:backend :day :interval :event
|
||||
:properties :date :intervals :events
|
||||
;; protocol
|
||||
:backend :*backends-alist* :active-backend :register-backend
|
||||
:*backends-alist* :active-backend :register-backend
|
||||
:backend-file
|
||||
:task-list
|
||||
:view-backend :edit-backend
|
||||
:backend-empty-p :backend-modified-p
|
||||
:create-file :latest-date-records
|
||||
:backend-run-assertions
|
||||
:insert :remove-last :replace-last
|
||||
:create-file
|
||||
:get-day :insert-day :remove-day
|
||||
:on-change :on-add :on-modify :on-remove
|
||||
:latest-record :task-records-for-date
|
||||
: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
|
||||
;; debugging
|
||||
|
|
@ -994,7 +999,7 @@ return a list of tasks from the active backend."
|
|||
:type string
|
||||
:documentation "The name of this event.")
|
||||
(time :initarg :time
|
||||
:accessor 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."))
|
||||
|
|
@ -1043,15 +1048,16 @@ Use FILE as a path, if provided.
|
|||
Return path of new file if successfully created, and nil if it already exists."))
|
||||
#+END_SRC
|
||||
|
||||
**** get :generic:function:
|
||||
**** get-day :generic:function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric get (date backend)
|
||||
(:documentation "Return day associated with DATE from BACKEND, or nil if no such day exists."))
|
||||
(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 :generic:function:
|
||||
**** insert-day :generic:function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric insert (backend plist &key &allow-other-keys)
|
||||
(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.
|
||||
|
||||
|
|
@ -1063,6 +1069,13 @@ PLIST may be an interval which crosses days."))
|
|||
(error "Not a valid plist: %S" plist)))
|
||||
#+END_SRC
|
||||
|
||||
**** remove-day :generic:function:
|
||||
#+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:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric remove-last (backend &key &allow-other-keys)
|
||||
|
|
@ -1724,12 +1737,6 @@ Concerns specific to the plist group backend -
|
|||
(:export
|
||||
:plist-group-backend
|
||||
:make-plist-group-backend
|
||||
;; protocol
|
||||
:latest-date-records
|
||||
:insert :remove-last
|
||||
:to-list :to-hash-table :to-file
|
||||
:on-add :on-modify :on-remove
|
||||
:verify
|
||||
;; customizable variables
|
||||
))
|
||||
(in-package :chronometrist.plist-group)
|
||||
|
|
@ -1785,6 +1792,7 @@ Situations -
|
|||
2. insert into new group
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
#+(or)
|
||||
(defmethod insert ((backend plist-group-backend) plist
|
||||
&key (save t)
|
||||
&allow-other-keys)
|
||||
|
|
@ -2113,15 +2121,15 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
|
|||
(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
|
||||
(:import-from :sxql :yield
|
||||
:create-table :foreign-key :unique-key
|
||||
:insert-into
|
||||
:select := :set= :from :order-by)
|
||||
:insert-into :select := :set= :from :order-by :where
|
||||
:left-join :limit)
|
||||
(:import-from :alexandria :flatten)
|
||||
(:import-from :trivia :let-match :let-match* :plist)
|
||||
(:export :sqlite-backend
|
||||
|
|
@ -2153,10 +2161,11 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
|
|||
(defmethod initialize-instance :after ((backend sqlite-backend) &rest initargs)
|
||||
"Initialize connection for BACKEND based on its file."
|
||||
(declare (ignore initargs))
|
||||
(with-slots (connection) backend
|
||||
(with-slots (connection file) backend
|
||||
(let ((file (chronometrist:backend-file backend)))
|
||||
(when (not connection)
|
||||
(setf connection (connect file))))))
|
||||
(setf connection (connect file)
|
||||
file file)))))
|
||||
|
||||
(chronometrist:register-backend
|
||||
:sqlite "Store records in SQLite database."
|
||||
|
|
@ -2186,6 +2195,7 @@ Return the connection object from `emacsql-sqlite'."
|
|||
(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)))
|
||||
|
|
@ -2237,6 +2247,41 @@ ORDER BY interval_id DESC;")
|
|||
(return db))))
|
||||
#+END_SRC
|
||||
|
||||
**** get-day :method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defmethod chronometrist:get-day (date (backend sqlite-backend))
|
||||
(with-slots (connection) backend
|
||||
(let-match*
|
||||
((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))
|
||||
(interval-ids
|
||||
(flatten (execute-to-list
|
||||
connection
|
||||
"SELECT interval_id FROM date_intervals WHERE date_id = ?;"
|
||||
date-id)))
|
||||
(intervals
|
||||
(loop for id in interval-ids
|
||||
collect (execute-single
|
||||
connection
|
||||
"SELECT name, start_time, stop_time, properties FROM intervals")))
|
||||
(event-ids
|
||||
(flatten (execute-to-list
|
||||
connection
|
||||
"SELECT event_id FROM date_events WHERE date_id = ?;"
|
||||
date-id)))
|
||||
(properties
|
||||
(execute-single connection
|
||||
"SELECT properties FROM properties WHERE prop_id = ?"
|
||||
prop-id)))
|
||||
(setf (chronometrist:date day) date
|
||||
;; (intervals day) intervals
|
||||
;; (events day) events
|
||||
(chronometrist:properties day) properties)
|
||||
day)))
|
||||
#+END_SRC
|
||||
|
||||
**** iso-to-unix :function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun iso-to-unix (timestamp)
|
||||
|
|
@ -2257,7 +2302,7 @@ ORDER BY interval_id DESC;")
|
|||
"INSERT OR IGNORE INTO dates (date) VALUES (?);"
|
||||
(iso-to-unix date))
|
||||
(loop for plist in (gethash date hash-table) do
|
||||
(chronometrist:insert backend plist)))))
|
||||
(chronometrist:insert-day backend plist)))))
|
||||
#+END_SRC
|
||||
|
||||
**** to-list :reader:method:
|
||||
|
|
@ -2321,7 +2366,7 @@ s-expressions in a text column.")
|
|||
|
||||
**** insert :writer:method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defmethod chronometrist:insert
|
||||
(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))
|
||||
|
|
@ -2412,7 +2457,8 @@ s-expressions in a text column.")
|
|||
|
||||
**** replace-last
|
||||
#+BEGIN_SRC lisp
|
||||
(defmethod chronometrist:replace-last ((backend sqlite-backend) plist &key &allow-other-keys)
|
||||
(defmethod chronometrist:replace-last ((backend sqlite-backend)
|
||||
plist &key &allow-other-keys)
|
||||
(emacsql db ;; [:delete-from events :where ]
|
||||
))
|
||||
#+END_SRC
|
||||
|
|
|
|||
Reference in New Issue