[report-utilities][API] gnc:account-accumulate-at-dates

this is a generalised form from gnc:account-get-balances-at-dates to
accumulate a list from report dates.

this function will scan through account splitlist, processing each
split via split->elt, accumulating results at date boundaries into the
results list. it uses ice-9 match for conciseness.

in: acc   - account
    dates - a list of time64
    split->elt - an unary lambda. the result of calling (split->elt split)
                 will be accumulated onto the resulting list. by
                 default it returns the last split-balance before
                 date boundary, similar to gnc:account-get-balances-at-dates

out: (list elt0 elt1 ...), each entry is the result of split->elt

gnucash/report/report-system/report-system.scm

@@ -698,6 +698,7 @@
 (export gnc:commodity-collector-get-negated)
 (export gnc:commodity-collectorlist-get-merged) ;deprecated
 (export gnc-commodity-collector-commodity-count)
+(export gnc:account-accumulate-at-dates)
 (export gnc:account-get-balance-at-date)
 (export gnc:account-get-balances-at-dates)
 (export gnc:account-get-comm-balance-at-date)

gnucash/report/report-system/report-utilities.scm

@@ -19,6 +19,7 @@
 
 (use-modules (srfi srfi-13))
 (use-modules (ice-9 format))
+(use-modules (ice-9 match))
 
 (define (list-ref-safe list elt)
   (and (> (length list) elt)
@@ -468,53 +469,63 @@ flawed. see report-utilities.scm. please update reports.")
 (define* (gnc:account-get-balances-at-dates
           account dates-list #:key (split->amount xaccSplitGetAmount))
   (define (amount->monetary bal)
-    (gnc:make-gnc-monetary (xaccAccountGetCommodity account) bal))
+    (gnc:make-gnc-monetary (xaccAccountGetCommodity account) (or bal 0)))
-  (let loop ((splits (xaccAccountGetSplitList account))
+  (define balance 0)
-             (dates-list (sort dates-list <))
+  (map amount->monetary
-             (currentbal 0)
+       (gnc:account-accumulate-at-dates
-             (lastbal 0)
+        account dates-list #:split->elt
-             (balancelist '()))
+        (lambda (s)
-    (cond
+          (if s (set! balance (+ balance (or (split->amount s) 0))))
+          balance))))
 
-     ;; end of dates. job done!
-     ((null? dates-list)
-      (map amount->monetary (reverse balancelist)))
 
-     ;; end of splits, but still has dates. pad with last-bal
+;; this function will scan through account splitlist, building a list
-     ;; until end of dates.
+;; of split->elt results along the way at dates specified in dates.
-     ((null? splits)
+;; in: acc   - account
-      (loop '()
+;;     dates - a list of time64 -- it will be sorted
-            (cdr dates-list)
+;;     split->date - an unary lambda. result to compare with dates list.
-            currentbal
+;;     split->elt - an unary lambda. it will be called successfully for each
-            lastbal
+;;                  split in the account until the last date. the result
-            (cons lastbal balancelist)))
+;;                  will be accumulated onto the resulting list. the default
+;;                  xaccSplitGetBalance makes it similar to
+;;                  gnc:account-get-balances-at-dates.
+;; out: (list elt0 elt1 ...), each entry is the result of split->elt
+(define* (gnc:account-accumulate-at-dates
+          acc dates #:key
+          (split->date (compose xaccTransGetDate xaccSplitGetParent))
+          (split->elt xaccSplitGetBalance))
+  (let lp ((splits (xaccAccountGetSplitList acc))
+           (dates (sort dates <))
+           (result '())
+           (last-result #f))
+    (match dates
 
-     (else
+      ;; end of dates. job done!
-      (let* ((this (car splits))
+      (() (reverse result))
-             (rest (cdr splits))
-             (currentbal (+ (or (split->amount this) 0) currentbal))
-             (next (and (pair? rest) (car rest))))
 
-        (cond
+      ((date . rest)
-         ;; the next split is still before date
+       (match splits
-         ((and next (< (xaccTransGetDate (xaccSplitGetParent next)) (car dates-list)))
-          (loop rest dates-list currentbal lastbal balancelist))
 
-         ;; this split after date, add previous bal to balancelist
+         ;; end of splits, but still has dates. pad with last-result
-         ((< (car dates-list) (xaccTransGetDate (xaccSplitGetParent this)))
+         ;; until end of dates.
-          (loop splits
+         (() (lp '() rest (cons last-result result) last-result))
-                (cdr dates-list)
-                lastbal
-                lastbal
-                (cons lastbal balancelist)))
 
-         ;; this split before date, next split after date, or end.
+         ((head . tail)
-         (else
+          (let ((next (and (pair? tail) (car tail))))
-          (loop rest
+            (cond
-                (cdr dates-list)
+
-                currentbal
+             ;; the next split is still before date.
-                currentbal
+             ((and next (< (split->date next) date))
-                (cons currentbal balancelist)))))))))
+              (lp tail dates result (split->elt head)))
+
+             ;; head split after date, accumulate previous result
+             ((< date (split->date head))
+              (lp splits rest (cons last-result result) last-result))
+
+             ;; head split before date, next split after date, or end.
+             (else
+              (let ((head-result (split->elt head)))
+                (lp tail rest (cons head-result result) head-result)))))))))))
 
 ;; This works similar as above but returns a commodity-collector, 
 ;; thus takes care of children accounts with different currencies.

gnucash/report/report-system/test/test-report-utilities.scm

@@ -653,6 +653,11 @@
            (dates (gnc:make-date-list (gnc-dmy2time64 01 01 1970)
                                       (gnc-dmy2time64 01 04 1970)
                                       MonthDelta)))
+
+      (test-equal "empty account"
+        '(#f #f #f #f)
+        (gnc:account-accumulate-at-dates bank1 dates))
+
       (env-transfer env 15 01 1970 income bank1 10)
       (env-transfer env 15 02 1970 income bank1 10)
       (env-transfer env 15 03 1970 income bank1 10)
@@ -690,5 +695,21 @@
 
       (test-equal "1 txn in early slot"
         '(("USD" . 0) ("USD" . 10) ("USD" . 10) ("USD" . 10))
-        (map monetary->pair (gnc:account-get-balances-at-dates bank4 dates))))
+        (map monetary->pair (gnc:account-get-balances-at-dates bank4 dates)))
+
+      (test-equal "1 txn in each slot"
+        '(#f 10 20 40)
+        (gnc:account-accumulate-at-dates bank1 dates))
+
+      (test-equal "2 txn before start, 1 in middle"
+        '(20 20 30 30)
+        (gnc:account-accumulate-at-dates bank2 dates))
+
+      (test-equal "1 txn in late slot"
+        '(#f #f #f 10)
+        (gnc:account-accumulate-at-dates bank3 dates))
+
+      (test-equal "1 txn in early slot"
+        '(#f 10 10 10)
+        (gnc:account-accumulate-at-dates bank4 dates)))
     (teardown)))