IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

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

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

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@23030 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Geert Janssens 2013-06-02 10:34:41 +00:00
parent 63441a3d6b
commit 76ccb82013
4 changed files with 56 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
src/report/report-system/report-collectors.scm
View File

@ -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)
(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-intervals datepairs account-alist split-collector result-collector progress-range)
(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)
(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-accumulate dates 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))))
(list min-date max-date datepairs)))
(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))

6
src/report/standard-reports/category-barchart.scm
View File

@ -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
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

6
src/report/standard-reports/net-barchart.scm
View File

@ -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)

6
src/report/standard-reports/net-linechart.scm
View File

@ -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)