Replace clsql with cl-sqlite
This commit is contained in:
contrapunctus
parent
e21c85e543
commit
33ac4243f4
|
|
@ -2048,13 +2048,11 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
|
|||
#+BEGIN_SRC lisp
|
||||
(in-package :cl)
|
||||
(defpackage :chronometrist.sqlite
|
||||
(:use :cl :trivia)
|
||||
(:use :cl :trivia :sqlite)
|
||||
(:import-from :chronometrist
|
||||
:backend :file-backend-mixin :backend-file :register-backend
|
||||
:*user-data-file*
|
||||
:split-plist :iso-to-date :plist-key-values)
|
||||
(:import-from :clsql :disconnect
|
||||
:select :query :execute-command :insert-records)
|
||||
(:import-from :alexandria :hash-table-keys)
|
||||
(:import-from :local-time :parse-timestring :timestamp-to-unix)
|
||||
(:import-from :uiop :strcat)
|
||||
|
|
@ -2066,6 +2064,15 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
|
|||
(in-package :chronometrist.sqlite)
|
||||
#+END_SRC
|
||||
|
||||
**** aliases
|
||||
#+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:
|
||||
#+BEGIN_SRC lisp
|
||||
(defclass sqlite-backend (backend file-backend-mixin)
|
||||
|
|
@ -2078,12 +2085,6 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
|
|||
(make-instance 'sqlite-backend))
|
||||
#+END_SRC
|
||||
|
||||
**** connect :procedure:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun connect (file)
|
||||
(clsql:connect (list file) :database-type :sqlite3 :if-exists :old))
|
||||
#+END_SRC
|
||||
|
||||
**** initialize-instance :method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defmethod initialize-instance :after ((backend sqlite-backend) &rest initargs)
|
||||
|
|
@ -2160,7 +2161,7 @@ FROM intervals
|
|||
LEFT JOIN interval_names USING (name_id)
|
||||
LEFT JOIN properties USING (prop_id)
|
||||
ORDER BY interval_id DESC;")
|
||||
do (execute-command expr)
|
||||
do (execute-non-query db expr)
|
||||
finally (return db))))
|
||||
#+END_SRC
|
||||
|
||||
|
|
@ -2198,13 +2199,14 @@ Alternative to the above
|
|||
(defmethod to-file (hash-table (backend sqlite-backend) file)
|
||||
(with-slots (connection) backend
|
||||
(delete-file file)
|
||||
(disconnect :database connection)
|
||||
(disconnect connection)
|
||||
(setf connection nil)
|
||||
(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-command
|
||||
(format nil "INSERT OR IGNORE INTO dates (date) VALUES (~s);" (iso-to-unix date)))
|
||||
(execute-non-query connection
|
||||
"INSERT OR IGNORE INTO dates (date) VALUES (?);"
|
||||
(iso-to-unix date))
|
||||
(loop for plist in (gethash date hash-table) do
|
||||
(insert backend plist)))))
|
||||
#+END_SRC
|
||||
|
|
@ -2229,17 +2231,15 @@ prop-id of the inserted or existing property."
|
|||
(encoded-properties
|
||||
(if (functionp *sqlite-properties-function*)
|
||||
(funcall *sqlite-properties-function* plist)
|
||||
(str:replace-all "'" "''"
|
||||
(write-to-string plist :escape t
|
||||
:pretty nil
|
||||
:readably t)))))
|
||||
(write-to-string plist :escape t :pretty nil :readably t))))
|
||||
;; (format t "properties: ~s~%" encoded-properties)
|
||||
(when plist
|
||||
(execute-command (strcat "INSERT OR IGNORE INTO properties (properties)
|
||||
VALUES ('" encoded-properties "');"))
|
||||
(caar (query (strcat "SELECT (prop_id) FROM properties WHERE properties = "
|
||||
encoded-properties
|
||||
";")))))))
|
||||
(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:
|
||||
|
|
@ -2273,7 +2273,8 @@ s-expressions in a text column.")
|
|||
**** insert :writer:method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defmethod insert ((backend sqlite-backend) plist &key &allow-other-keys)
|
||||
(let-match (((or (list plist-1 plist-2) nil) (split-plist plist)))
|
||||
(let-match (((or (list plist-1 plist-2) nil) (split-plist plist))
|
||||
(connection (backend-connection backend)))
|
||||
(loop
|
||||
for plist in (if (and plist-1 plist-2)
|
||||
(list plist-1 plist-2)
|
||||
|
|
@ -2288,28 +2289,35 @@ s-expressions in a text column.")
|
|||
(interval-id)
|
||||
(date-id))
|
||||
;; insert name if it does not exist
|
||||
(execute-command
|
||||
(format nil "INSERT OR IGNORE INTO interval_names (name) VALUES ('~a');"
|
||||
name))
|
||||
(execute-non-query
|
||||
connection
|
||||
"INSERT OR IGNORE INTO interval_names (name) VALUES (?);"
|
||||
name)
|
||||
(setq name-id
|
||||
(caar (query (format nil "SELECT (name_id) FROM interval_names WHERE name = '~a';"
|
||||
name))))
|
||||
(execute-single
|
||||
connection
|
||||
"SELECT (name_id) FROM interval_names WHERE name = ?;"
|
||||
name))
|
||||
;; insert an interval...
|
||||
(execute-command
|
||||
(format nil "INSERT OR IGNORE INTO intervals
|
||||
(name_id, start_time, stop_time, prop_id)
|
||||
VALUES (~a, ~a, ~a, ~a);" name-id start-unix stop-unix (or prop-id "NULL")))
|
||||
(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
|
||||
(caar (query (format nil "SELECT (interval_id) FROM intervals WHERE start_time = ~a AND stop_time = ~a;"
|
||||
start-unix stop-unix))))
|
||||
(execute-single connection
|
||||
"SELECT (interval_id) FROM intervals WHERE start_time = ?;"
|
||||
start-unix))
|
||||
;; ...and associate it with the date
|
||||
(execute-command
|
||||
(format nil "INSERT OR IGNORE INTO dates (date) VALUES (~a);" date-unix))
|
||||
(execute-non-query connection
|
||||
"INSERT OR IGNORE INTO dates (date) VALUES (?);"
|
||||
date-unix)
|
||||
(setq date-id
|
||||
(caar (query (format nil "SELECT (date_id) FROM dates WHERE date = ~a;" date-unix))))
|
||||
(execute-command
|
||||
(format nil "INSERT INTO date_intervals (date_id, interval_id)
|
||||
VALUES (~a, ~a);" date-id interval-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
|
||||
|
||||
**** open-file
|
||||
|
|
|
|||
Reference in New Issue