r23030 - gnucash/trunk/src/report - Refactor so that we don't have to call gnc:progress functions while creating a report
Geert Janssens
gjanssens at code.gnucash.org
Sun Jun 2 06:34:41 EDT 2013
Author: gjanssens
Date: 2013-06-02 06:34:41 -0400 (Sun, 02 Jun 2013)
New Revision: 23030
Trac: http://svn.gnucash.org/trac/changeset/23030
Modified:
gnucash/trunk/src/report/report-system/report-collectors.scm
gnucash/trunk/src/report/standard-reports/category-barchart.scm
gnucash/trunk/src/report/standard-reports/net-barchart.scm
gnucash/trunk/src/report/standard-reports/net-linechart.scm
Log:
Refactor so that we don't have to call gnc:progress functions while creating a report
Author: Peter Broadbery <p.broadbery at gmail.com>
Modified: gnucash/trunk/src/report/report-system/report-collectors.scm
===================================================================
--- gnucash/trunk/src/report/report-system/report-collectors.scm 2013-06-02 10:34:27 UTC (rev 23029)
+++ gnucash/trunk/src/report/report-system/report-collectors.scm 2013-06-02 10:34:41 UTC (rev 23030)
@@ -17,6 +17,8 @@
(export account-destination-alist)
(export category-by-account-report)
+(export category-by-account-report-work)
+(export category-by-account-report-do-work)
(export make-gnc-collector-collector)
(export splits-up-to)
@@ -90,39 +92,61 @@
(lambda (date)
(cell-accumulator account date)))))))
-(define (category-by-account-report do-intervals? datepairs account-alist split-collector result-collector progress-range)
- (if do-intervals?
- (category-by-account-report-intervals datepairs account-alist split-collector result-collector progress-range)
- (category-by-account-report-accumulate datepairs account-alist split-collector result-collector progress-range)))
+(define (category-by-account-report do-intervals? datepairs account-alist
+ split-collector result-collector progress-range)
+ (let* ((work (category-by-account-report-work do-intervals? datepairs
+ account-alist split-collector result-collector))
+ (splits-fn (car work))
+ (collector (cdr work))
+ (splits (splits-fn)))
+ (collector-add-all (collector-do collector
+ (progress-collector (length splits) progress-range))
+ splits)))
-(define (category-by-account-report-intervals datepairs account-alist split-collector result-collector progress-range)
+(define (category-by-account-report-do-work work progress-range)
+ (let* ((splits-fn (car work))
+ (collector (cdr work))
+ (splits (splits-fn)))
+ (collector-add-all (collector-do collector
+ (progress-collector (length splits) progress-range))
+ splits)))
+
+;; Decide how to run the given report (but don't actually do any work)
+
+(define (category-by-account-report-work do-intervals? datepairs account-alist
+ split-collector result-collector)
+ (let* ((dateinfo (if do-intervals? (category-report-dates-intervals datepairs)
+ (category-report-dates-accumulate datepairs)))
+ (processed-datepairs (third dateinfo))
+ (splits-fn (lambda () (category-report-splits dateinfo account-alist)))
+ (collector (collector-where (predicate-not split-closing?)
+ (build-category-by-account-collector account-alist
+ processed-datepairs split-collector
+ result-collector))))
+ (cons splits-fn collector)))
+
+(define (category-report-splits dateinfo account-alist)
+ (let ((min-date (first dateinfo))
+ (max-date (second dateinfo)))
+ (splits-up-to (map car account-alist) min-date max-date)))
+
+(define (category-report-dates-intervals datepairs)
(let* ((min-date (car (list-min-max (map first datepairs) gnc:timepair-lt)))
- (max-date (cdr (list-min-max (map second datepairs) gnc:timepair-lt)))
- (splits (splits-up-to (map car account-alist)
- min-date max-date))
- (collector (build-category-by-account-collector account-alist datepairs
- split-collector
- result-collector)))
- (collector-add-all (collector-do (collector-where (predicate-not split-closing?) collector)
- (progress-collector (length splits) progress-range))
- splits)))
+ (max-date (cdr (list-min-max (map second datepairs) gnc:timepair-lt))))
+ (list min-date max-date datepairs)))
-(define (category-by-account-report-accumulate dates account-alist split-collector result-collector progress-range)
+(define (category-report-dates-accumulate dates)
(let* ((min-date (gnc:secs->timepair 0))
(max-date (cdr (list-min-max dates gnc:timepair-lt)))
(datepairs (reverse! (cdr (fold (lambda (next acc)
(let ((prev (car acc))
(pairs-so-far (cdr acc)))
(cons next (cons (list prev next) pairs-so-far))))
- (cons min-date '()) dates))))
- (splits (splits-up-to (map car account-alist)
- min-date max-date))
- (collector (build-category-by-account-collector account-alist datepairs split-collector
- result-collector)))
- (collector-add-all (collector-do (collector-where (predicate-not split-closing?) collector)
- (progress-collector (length splits) progress-range))
- splits)))
+ (cons min-date '()) dates)))))
+ (list min-date max-date datepairs)))
+
+
(define (progress-collector size range)
(let* ((from (car range))
(to (cdr range))
Modified: gnucash/trunk/src/report/standard-reports/category-barchart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/category-barchart.scm 2013-06-02 10:34:27 UTC (rev 23029)
+++ gnucash/trunk/src/report/standard-reports/category-barchart.scm 2013-06-02 10:34:41 UTC (rev 23030)
@@ -384,12 +384,12 @@
(collector-into-list)
result dates-list))))))
- (the-report (category-by-account-report do-intervals?
+ (the-work (category-by-account-report-work do-intervals?
dates-list the-acount-destination-alist
(lambda (account date)
(make-gnc-collector-collector))
- account-reformat
- progress-range)))
+ account-reformat))
+ (the-report (category-by-account-report-do-work the-work progress-range)))
the-report))
;; The percentage done numbers here are a hack so that
Modified: gnucash/trunk/src/report/standard-reports/net-barchart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/net-barchart.scm 2013-06-02 10:34:27 UTC (rev 23029)
+++ gnucash/trunk/src/report/standard-reports/net-barchart.scm 2013-06-02 10:34:41 UTC (rev 23030)
@@ -287,13 +287,13 @@
(collector-into-list)
result
dates-list))))))
- (rpt (category-by-account-report inc-exp?
+ (work (category-by-account-report-work inc-exp?
dates-list
the-acount-destination-alist
(lambda (account date)
(make-gnc-collector-collector))
- account-reformat
- progress-range))
+ account-reformat))
+ (rpt (category-by-account-report-do-work work progress-range))
(assets (assoc-ref rpt 'asset))
(liabilities (assoc-ref rpt 'liability)))
(set! assets-list (if assets (car assets)
Modified: gnucash/trunk/src/report/standard-reports/net-linechart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/net-linechart.scm 2013-06-02 10:34:27 UTC (rev 23029)
+++ gnucash/trunk/src/report/standard-reports/net-linechart.scm 2013-06-02 10:34:41 UTC (rev 23030)
@@ -329,13 +329,13 @@
(collector-into-list)
result
dates-list))))))
- (rpt (category-by-account-report inc-exp?
+ (work (category-by-account-report-work inc-exp?
dates-list
the-acount-destination-alist
(lambda (account date)
(make-gnc-collector-collector))
- account-reformat
- progress-range))
+ account-reformat))
+ (rpt (category-by-account-report-do-work work progress-range))
(assets (assoc-ref rpt 'asset))
(liabilities (assoc-ref rpt 'liability)))
(set! assets-list (if assets (car assets)
More information about the gnucash-changes
mailing list