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

[category-barchart] refactor, handling error conditions first

Browse Source
This commit is contained in:
Christopher Lam 2021-01-14 22:53:59 +08:00
parent e6b97849a5
commit 6605a6eb66
1 changed files with 356 additions and 379 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
gnucash/report/reports/standard/category-barchart.scm
View File

@ -274,11 +274,21 @@ developing over time"))
account-levels)) account-levels))
;;(gnc:debug accounts) ;;(gnc:debug accounts)
(if (not (null? accounts)) (cond
((null? accounts)
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))
;; Define more helper variables. (else
(let* ((commodity-list #f) (let* ((commodity-list (gnc:accounts-get-commodities
(exchange-fn #f) (gnc:accounts-and-all-descendants accounts)
report-currency))
(exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list to-date-t64
5 15))
(averaging-fraction-func (gnc:date-get-fraction-func averaging-selection)) (averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
(interval-fraction-func (gnc:date-get-fraction-func interval)) (interval-fraction-func (gnc:date-get-fraction-func interval))
(averaging-multiplier (averaging-multiplier
@ -288,7 +298,9 @@ developing over time"))
(let* ((start-frac-avg (averaging-fraction-func from-date-t64)) (let* ((start-frac-avg (averaging-fraction-func from-date-t64))
(end-frac-avg (averaging-fraction-func (1+ to-date-t64))) (end-frac-avg (averaging-fraction-func (1+ to-date-t64)))
(diff-avg (- end-frac-avg start-frac-avg)) (diff-avg (- end-frac-avg start-frac-avg))
(diff-avg-numeric (/ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision (diff-avg-numeric
(/ (inexact->exact (round (* diff-avg 1000000)))
;; 6 decimals precision
1000000)) 1000000))
(start-frac-int (interval-fraction-func from-date-t64)) (start-frac-int (interval-fraction-func from-date-t64))
(end-frac-int (interval-fraction-func (1+ to-date-t64))) (end-frac-int (interval-fraction-func (1+ to-date-t64)))
@ -317,8 +329,7 @@ developing over time"))
(gnc:deltasym-to-delta interval))) (gnc:deltasym-to-delta interval)))
;; Here the date strings for the x-axis labels are ;; Here the date strings for the x-axis labels are
;; created. ;; created.
(other-anchor "") (other-anchor ""))
(all-data '()))
;; Converts a commodity-collector into gnc-monetary in the report's ;; Converts a commodity-collector into gnc-monetary in the report's
;; currency using the exchange-fn calculated above. Returns a gnc-monetary ;; currency using the exchange-fn calculated above. Returns a gnc-monetary
@ -334,11 +345,11 @@ developing over time"))
c report-currency c report-currency
(lambda (a b) (exchange-fn a b date))))))) (lambda (a b) (exchange-fn a b date)))))))
;; copy of gnc:not-all-zeros using gnc-monetary (define (all-zeros data)
(define (not-all-zeros data) (cond
(cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data)))) ((gnc:gnc-monetary? data) (zero? (gnc:gnc-monetary-amount data)))
((list? data) (or-map not-all-zeros data)) ((pair? data) (every all-zeros data))
(else #f))) (else (error 'huh))))
;; this is an alist of account-balances ;; this is an alist of account-balances
;; (list (list acc0 bal0 bal1 bal2 ...) ;; (list (list acc0 bal0 bal1 bal2 ...)
@ -402,12 +413,15 @@ developing over time"))
(let ((sum 0)) (let ((sum 0))
(for-each (for-each
(lambda (a) (lambda (a)
(set! sum (+ sum (1+ (count-accounts (1+ current-depth) (set! sum
(+ sum (1+ (count-accounts (1+ current-depth)
(gnc-account-get-children a)))))) (gnc-account-get-children a))))))
accts) accts)
sum) sum)
(length (filter show-acct? accts)))) (length (filter show-acct? accts))))
(set! work-to-do (count-accounts 1 topl-accounts))
;; Calculates all account's balances. Returns a list of pairs: ;; Calculates all account's balances. Returns a list of pairs:
;; (<account> <balance-list>), like '((Earnings (10.0 11.2)) ;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
;; (Gifts (12.3 14.5))), where each element of <balance-list> ;; (Gifts (12.3 14.5))), where each element of <balance-list>
@ -427,18 +441,17 @@ developing over time"))
(let ((res '())) (let ((res '()))
(for-each (for-each
(lambda (a) (lambda (a)
(begin
(set! work-done (1+ work-done)) (set! work-done (1+ work-done))
(gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do)))) (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
(if (show-acct? a) (if (show-acct? a)
(set! res (set! res
(cons (list a (account->balance-list a #f)) (cons (list a (account->balance-list a #f))
res))) res)))
(set! res (append (set! res
(traverse-accounts (append (traverse-accounts
(1+ current-depth) (1+ current-depth)
(gnc-account-get-children a)) (gnc-account-get-children a))
res)))) res)))
accts) accts)
res) res)
;; else (i.e. current-depth == tree-depth) ;; else (i.e. current-depth == tree-depth)
@ -449,27 +462,8 @@ developing over time"))
(list a (account->balance-list a #t))) (list a (account->balance-list a #t)))
(filter show-acct? accts)))) (filter show-acct? accts))))
;; The percentage done numbers here are a hack so that
;; something gets displayed. On my system the
;; gnc:case-exchange-time-fn takes about 20% of the time
;; building up a list of prices for later use. Either this
;; routine needs to send progress reports, or the price
;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly.
(gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities
(gnc:accounts-and-all-descendants accounts)
report-currency))
(set! exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list to-date-t64
5 15))
(set! work-to-do (count-accounts 1 topl-accounts))
;; Sort the account list according to the account code field. ;; Sort the account list according to the account code field.
(set! all-data (define all-data
(sort (sort
(filter (lambda (l) (filter (lambda (l)
(not (zero? (gnc:gnc-monetary-amount (not (zero? (gnc:gnc-monetary-amount
@ -492,18 +486,20 @@ developing over time"))
(> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a))) (> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a)))
(gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b))))))))) (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b)))))))))
;; Proceed if the data is non-zeros (cond
(if ((or (null? all-data) (all-zeros (map cadr all-data)))
(and (not (null? all-data)) (gnc:html-document-add-object!
(not-all-zeros (map cadr all-data))) document
(gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj))))
(else
(let* ((dates-list (if do-intervals? (let* ((dates-list (if do-intervals?
(list-head dates-list (1- (length dates-list))) (list-head dates-list (1- (length dates-list)))
dates-list)) dates-list))
(date-string-list (map qof-print-date dates-list))) (date-string-list (map qof-print-date dates-list)))
;; Set chart title, subtitle etc. ;; Set chart title, subtitle etc.
(gnc:html-chart-set-type! (gnc:html-chart-set-type!
chart (if (eq? chart-type 'barchart) 'bar 'line)) chart (if (eq? chart-type 'barchart) 'bar 'line))
@ -555,28 +551,21 @@ developing over time"))
(lambda (series color stack) (lambda (series color stack)
(let* ((acct (car series)) (let* ((acct (car series))
(label (cond (label (cond
((string? acct) ((string? acct) (car series))
(car series)) (show-fullname? (gnc-account-get-full-name acct))
(show-fullname?
(gnc-account-get-full-name acct))
(else (xaccAccountGetName acct)))) (else (xaccAccountGetName acct))))
(amounts (map gnc:gnc-monetary-amount (cadr series))) (amounts (map gnc:gnc-monetary-amount (cadr series)))
(stack (if stacked? (stack (if stacked? "default" (number->string stack)))
"default"
(number->string stack)))
(fill (eq? chart-type 'barchart)) (fill (eq? chart-type 'barchart))
(urls (cond (urls (cond
((string? acct) ((string? acct) other-anchor)
other-anchor)
((null? (gnc-account-get-children acct)) ((null? (gnc-account-get-children acct))
(gnc:account-anchor-text acct)) (gnc:account-anchor-text acct))
;; because the tree-depth option for ;; because the tree-depth option for
;; accounts/levels goes up to 6. FIXME: ;; accounts/levels goes up to 6. FIXME:
;; magic number. ;; magic number.
((>= tree-depth 6) ((>= tree-depth 6) (gnc:account-anchor-text acct))
(gnc:account-anchor-text acct))
(else (else
(gnc:make-report-anchor (gnc:make-report-anchor
@ -672,19 +661,7 @@ developing over time"))
(list (apply gnc:monetary+ row)) (list (apply gnc:monetary+ row))
'()))) '())))
(map (cut gnc-print-time64 <> iso-date) dates-list) (map (cut gnc-print-time64 <> iso-date) dates-list)
(apply zip (map cadr all-data)))))))))) (apply zip (map cadr all-data)))))))))))))))
;; else if empty data
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj)))))
;; else if no accounts selected
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))
(unless (gnc:html-document-export-string document) (unless (gnc:html-document-export-string document)
(gnc:html-document-set-export-error document (G_ "No exportable data"))) (gnc:html-document-set-export-error document (G_ "No exportable data")))