diff --git a/org-clock-agg.el b/org-clock-agg.el index 448b01d..044ba12 100644 --- a/org-clock-agg.el +++ b/org-clock-agg.el @@ -35,6 +35,8 @@ ;; Reset org-ql cache (setq org-ql-cache (make-hash-table :weakness 'key)) +;;; Querying + (defun org-clock-agg--parse-clocks (headline) (let ((contents (buffer-substring-no-properties (org-element-property :contents-begin headline) @@ -44,18 +46,17 @@ (let (res) (org-element-map (org-element-parse-buffer) 'clock (lambda (clock) - (let ((start ) + (let ((start (time-convert + (org-timestamp-to-time (org-element-property :value clock)) + 'integer)) (end (time-convert (org-timestamp-to-time (org-element-property :value clock) t) - 'integer)))) - (push - `((:start . ,(time-convert - (org-timestamp-to-time (org-element-property :value clock)) - 'integer)) - (:end . ,(time-convert - (org-timestamp-to-time (org-element-property :value clock) t) - 'integer))) - res)) + 'integer))) + (push + `((:start . ,start) + (:end . ,end) + (:duration . ,(- end start))) + res))) nil nil 'headline) res)))) @@ -73,23 +74,107 @@ #'substring-no-properties (org-ql--outline-path))) (category (org-get-category))) - `((:headline . ,headline) - (:tags . ,tags) - (:file . ,file) - (:outline-path . ,outline-path) - (:category . ,category) - (:clocks . ,(org-clock-agg--parse-clocks headline))))) + (org-ql--add-markers headline) + ;; Just to make the output more tolerable + ;; (setf + ;; (plist-get (cadr (alist-get :headline headline)) :todo-keyword) + ;; (substring-no-properties + ;; (plist-get (cadr (alist-get :headline headline)) :todo-keyword))) + (cl-loop for clock in (org-clock-agg--parse-clocks headline) + collect`(,@clock + (:headline . ,headline) + (:tags . ,tags) + (:file . ,file) + (:outline-path . ,outline-path) + (:category . ,category))))) (defun org-clock-agg--query (from to files) - (org-ql-query - :select #'org-clock-agg--parse-headline - :from files - :where `(clocked :from ,from :to ,to))) + (cl-loop for res in (org-ql-query + :select #'org-clock-agg--parse-headline + :from files + :where `(clocked :from ,from :to ,to)) + append res)) +;;; Aggregation +(defvar org-clock-agg-groupby nil + "Group by functions.") -(defun org-clock-agg () - (interactive) - ()) +(cl-defmacro org-clock-agg-defgroupby (name doc &body body) + (declare (indent defun) + (doc-string 2)) + (let ((func-name (intern (concat "org-clock-agg--groupby-" (symbol-name name)))) + readable-name + hidden) + ;; Parse keyword arguments in BODY + (while-let ((symbol (and + (member (car-safe body) '(:hidden :readable-name)) + (car-safe body)))) + (when (eq :hidden symbol) + (setq hidden (cadr body))) + (when (eq :readable-name symbol) + (setq readable-name (cadr body))) + (setq body (cddr body))) + `(progn + (defun ,func-name (elem) + ,doc + ,@body) + (push (cons ',name '((:function . ,func-name) + (:hidden . ,hidden) + (:readable-name . ,(or readable-name + (symbol-name name))))) + org-clock-agg-groupby)))) + +(org-clock-agg-defgroupby category + "Group org-clock entries by category." + (list (alist-get :category elem))) + +(org-clock-agg-defgroupby org-file + "Group org-clock entries by file in `org-directory'." + (list + (file-relative-name (alist-get :file elem) + (directory-file-name org-directory)))) + +(org-clock-agg-defgroupby outline-path + "Group org-clock entries by outline path." + (alist-get :outline-path elem)) + +(org-clock-agg-defgroupby root--group + "Return \"Root\". Used for the root group." + :hidden t + (list "Root")) + +(defun org-clock-agg--groupby-apply (alist groups elem) + (let* ((key (caar groups)) + (groupby (cdar groups)) + (rest (cdr groups)) + (duration (alist-get :duration elem)) + (prev-val (alist-get key alist nil nil #'equal))) + (when key + (setf (alist-get key alist nil nil #'equal) + `((:total . ,(+ duration (or (alist-get :total prev-val) 0))) + (:groupby . ,groupby) + (:children . ,(org-clock-agg--groupby-apply + (alist-get :children prev-val) rest elem)) + (:elems . ,(if rest + (alist-get :elems prev-val) + (cons elem (alist-get :elems prev-val)))))))) + alist) + +(defun org-clock-agg--groupby (elems groupby-list) + (let (res) + (dolist (elem elems) + (let* ((group-symbols (cons 'root--group groupby-list)) + (groups + (cl-loop for group-symbol in group-symbols + for groupby = (alist-get group-symbol org-clock-agg-groupby) + for group-values = (funcall (alist-get :function groupby) elem) + append + (mapcar + (lambda (group-value) + (cons group-value groupby)) + group-values)))) + (setq res (org-clock-agg--groupby-apply res groups elem)))) + res)) (provide 'org-clock-agg) ;;; org-clock-agg.el ends here