contrapunctus
/
chronometrist
Archived
1
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

Refactor get-day (SQLite)

This commit is contained in:
contrapunctus 2022-04-18 22:45:08 +05:30
parent 0021f92e29
commit cf50c5beaf
1 changed files with 58 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
cl/chronometrist.org
View File

@ -2172,6 +2172,24 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
(make-instance 'sqlite-backend))
#+END_SRC
**** execute-sxql :function:
#+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:
#+BEGIN_SRC lisp
(defmethod chronometrist:create-file ((backend sqlite-backend) &optional file)
@ -2250,52 +2268,46 @@ ORDER BY interval_id DESC;")
**** 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 (name start stop properties)
in (multiple-value-bind (string values)
(yield
(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)))))))
(apply #'execute-to-list connection string values))
collect (make-instance 'chronometrist:interval
:activity name
:start start
:stop stop
:properties (when properties
(read-from-string properties)))))
(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
intervals)))
(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))
(intervals
(loop for (name start stop properties)
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-instance 'chronometrist:interval
:activity name
:start start
:stop stop
:properties (when properties
(read-from-string properties)))))
(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
intervals))
#+END_SRC
**** iso-to-unix :function: