gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Tue Oct 16 12:22:08 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/1244ebb3 (commit)
via https://github.com/Gnucash/gnucash/commit/23d2ed70 (commit)
via https://github.com/Gnucash/gnucash/commit/b1f03ecd (commit)
via https://github.com/Gnucash/gnucash/commit/3f2a9022 (commit)
via https://github.com/Gnucash/gnucash/commit/a86d17e7 (commit)
via https://github.com/Gnucash/gnucash/commit/ab97eed9 (commit)
via https://github.com/Gnucash/gnucash/commit/cacb15c3 (commit)
via https://github.com/Gnucash/gnucash/commit/53cab269 (commit)
via https://github.com/Gnucash/gnucash/commit/caa3807f (commit)
via https://github.com/Gnucash/gnucash/commit/4102e700 (commit)
via https://github.com/Gnucash/gnucash/commit/9d25b25b (commit)
from https://github.com/Gnucash/gnucash/commit/08e28bfc (commit)
commit 1244ebb396e6445a69b3299a904274d8eee0ad4f
Merge: 08e28bf 23d2ed7
Author: John Ralls <jralls at ceridwen.us>
Date: Tue Oct 16 09:15:12 2018 -0700
Merge branch Chris Lam's 'maint-net-charts' into maint.
commit 23d2ed708e95334606b1dbb99592c402c93dbfb1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Oct 2 07:27:27 2018 +0800
[net-charts] remove doubles. send pure numbers to charts.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 139a1cc..317a220 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -258,9 +258,6 @@
(warn "incompatible currencies in monetary+: " a b)))
(warn "wrong arguments for monetary+: " a b)))
- (define (monetary->double monetary)
- (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
-
(define (split->date s)
(xaccTransGetDate (xaccSplitGetParent s)))
@@ -469,11 +466,11 @@
;; Add the data
(when show-sep?
- (add-column! (map monetary->double minuend-balances))
- (add-column! (map - (map monetary->double subtrahend-balances))))
+ (add-column! (map gnc:gnc-monetary-amount minuend-balances))
+ (add-column! (map - (map gnc:gnc-monetary-amount subtrahend-balances))))
(if show-net?
- (add-column! (map monetary->double difference-balances)))
+ (add-column! (map gnc:gnc-monetary-amount difference-balances)))
;; Legend labels, colors
((if linechart?
commit b1f03ecd9e1b65774263bf5440a1dcaf31c12cd7
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Oct 2 06:52:51 2018 +0800
[net-charts] rename variables to mathematical terms
This report seems to have evolved from a pure asset-liability
chart. It handles income-expense too, so rename to minuend-subtrahend
to be generic.
Also report percentages done.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 18df1b9..139a1cc 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -407,14 +407,19 @@
(if
(not (null? accounts))
(let* ((account-balancelist (map account->balancelist accounts))
- (assets-list (process-datelist
- account-balancelist
- dates-list #t))
- (liability-list (process-datelist
- account-balancelist
- dates-list #f))
+ (dummy (gnc:report-percent-done 60))
- (net-list (map monetary+ assets-list liability-list))
+ (minuend-balances (process-datelist
+ account-balancelist
+ dates-list #t))
+ (dummy (gnc:report-percent-done 70))
+
+ (subtrahend-balances (process-datelist
+ account-balancelist
+ dates-list #f))
+ (dummy (gnc:report-percent-done 80))
+
+ (difference-balances (map monetary+ minuend-balances subtrahend-balances))
(dates-list (if inc-exp?
(list-head dates-list (1- (length dates-list)))
@@ -463,15 +468,12 @@
chart (gnc-commodity-get-mnemonic report-currency))
;; Add the data
- (if show-sep?
- (begin
- (add-column! (map monetary->double assets-list))
- (add-column! ;;(if inc-exp?
- (map - (map monetary->double liability-list))
- ;;liability-list)
- )))
+ (when show-sep?
+ (add-column! (map monetary->double minuend-balances))
+ (add-column! (map - (map monetary->double subtrahend-balances))))
+
(if show-net?
- (add-column! (map monetary->double net-list)))
+ (add-column! (map monetary->double difference-balances)))
;; Legend labels, colors
((if linechart?
@@ -567,18 +569,15 @@
(if inc-exp?
(list (_ "Net Profit"))
(list (_ "Net Worth")))
- '()))
- )
+ '())))
(gnc:html-table-append-column! table date-string-list)
- (if show-sep?
- (begin
- (gnc:html-table-append-column! table assets-list)
- (gnc:html-table-append-column! table liability-list)
- )
- )
+ (when show-sep?
+ (gnc:html-table-append-column! table minuend-balances)
+ (gnc:html-table-append-column! table subtrahend-balances))
+
(if show-net?
- (gnc:html-table-append-column! table net-list)
- )
+ (gnc:html-table-append-column! table difference-balances))
+
;; set numeric columns to align right
(for-each
(lambda (col)
commit 3f2a9022bf75b963be4ff3a5dc3f5c606db7bd96
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Sep 23 10:03:13 2018 +0800
[net-charts] simplify date-list variables
dates-list is now a list of time64 for both inc-exp and net-worth
therefore we can combine the strings.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index b0d1c8e..18df1b9 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -413,27 +413,20 @@
(liability-list (process-datelist
account-balancelist
dates-list #f))
+
(net-list (map monetary+ assets-list liability-list))
+
(dates-list (if inc-exp?
(list-head dates-list (1- (length dates-list)))
dates-list))
- ;; Here the date strings for the x-axis labels are
- ;; created.
- (datelist->stringlist (lambda (dates-list)
- (map (lambda (date-list-item)
- (qof-print-date date-list-item))
- dates-list)))
-
- (date-string-list (if linechart?
- (datelist->stringlist dates-list)
- (map qof-print-date dates-list)))
+
+ (date-string-list (map qof-print-date dates-list))
- (date-iso-string-list (let ((save-fmt (qof-date-format-get))
- (retlist #f))
+ (date-iso-string-list (let ((save-fmt (qof-date-format-get)))
(qof-date-format-set QOF-DATE-FORMAT-ISO)
- (set! retlist (datelist->stringlist dates-list))
- (qof-date-format-set save-fmt)
- retlist)))
+ (let ((retlist (map qof-print-date dates-list)))
+ (qof-date-format-set save-fmt)
+ retlist))))
(gnc:report-percent-done 90)
commit a86d17e77df601f4453950801aa85065f8c2652b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Sep 25 09:59:54 2018 +0800
[net-charts] modify process-datelist to cycle balancelist once
This will deconstruct process-datelist to not call the utility
(gnc:accounts-get-comm-total-*) functions which are still slow,
because they will cycle through the balancelist for each account. In a
large enough report, the balance list may be thousands of entries
long, and we don't want to cycle through them every time.
This commit will loop all so that the balances are cycled once only.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 8b28acf..b0d1c8e 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -327,52 +327,69 @@
currentbal
(cons currentbal balancelist)))))))))
- ;; This calculates the balances for all the 'accounts' for each
- ;; element of the list 'dates'. If income?==#t, the signs get
- ;; reversed according to income-sign-reverse general option
- ;; settings. Uses the collector->monetary conversion function
- ;; above. Returns a list of gnc-monetary.
- (define (process-datelist account-balances accounts dates income?)
-
- (define (get-nth-balance account n)
- (let ((acct-balances (cdr (assoc account account-balances))))
- (list-ref acct-balances n)))
-
- (define (get-nth-interval account n)
- (let ((bal1 (get-nth-balance account n))
- (bal2 (get-nth-balance account (1+ n))))
- (- bal2 bal1)))
-
- (define (monetary->collector mon)
- (let ((c (gnc:make-commodity-collector)))
- (c 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon))
- c))
+ ;; This calculates the balances for all the 'account-balances' for
+ ;; each element of the list 'dates'. Uses the collector->monetary
+ ;; conversion function above. Returns a list of gnc-monetary.
+ (define (process-datelist account-balances dates left-col?)
+
+ (define (collector-minus coll1 coll2)
+ (let ((res (gnc:make-commodity-collector)))
+ (res 'merge coll1 #f)
+ (res 'minusmerge coll2 #f)
+ res))
+
+ (define accountlist
+ (if inc-exp?
+ (if left-col?
+ (assoc-ref classified-accounts ACCT-TYPE-INCOME)
+ (assoc-ref classified-accounts ACCT-TYPE-EXPENSE))
+ (if left-col?
+ (assoc-ref classified-accounts ACCT-TYPE-ASSET)
+ (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))))
+
+ (define filtered-account-balances
+ (filter
+ (lambda (a)
+ (member (car a) accountlist))
+ account-balances))
+
+ (define (acc-balances->list-of-balances lst)
+ ;; input: (list (list acc1 bal0 bal1 bal2 ...)
+ ;; (list acc2 bal0 bal1 bal2 ...) ...)
+ ;; whereby list of balances are numbers in the acc's currency
+ ;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
+ (define list-of-collectors
+ (let loop ((n (length dates)) (result '()))
+ (if (zero? n) result
+ (loop (1- n) (cons (gnc:make-commodity-collector) result)))))
+ (let loop ((lst lst))
+ (when (pair? lst)
+ (let innerloop ((list-of-collectors list-of-collectors)
+ (list-of-balances (cdar lst)))
+ (when (pair? list-of-balances)
+ ((car list-of-collectors) 'add
+ (xaccAccountGetCommodity (caar lst))
+ (car list-of-balances))
+ (innerloop (cdr list-of-collectors) (cdr list-of-balances))))
+ (loop (cdr lst))))
+ list-of-collectors)
(let loop ((dates dates)
- (dates-idx 0)
+ (acct-balances (acc-balances->list-of-balances filtered-account-balances))
(result '()))
(if (if inc-exp?
(null? (cdr dates))
(null? dates))
(reverse result)
(loop (cdr dates)
- (1+ dates-idx)
- (cons (collector->monetary
- ((if inc-exp?
- (if income?
- gnc:accounts-get-comm-total-income
- gnc:accounts-get-comm-total-expense)
- gnc:accounts-get-comm-total-assets)
- accounts
- (lambda (account)
- (monetary->collector
- (gnc:make-gnc-monetary
- (xaccAccountGetCommodity account)
- (if inc-exp?
- (get-nth-interval account dates-idx)
- (get-nth-balance account dates-idx))))))
- (if inc-exp? (cadr dates) (car dates)))
- result)))))
+ (cdr acct-balances)
+ (cons
+ (collector->monetary
+ (if inc-exp?
+ (collector-minus (car acct-balances) (cadr acct-balances))
+ (car acct-balances))
+ (if inc-exp? (cadr dates) (car dates)))
+ result)))))
(gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities
@@ -392,15 +409,9 @@
(let* ((account-balancelist (map account->balancelist accounts))
(assets-list (process-datelist
account-balancelist
- (if inc-exp?
- accounts
- (assoc-ref classified-accounts ACCT-TYPE-ASSET))
dates-list #t))
(liability-list (process-datelist
account-balancelist
- (if inc-exp?
- accounts
- (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))
dates-list #f))
(net-list (map monetary+ assets-list liability-list))
(dates-list (if inc-exp?
commit ab97eed97989754637b9f90cfcbb40dd5366b883
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 21 04:36:30 2018 +0800
[net-charts] modify process-datelist to use account-balances
This will retrieve the cached balances in account-balances, rather
than calling (gnc:account-get-comm-balance-interval)
or (gnc:account-get-comm-balance-at-date) which are very expensive
because they will call xaccAccountGetBalanceAsOfDate which will scan
the account splitlist every time.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index d099f9e..8b28acf 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -214,9 +214,7 @@
;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid)))
(commodity-list #f)
(exchange-fn #f)
- (dates-list ((if inc-exp?
- gnc:make-date-interval-list
- gnc:make-date-list)
+ (dates-list (gnc:make-date-list
((if inc-exp?
gnc:time64-start-day-time
gnc:time64-end-day-time)
@@ -334,26 +332,47 @@
;; reversed according to income-sign-reverse general option
;; settings. Uses the collector->monetary conversion function
;; above. Returns a list of gnc-monetary.
- (define (process-datelist accounts dates income?)
- (map
- (lambda (date)
- (collector->monetary
- ((if inc-exp?
- (if income?
- gnc:accounts-get-comm-total-income
- gnc:accounts-get-comm-total-expense)
- gnc:accounts-get-comm-total-assets)
- accounts
- (lambda (account)
- (if inc-exp?
- ;; for inc-exp, 'date' is a pair of time values, else
- ;; it is a time value.
- (gnc:account-get-comm-balance-interval
- account (first date) (second date) #f)
- (gnc:account-get-comm-balance-at-date
- account date #f))))
- (if inc-exp? (second date) date)))
- dates))
+ (define (process-datelist account-balances accounts dates income?)
+
+ (define (get-nth-balance account n)
+ (let ((acct-balances (cdr (assoc account account-balances))))
+ (list-ref acct-balances n)))
+
+ (define (get-nth-interval account n)
+ (let ((bal1 (get-nth-balance account n))
+ (bal2 (get-nth-balance account (1+ n))))
+ (- bal2 bal1)))
+
+ (define (monetary->collector mon)
+ (let ((c (gnc:make-commodity-collector)))
+ (c 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon))
+ c))
+
+ (let loop ((dates dates)
+ (dates-idx 0)
+ (result '()))
+ (if (if inc-exp?
+ (null? (cdr dates))
+ (null? dates))
+ (reverse result)
+ (loop (cdr dates)
+ (1+ dates-idx)
+ (cons (collector->monetary
+ ((if inc-exp?
+ (if income?
+ gnc:accounts-get-comm-total-income
+ gnc:accounts-get-comm-total-expense)
+ gnc:accounts-get-comm-total-assets)
+ accounts
+ (lambda (account)
+ (monetary->collector
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity account)
+ (if inc-exp?
+ (get-nth-interval account dates-idx)
+ (get-nth-balance account dates-idx))))))
+ (if inc-exp? (cadr dates) (car dates)))
+ result)))))
(gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities
@@ -370,36 +389,33 @@
(if
(not (null? accounts))
- (let* ((assets-list (process-datelist
+ (let* ((account-balancelist (map account->balancelist accounts))
+ (assets-list (process-datelist
+ account-balancelist
(if inc-exp?
accounts
(assoc-ref classified-accounts ACCT-TYPE-ASSET))
dates-list #t))
(liability-list (process-datelist
+ account-balancelist
(if inc-exp?
accounts
(assoc-ref classified-accounts ACCT-TYPE-LIABILITY))
dates-list #f))
(net-list (map monetary+ assets-list liability-list))
+ (dates-list (if inc-exp?
+ (list-head dates-list (1- (length dates-list)))
+ dates-list))
;; Here the date strings for the x-axis labels are
;; created.
(datelist->stringlist (lambda (dates-list)
(map (lambda (date-list-item)
- (qof-print-date
- (if inc-exp?
- (car date-list-item)
- date-list-item)))
+ (qof-print-date date-list-item))
dates-list)))
(date-string-list (if linechart?
(datelist->stringlist dates-list)
- (map
- (if inc-exp?
- (lambda (date-list-item)
- (qof-print-date
- (car date-list-item)))
- qof-print-date)
- dates-list)))
+ (map qof-print-date dates-list)))
(date-iso-string-list (let ((save-fmt (qof-date-format-get))
(retlist #f))
commit cacb15c3f3d1e9762d158df405151cf0d339a3eb
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 21 02:38:05 2018 +0800
[net-charts] create account->balancelist
This function will scan the splitlist for account, and build a list of
balances at the dates specified in the dates-list variable.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 5a633e3..d099f9e 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -263,6 +263,72 @@
(define (monetary->double monetary)
(gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
+ (define (split->date s)
+ (xaccTransGetDate (xaccSplitGetParent s)))
+
+ ;; this function will scan through the account splitlist, building
+ ;; a list of balances along the way. it will use the dates
+ ;; specified in the variable dates-list.
+ ;; input: account
+ ;; uses: dates-list (list of time64)
+ ;; out: (list account bal0 bal1 ...)
+ (define (account->balancelist account)
+
+ ;; the test-closing? function will enable testing closing status
+ ;; for inc-exp only. this may squeeze more speed for net-worth charts.
+ (define test-closing?
+ (gnc:account-is-inc-exp? account))
+
+ (let loop ((splits (xaccAccountGetSplitList account))
+ (dates dates-list)
+ (currentbal 0)
+ (lastbal 0)
+ (balancelist '()))
+ (cond
+
+ ;; end of dates. job done!
+ ((null? dates)
+ (cons account (reverse balancelist)))
+
+ ;; end of splits, but still has dates. pad with last-bal
+ ;; until end of dates.
+ ((null? splits)
+ (loop '()
+ (cdr dates)
+ currentbal
+ lastbal
+ (cons lastbal balancelist)))
+
+ (else
+ (let* ((this (car splits))
+ (rest (cdr splits))
+ (currentbal (if (and test-closing?
+ (xaccTransGetIsClosingTxn (xaccSplitGetParent this)))
+ currentbal
+ (+ (xaccSplitGetAmount this) currentbal)))
+ (next (and (pair? rest) (car rest))))
+
+ (cond
+ ;; the next split is still before date
+ ((and next (< (split->date next) (car dates)))
+ (loop rest dates currentbal lastbal balancelist))
+
+ ;; this split after date, add previous bal to balancelist
+ ((< (car dates) (split->date this))
+ (loop splits
+ (cdr dates)
+ lastbal
+ lastbal
+ (cons lastbal balancelist)))
+
+ ;; this split before date, next split after date, or end.
+ (else
+ (loop rest
+ (cdr dates)
+ currentbal
+ currentbal
+ (cons currentbal balancelist)))))))))
+
;; This calculates the balances for all the 'accounts' for each
;; element of the list 'dates'. If income?==#t, the signs get
;; reversed according to income-sign-reverse general option
commit 53cab269f467cf73ff7e20cde797cd08212b9435
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 19 10:16:06 2018 +0800
[test-charts] add basic test for net-charts amounts & dates
This is similar to test-standard-net-linechart but designed to test
date boundaries. Creates book with following entries in bank accounts,
and calculates amounts at each date boundary.
Bank1 Bank2 Bank3
05/05/69 $25
01/01/1970
05/01/70 $25
12/01/70 $10
18/01/70 $15 $50
01/02/1970
18/02/70 $50
01/03/1970
03/03/70 $200
01/04/1970
15/04/1970
diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm
index 850b472..b181cab 100644
--- a/gnucash/report/standard-reports/test/test-charts.scm
+++ b/gnucash/report/standard-reports/test/test-charts.scm
@@ -57,6 +57,9 @@
(define structure
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
(list "Asset"
+ (list "Bank1")
+ (list "Bank2")
+ (list "Bank3")
(list "Bank"))
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
(list "Liability" (list (cons 'type ACCT-TYPE-LIABILITY)))
@@ -75,6 +78,69 @@
(test-chart-variant variant)
(gnc-clear-current-session)))
+(define (test-net-chart-variant variant)
+ (define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "[~a] wrong-option ~a ~a" variant section name) #f))))
+ (let* ((uuid (variant->uuid variant))
+ (inc-exp? (memq variant '(income-expense-barchart income-expense-linechart)))
+ (env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank1 (cdr (assoc "Bank1" account-alist)))
+ (bank2 (cdr (assoc "Bank2" account-alist)))
+ (bank3 (cdr (assoc "Bank3" account-alist)))
+ (liability (cdr (assoc "Liability" account-alist)))
+ (income (cdr (assoc "Income" account-alist)))
+ (expense (cdr (assoc "Expenses" account-alist)))
+ (equity (cdr (assoc "Equity" account-alist))))
+
+ (env-transfer env 12 01 1970 income bank1 10)
+ (env-transfer env 18 01 1970 income bank1 15)
+ (env-transfer env 03 03 1970 income bank1 200)
+
+ (env-transfer env 18 01 1970 income bank2 50)
+ (env-transfer env 18 02 1970 income bank2 50)
+
+ (env-transfer env 05 05 1969 income bank3 25)
+ (env-transfer env 05 01 1970 income bank3 25)
+
+ ;; one closing txn which should be ignored by the inc-exp charts
+ (let ((txn (env-transfer env 03 01 1970 equity income 25)))
+ (xaccTransSetIsClosingTxn txn #t))
+
+ (let* ((options (gnc:make-report-options (variant->uuid variant))))
+ (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1970)))
+ (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 4 1970)))
+ (set-option! options "Accounts" "Accounts" (list income bank1 bank2 bank3))
+ (set-option! options "General" "Step Size" 'MonthDelta)
+ (set-option! options "Display" "Show table" #t)
+ (format #t "\n\ntesting net-chart variant:~a\n" variant)
+ (let ((sxml (gnc:options->sxml uuid options (format #f "test-net-charts ~a 3 months" variant)
+ "test-table" #:strip-tag "script")))
+ (unless inc-exp?
+ (test-equal "first row"
+ '("Date" "Assets" "Liabilities" "Net Worth")
+ (sxml->table-row-col sxml 1 0 #f))
+ (test-equal "first data row"
+ '("01/01/70" "$25.00" "$0.00" "$25.00")
+ (sxml->table-row-col sxml 1 1 #f))
+ (test-equal "last data row"
+ '("04/15/70" "$375.00" "$0.00" "$375.00")
+ (sxml->table-row-col sxml 1 -1 #f)))
+
+ (when inc-exp?
+ (test-equal "first row"
+ '("Date" "Income" "Expense" "Net Profit")
+ (sxml->table-row-col sxml 1 0 #f))
+ (test-equal "first data row"
+ '("01/01/70" "$100.00" "$0.00" "$100.00")
+ (sxml->table-row-col sxml 1 1 #f))
+ (test-equal "last data row"
+ '("04/01/70" "$0.00" "$0.00" "$0.00")
+ (sxml->table-row-col sxml 1 -1 #f)))))))
+
(define (test-chart-variant variant)
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
@@ -179,4 +245,5 @@
'daily-tests)
((net-worth-barchart income-expense-barchart net-worth-linechart income-expense-linechart)
- 'net-charts-tests))))
+ (test-net-chart-variant variant)))))
+
commit caa3807f05c48ffd124b1946537bf374204e6756
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 21 10:36:43 2018 +0800
Revert "Revert "[net-charts] deoptimize accounts-list""
This reverts commit 70bc472ffe93b80ad12db56e75332d09d3b0c1df.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 9e1e885..5a633e3 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -33,8 +33,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash report report-system report-collectors))
-(use-modules (gnucash report report-system collectors))
(use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports
(gnc:module-load "gnucash/report/report-system" 0)
@@ -306,50 +304,16 @@
(if
(not (null? accounts))
- (let* ((the-account-destination-alist
- (if inc-exp?
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-INCOME))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-EXPENSE)))
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-ASSET))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)))))
- (account-reformat (if inc-exp?
- (lambda (account result)
- (map (lambda (collector date-interval)
- (gnc:monetary-neg (collector->monetary collector (second date-interval))))
- result dates-list))
- (lambda (account result)
- (let ((commodity-collector (gnc:make-commodity-collector)))
- (collector-end (fold (lambda (next date list-collector)
- (commodity-collector 'merge next #f)
- (collector-add list-collector
- (collector->monetary
- commodity-collector date)))
- (collector-into-list)
- result
- dates-list))))))
- (work (category-by-account-report-work inc-exp?
- dates-list
- the-account-destination-alist
- (lambda (account date)
- (make-gnc-collector-collector))
- account-reformat))
- (rpt (category-by-account-report-do-work work (cons 50 90)))
- (assets (assoc-ref rpt 'asset))
- (liabilities (assoc-ref rpt 'liability))
- (assets-list (if assets
- (car assets)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0))
- dates-list)))
- (liability-list (if liabilities
- (car liabilities)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0))
- dates-list)))
+ (let* ((assets-list (process-datelist
+ (if inc-exp?
+ accounts
+ (assoc-ref classified-accounts ACCT-TYPE-ASSET))
+ dates-list #t))
+ (liability-list (process-datelist
+ (if inc-exp?
+ accounts
+ (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))
+ dates-list #f))
(net-list (map monetary+ assets-list liability-list))
;; Here the date strings for the x-axis labels are
;; created.
commit 4102e7007e0ac1f6cdc9bead7189c6caedcc3b30
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 26 05:04:02 2018 +0800
[test-report-utilities] gnc:strify tests
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 531901b..f8d5241 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -17,6 +17,7 @@
(test-account-get-trans-type-splits-interval)
(test-list-ref-safe)
(test-list-set-safe)
+ (test-gnc-pk)
(test-gnc:monetary->string)
(test-commodity-collector)
(test-get-account-balances)
@@ -103,6 +104,33 @@
(string? (gnc:monetary->string monetary))))
(teardown)))
+(define (test-gnc-pk)
+ (test-begin "debugging tools")
+ (test-equal "gnc:pk testing"
+ 'works
+ (gnc:pk 'testing "gnc:pk" 'works))
+ (test-equal "gnc:strify #t"
+ "#t"
+ (gnc:strify #t))
+ (test-equal "gnc:strify '()"
+ "#null"
+ (gnc:strify '()))
+ (test-equal "gnc:strify 'sym"
+ "'sym"
+ (gnc:strify 'sym))
+ (test-equal "gnc:strify \"str\""
+ "str"
+ (gnc:strify "str"))
+ (test-equal "gnc:strify '(1 2 3)"
+ "(list 1 2 3)"
+ (gnc:strify '(1 2 3)))
+ (test-equal "gnc:strify (a . 2)"
+ "('a . 2)"
+ (gnc:strify (cons 'a 2)))
+ (test-equal "gnc:strify cons"
+ "Proc<cons>"
+ (gnc:strify cons)))
+
(define (test-commodity-collector)
(test-group-with-cleanup "test-commodity-collector"
(let* ((book (gnc-get-current-book))
commit 9d25b25be30b8ac15b5423e5e02f913142d1a7e9
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 19 11:34:07 2018 +0800
[report-utilities] add (gnc:strify) and (gnc:pk) for debugging
The (gnc:strify) function will take an object, and try various methods
to display a useful output. Instead of a cryptic "#<swig-pointer
Split * 55a7079b2660> () # ?" message it can show
"Split<d:02/05/2018,acc:Bank1,amt:$20,val:$20>"
The (gnc:pk) function is a debugging tool. It will dump all arguments
via gnc:strify to console and return the last argument. In addition,
it will print the time stamp since the procedure was defined, and the
delta time since the last (gnc:pk) call.
(gnc:pk "call weird-fn with " acc " = " (weird-fn acc))
(gnc:pk "call another-fn =" (another-fn))
[d2.3243 t2.3243] call weird-fn with Acc<Bank> = Mon<$25.00>
[d0.1000 t2.4243] call another-fn = #t
This would suggest that (weird-fn acc) ran for 0.1 seconds, and
returned a gnc:gnc-monetary object.
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 73357a6..f600835 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -737,6 +737,8 @@
(export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total)
(export make-file-url)
+(export gnc:strify)
+(export gnc:pk)
(load-from-path "commodity-utilities")
(load-from-path "html-barchart")
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 1b8cde8..f01a97a 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -18,6 +18,7 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
(use-modules (srfi srfi-13))
+(use-modules (ice-9 format))
(define (list-ref-safe list elt)
(and (> (length list) elt)
@@ -966,3 +967,89 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(if (string-prefix? "file:///" url)
url
(string-append "file:///" url)))
+
+(define-public (gnc:strify d)
+ ;; any object -> string. The option is passed to various
+ ;; scm->string converters; ultimately a generic stringify
+ ;; function handles symbol/string/other types.
+ (define (split->str spl)
+ (let ((txn (xaccSplitGetParent spl)))
+ (format #f "Split<d:~a,acc:~a,amt:~a,val:~a>"
+ (qof-print-date (xaccTransGetDate txn))
+ (xaccAccountGetName (xaccSplitGetAccount spl))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (xaccTransGetCurrency txn)
+ (xaccSplitGetValue spl)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity
+ (xaccSplitGetAccount spl))
+ (xaccSplitGetAmount spl))))))
+ (define (trans->str txn)
+ (format #f "Txn<d:~a>" (qof-print-date (xaccTransGetDate txn))))
+ (define (account->str acc)
+ (format #f "Acc<~a>" (xaccAccountGetName acc)))
+ (define (monetary-collector->str coll)
+ (format #f "Mon-coll<~a>"
+ (map gnc:strify (coll 'format gnc:make-gnc-monetary #f))))
+ (define (value-collector->str coll)
+ (format #f "Val-coll<~a>"
+ (map gnc:strify (coll 'total gnc:make-gnc-monetary))))
+ (define (procedure->str proc)
+ (format #f "Proc<~a>"
+ (or (procedure-name proc) "unk")))
+ (define (monetary->string mon)
+ (format #f "Mon<~a>"
+ (gnc:monetary->string mon)))
+ (define (try proc)
+ ;; Try proc with d as a parameter, catching 'wrong-type-arg
+ ;; exceptions to return #f to the (or) evaluator below.
+ (catch 'wrong-type-arg
+ (lambda () (proc d))
+ (const #f)))
+ (or (and (boolean? d) (if d "#t" "#f"))
+ (and (null? d) "#null")
+ (and (symbol? d) (format #f "'~a" d))
+ (and (string? d) d)
+ (and (list? d) (string-append
+ "(list "
+ (string-join (map gnc:strify d) " ")
+ ")"))
+ (and (pair? d) (format #f "(~a . ~a)"
+ (gnc:strify (car d))
+ (if (eq? (car d) 'absolute)
+ (qof-print-date (cdr d))
+ (gnc:strify (cdr d)))))
+ (try procedure->str)
+ (try gnc-commodity-get-mnemonic)
+ (try account->str)
+ (try split->str)
+ (try trans->str)
+ (try monetary-collector->str)
+ (try value-collector->str)
+ (try monetary->string)
+ (try gnc-budget-get-name)
+ (object->string d)))
+
+(define (pair->num pair)
+ (+ (car pair)
+ (/ (cdr pair) 1000000)))
+
+(define (delta t1 t2)
+ (exact->inexact
+ (- (pair->num t2)
+ (pair->num t1))))
+
+(define-public gnc:pk
+ (let* ((start-time (gettimeofday))
+ (last-time start-time))
+ (lambda args
+ (let ((now (gettimeofday)))
+ (format #t "d~,4f t~,3f: "
+ (delta last-time now)
+ (delta start-time now))
+ (set! last-time now))
+ (display (map gnc:strify args))
+ (newline)
+ (last args))))
Summary of changes:
gnucash/report/report-system/report-system.scm | 2 +
gnucash/report/report-system/report-utilities.scm | 87 +++++++
.../report-system/test/test-report-utilities.scm | 28 ++
gnucash/report/standard-reports/net-charts.scm | 286 ++++++++++++---------
.../report/standard-reports/test/test-charts.scm | 69 ++++-
5 files changed, 351 insertions(+), 121 deletions(-)
More information about the gnucash-changes
mailing list