org-clock-agg: aggregate works

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