Refactor so that we don't have to call gnc:progress functions while creating a report

Author:    Peter Broadbery <p.broadbery@gmail.com>

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@23030 57a11ea4-9604-0410-9ed3-97b8803252fd

src/report/report-system/report-collectors.scm

@@ -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,38 +92,60 @@
 								       (lambda (date)
 									 (cell-accumulator account date)))))))
 
-(define (category-by-account-report do-intervals? datepairs account-alist split-collector result-collector progress-range)
+(define (category-by-account-report do-intervals? datepairs account-alist
-  (if do-intervals?
+				    split-collector result-collector progress-range)
-      (category-by-account-report-intervals datepairs account-alist split-collector result-collector progress-range)
+  (let* ((work (category-by-account-report-work do-intervals? datepairs
-      (category-by-account-report-accumulate datepairs account-alist split-collector result-collector progress-range)))
+					       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)))
+	 (max-date (cdr (list-min-max (map second datepairs) gnc:timepair-lt))))
-	  (splits (splits-up-to (map car account-alist)
+    (list min-date max-date datepairs)))
-			      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)))
 
-(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))))
+					 (cons min-date '()) dates)))))
-	 (splits (splits-up-to (map car account-alist)
+    (list min-date max-date datepairs)))
-			       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)))
 
 (define (progress-collector size range)
   (let* ((from (car range))

src/report/standard-reports/category-barchart.scm

@@ -384,12 +384,12 @@ developing over time"))
 						 (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
+				account-reformat))
-				progress-range)))
+		   (the-report (category-by-account-report-do-work the-work progress-range)))
 	      the-report))
 
           ;; The percentage done numbers here are a hack so that

src/report/standard-reports/net-barchart.scm

@@ -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
+					  account-reformat))
-					  progress-range))
+	      (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)

src/report/standard-reports/net-linechart.scm

@@ -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
+					  account-reformat))
-					  progress-range))
+	      (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)