Have task-records-for-date return intervals
This commit is contained in:
contrapunctus
parent
07498b39c5
commit
900dbd9742
|
|
@ -995,6 +995,15 @@ return a list of tasks from the active backend."
|
|||
optional properties."))
|
||||
#+END_SRC
|
||||
|
||||
***** make-interval :constructor:function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun make-interval (name start &optional stop properties-string)
|
||||
(make-instance 'chronometrist:interval
|
||||
:name name :start start :stop stop
|
||||
:properties (when properties-string
|
||||
(read-from-string properties-string))))
|
||||
#+END_SRC
|
||||
|
||||
**** event :class:
|
||||
#+BEGIN_SRC lisp
|
||||
(defclass event ()
|
||||
|
|
@ -1103,13 +1112,21 @@ entire (unsplit) record must be returned."))
|
|||
|
||||
**** task-records-for-date :generic:function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric task-records-for-date (backend task date-ts &key &allow-other-keys)
|
||||
(declaim (ftype (function (chronometrist:backend
|
||||
string integer &key &allow-other-keys))
|
||||
chronometrist:task-records-for-date))
|
||||
(defgeneric task-records-for-date (backend task date &key &allow-other-keys)
|
||||
(:documentation "From BACKEND, return records for TASK on DATE-TS as a list of plists.
|
||||
DATE-TS must be a `ts.el' struct.
|
||||
|
||||
Return nil if BACKEND contains no records."))
|
||||
#+END_SRC
|
||||
|
||||
(defmethod task-records-for-date :before ((_backend t) task date-ts &key &allow-other-keys)
|
||||
***** task-records-for-date :before:method:
|
||||
#+BEGIN_SRC lisp
|
||||
#+(or)
|
||||
(defmethod task-records-for-date :before
|
||||
((_backend t) task date-ts &key &allow-other-keys)
|
||||
(unless (typep task 'string)
|
||||
(error "task %S is not a string" task))
|
||||
(unless (typep date-ts 'ts)
|
||||
|
|
@ -2132,18 +2149,26 @@ We apply the same hack as in the [[hack-note-plist-group-insert][insert]] method
|
|||
(in-package :cl)
|
||||
(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 :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 :where
|
||||
:left-join :limit)
|
||||
(:import-from :alexandria :flatten)
|
||||
(:import-from :trivia :let-match :let-match* :plist)
|
||||
(:import-from :alexandria
|
||||
:flatten)
|
||||
(:import-from :trivia
|
||||
:let-match :let-match* :plist)
|
||||
(:import-from :chronometrist
|
||||
:make-interval)
|
||||
(:export :sqlite-backend
|
||||
;; customizable variables
|
||||
))
|
||||
|
|
@ -2295,7 +2320,7 @@ ORDER BY interval_id DESC;")
|
|||
connection))))
|
||||
(setf (chronometrist:date day) date
|
||||
(chronometrist:intervals day)
|
||||
(loop for (name start stop properties)
|
||||
(loop for (name start stop prop-string)
|
||||
in (execute-sxql
|
||||
#'execute-to-list
|
||||
(select (:name :start_time :stop_time :properties)
|
||||
|
|
@ -2307,12 +2332,7 @@ ORDER BY interval_id DESC;")
|
|||
(from :date_intervals)
|
||||
(where (:= :date_id date-id))))))
|
||||
connection)
|
||||
collect (make-instance 'chronometrist:interval
|
||||
:name name
|
||||
:start start
|
||||
:stop stop
|
||||
:properties (when properties
|
||||
(read-from-string properties))))
|
||||
collect (make-interval name start stop prop-string))
|
||||
(chronometrist:events day)
|
||||
(loop for (name time properties)
|
||||
in (execute-sxql
|
||||
|
|
@ -2503,20 +2523,23 @@ s-expressions in a text column.")
|
|||
#+BEGIN_SRC lisp
|
||||
(defmethod chronometrist:task-records-for-date
|
||||
((backend sqlite-backend) task date &key &allow-other-keys)
|
||||
(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 (:and
|
||||
(:in :interval_id
|
||||
(select (:interval_id)
|
||||
(from :date_intervals)
|
||||
(where (:= :date_id
|
||||
(select (:date_id)
|
||||
(from :dates)
|
||||
(where (:= :date date)))))))
|
||||
(:= :name task))))))
|
||||
(let ((list (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 (:and
|
||||
(:in :interval_id
|
||||
(select (:interval_id)
|
||||
(from :date_intervals)
|
||||
(where (:= :date_id
|
||||
(select (:date_id)
|
||||
(from :dates)
|
||||
(where (:= :date date)))))))
|
||||
(:= :name task))))
|
||||
(backend-connection backend))))
|
||||
(loop for (name start stop prop-string) in list
|
||||
collect (make-interval name start stop prop-string))))
|
||||
#+END_SRC
|
||||
|
||||
**** active-days
|
||||
|
|
|
|||
Reference in New Issue