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