Merge branch J. Marino's cashflow-barchart report into unstable.

This commit is contained in:
John Ralls
2017-10-27 11:31:46 -07:00
6 changed files with 814 additions and 1 deletions

View File

@@ -15,6 +15,7 @@ SET (standard_reports_SCHEME_2
budget-income-statement.scm
budget.scm
cash-flow.scm
cashflow-barchart.scm
category-barchart.scm
daily-reports.scm
equity-statement.scm

View File

@@ -17,6 +17,7 @@ gncscmrpt_DATA = \
budget-flow.scm \
budget-income-statement.scm \
cash-flow.scm \
cashflow-barchart.scm \
category-barchart.scm \
daily-reports.scm \
equity-statement.scm \

View File

@@ -0,0 +1,521 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cashflow-barchart.scm: cash flow barchart report
;;
;; By Jose Marino <jmarino@users.noreply.github.com>
;;
;; based on cash-flow.scm by:
;; Herbert Thoma <herbie@hthoma.de>
;; and net-barchart by:
;; Robert Merkel <rgmerk@mira.net>
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report standard-reports cashflow-barchart))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(use-modules (gnucash engine))
(use-modules (gnucash printf))
(gnc:module-load "gnucash/report/report-system" 0)
;; Define these utilities to avoid using module srfi-1
(define first car)
(define second cadr)
(define reportname (N_ "Cash Flow Barchart"))
;; define all option's names so that they are properly defined
;; in *one* place.
;; Accounts
(define optname-accounts (N_ "Accounts"))
(define optname-include-trading-accounts (N_ "Include Trading Accounts in report"))
;; Display
(define optname-show-inout (N_ "Show Money In/Out"))
(define optname-show-net (N_ "Show Net Flow"))
(define optname-show-table (N_ "Show Table"))
(define optname-plot-width (N_ "Plot Width"))
(define optname-plot-height (N_ "Plot Height"))
;; General
(define optname-from-date (N_ "Start Date"))
(define optname-to-date (N_ "End Date"))
(define optname-stepsize (N_ "Step Size"))
(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
;; options generator function
(define (cashflow-barchart-options-generator)
(let* ((options (gnc:new-options))
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
;; General tab
(gnc:options-add-date-interval!
options gnc:pagename-general
optname-from-date optname-to-date "a")
(gnc:options-add-interval-choice!
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
(gnc:options-add-currency!
options gnc:pagename-general optname-report-currency "c")
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" 'pricedb-nearest)
;; Accounts tab
(add-option
(gnc:make-account-list-option
gnc:pagename-accounts optname-accounts
"a" (N_ "Report on these accounts.")
(lambda () ; account getter
(gnc:filter-accountlist-type
(list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-ASSET
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#f #t))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-accounts optname-include-trading-accounts
"b" (N_ "Include transfers to and from Trading Accounts in the report.") #f))
;; Display tab
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-inout
"a" (N_ "Show money in/out?") #t))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-net
"b" (N_ "Show net money flow?") #t))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-table
"c" (N_ "Display a table of the selected data.") #f))
;; Plot size options
(gnc:options-add-plot-size!
options gnc:pagename-display
optname-plot-width optname-plot-height "d" (cons 'percent 100.0) (cons 'percent 100.0))
;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-general)
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cashflow-barchart-renderer
;; set up the document and add the barchart and table
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cashflow-barchart-renderer report-obj)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
(gnc:report-starting reportname)
;; get all option's values
(let* ((accounts (get-option gnc:pagename-accounts
optname-accounts))
(include-trading-accounts (get-option gnc:pagename-accounts
optname-include-trading-accounts))
(row-num 0)
(work-done 0)
(work-to-do 0)
(report-currency (get-option gnc:pagename-general
optname-report-currency))
(price-source (get-option gnc:pagename-general
optname-price-source))
(from-date-tp (gnc:timepair-start-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general
optname-from-date))))
(to-date-tp (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general
optname-to-date))))
;; calculate the exchange rates
(exchange-fn (gnc:case-exchange-fn
price-source report-currency to-date-tp))
(interval (get-option gnc:pagename-general optname-stepsize))
(show-inout? (get-option gnc:pagename-display optname-show-inout))
(show-net? (get-option gnc:pagename-display optname-show-net))
(show-table? (get-option gnc:pagename-display optname-show-table))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
(dates-list (gnc:make-date-interval-list
(gnc:timepair-start-day-time from-date-tp)
(gnc:timepair-end-day-time to-date-tp)
(gnc:deltasym-to-delta interval)))
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(doc (gnc:make-html-document))
(table (gnc:make-html-table))
(txt (gnc:make-html-text))
(chart (gnc:make-html-barchart))
(non-zeros #f))
;; utility function used to generate chart (from net-barchart.scm)
(define (add-column! data-list)
(begin
(gnc:html-barchart-append-column! chart data-list)
(if (gnc:not-all-zeros data-list) (set! non-zeros #t))
#f))
(if (not (null? accounts))
(let* ((money-diff-collector (gnc:make-commodity-collector))
(account-disp-list '())
(time-exchange-fn #f)
(commodity-list (gnc:accounts-get-commodities
accounts
report-currency))
;; Get an exchange function that will convert each transaction using the
;; nearest available exchange rate if that is what is specified
(time-exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list to-date-tp
0 0))
(date-string-list (map (lambda (date-list-item) ; date-list-item is (start . end)
(gnc-print-date (car date-list-item)))
dates-list))
(results-by-date '())
(in-list '())
(out-list '())
(net-list '())
(in-value-list #f)
(out-value-list #f)
(net-value-list #f)
(in-total-collector (gnc:make-commodity-collector))
(out-total-collector (gnc:make-commodity-collector))
(net-total-collector (gnc:make-commodity-collector))
)
;; Helper function to convert currencies
(define (to-report-currency currency amount date)
(gnc:gnc-monetary-amount
(time-exchange-fn (gnc:make-gnc-monetary currency amount)
report-currency
date)))
;; Sum a collector to return a gnc-monetary
(define (sum-collector collector)
(gnc:sum-collector-commodity
collector report-currency exchange-fn)
)
;; Convert gnc:monetary to number (used to generate data for the chart)
(define (monetary->double monetary)
(gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))
)
;; gather money in/out data for all date intervals
(set! work-done 0)
(set! work-to-do (length dates-list))
(for-each
(lambda (date-pair)
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 80 (/ work-done work-to-do)))
(let* ((settings (list (cons 'accounts accounts)
(cons 'to-date-tp (second date-pair))
(cons 'from-date-tp (first date-pair))
(cons 'report-currency report-currency)
(cons 'include-trading-accounts include-trading-accounts)
(cons 'to-report-currency to-report-currency)))
(result (cashflow-barchart-calc-money-in-out settings))
(money-in-collector (cdr (assq 'money-in-collector result)))
(money-out-collector (cdr (assq 'money-out-collector result)))
(money-net-collector (gnc:make-commodity-collector))
(money-in-monetary (sum-collector money-in-collector))
(money-out-monetary (sum-collector money-out-collector))
(money-net-monetary #f)
)
(money-net-collector 'merge money-in-collector #f)
(money-net-collector 'minusmerge money-out-collector #f)
(set! money-net-monetary (sum-collector money-net-collector))
(set! in-list (cons money-in-monetary in-list))
(set! out-list (cons money-out-monetary out-list))
(set! net-list (cons money-net-monetary net-list))
(in-total-collector 'merge money-in-collector #f)
(out-total-collector 'merge money-out-collector #f)
))
dates-list)
(net-total-collector 'merge in-total-collector #f)
(net-total-collector 'minusmerge out-total-collector #f)
;; flip result lists (they were built by appending to the front)
(set! in-list (reverse in-list))
(set! out-list (reverse out-list))
(set! in-value-list (map monetary->double in-list))
(set! out-value-list (map monetary->double out-list))
(if show-net?
(begin
(set! net-list (reverse net-list))
(set! net-value-list (map monetary->double net-list)))
)
(gnc:report-percent-done 90)
(gnc:html-barchart-set-title! chart report-title)
(gnc:html-barchart-set-subtitle!
chart (sprintf #f
(_ "%s to %s")
(gnc-print-date from-date-tp)
(gnc-print-date to-date-tp)))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
(gnc:html-barchart-set-row-labels! chart date-string-list)
(gnc:html-barchart-set-y-axis-label!
chart (gnc-commodity-get-mnemonic report-currency))
(if show-inout?
(begin
(add-column! in-value-list)
(add-column! out-value-list)
))
(if show-net?
(add-column! net-value-list))
;; Legend labels, colors
(gnc:html-barchart-set-col-labels!
chart (append
(if show-inout?
(list (_ "Money In") (_ "Money Out")) '())
(if show-net?
(list (_ "Net Flow")) '())))
(gnc:html-barchart-set-col-colors!
chart (append
(if show-inout?
'("blue" "red") '())
(if show-net?
'("green") '())))
(gnc:report-percent-done 95)
;; If we have no data in the plot, display warning message
(if non-zeros
(gnc:html-document-add-object! doc chart)
(gnc:html-document-add-object!
doc
(gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj)))
)
(if (and non-zeros show-table?)
(let* ((table (gnc:make-html-table)))
(set! date-string-list (append date-string-list (list "Total")))
(set! in-list (append in-list (list (sum-collector in-total-collector))))
(set! out-list (append out-list (list (sum-collector out-total-collector))))
(if show-net?
(set! net-list (append net-list (list (sum-collector net-total-collector)))))
(gnc:html-table-set-col-headers!
table (append (list (_ "Date"))
(if show-inout?
(list (_ "Money In") (_ "Money Out")) '())
(if show-net?
(list (_ "Net Flow")) '())
))
(gnc:html-document-add-object!
doc (gnc:make-html-text (gnc:html-markup-h3 (_ "Overview:"))))
(gnc:html-table-append-column! table date-string-list)
(if show-inout?
(begin
(gnc:html-table-append-column! table in-list)
(gnc:html-table-append-column! table out-list)
))
(if show-net?
(gnc:html-table-append-column! table net-list))
;; set numeric columns to align right
(for-each
(lambda (col)
(gnc:html-table-set-col-style!
table col "td"
'attribute (list "class" "number-cell")))
'(1 2 3))
(gnc:html-document-add-object! doc table)
)
)
)
;; else: error condition: no accounts specified
(gnc:html-document-add-object!
doc
(gnc:html-make-no-account-warning
reportname (gnc:report-id report-obj)))
) ;; if not null? accounts
(gnc:report-finished)
doc))
;; function to add inflow and outflow of money
(define (cashflow-barchart-calc-money-in-out settings)
(let* ((accounts (cdr (assq 'accounts settings)))
(to-date-tp (cdr (assq 'to-date-tp settings)))
(from-date-tp (cdr (assq 'from-date-tp settings)))
(report-currency (cdr (assq 'report-currency settings)))
(include-trading-accounts (cdr (assq 'include-trading-accounts settings)))
(to-report-currency (cdr (assq 'to-report-currency settings)))
(is-report-account? (account-in-list-pred accounts))
(money-in-accounts '())
(money-in-hash (make-hash-table))
(money-in-collector (gnc:make-commodity-collector))
(money-out-accounts '())
(money-out-hash (make-hash-table))
(money-out-collector (gnc:make-commodity-collector))
(all-splits (gnc:account-get-trans-type-splits-interval accounts '() from-date-tp to-date-tp))
(splits-seen-table (make-hash-table)))
(define (split-seen? split)
(if (split-hashtable-ref splits-seen-table split) #t
(begin
(split-hashtable-set! splits-seen-table split #t)
#f)))
(define (work-per-split split)
(let ((parent (xaccSplitGetParent split)))
(if (and (gnc:timepair-le (gnc-transaction-get-date-posted parent) to-date-tp)
(gnc:timepair-ge (gnc-transaction-get-date-posted parent) from-date-tp))
(let* ((parent-description (xaccTransGetDescription parent))
(parent-currency (xaccTransGetCurrency parent)))
;(gnc:debug parent-description
; " - "
; (gnc-commodity-get-printname parent-currency))
(for-each
(lambda (s)
(let* ((s-account (xaccSplitGetAccount s))
(s-account-type (xaccAccountGetType s-account))
(s-amount (xaccSplitGetAmount s))
(s-value (xaccSplitGetValue s))
(s-commodity (xaccAccountGetCommodity s-account)))
;; Check if this is a dangling split
;; and print a warning
(if (null? s-account)
(display
(string-append
"WARNING: s-account is NULL for split: "
(gncSplitGetGUID s) "\n")))
;(gnc:debug (xaccAccountGetName s-account))
(if (and ;; make sure we don't have
(not (null? s-account)) ;; any dangling splits
(or include-trading-accounts (not (eq? s-account-type ACCT-TYPE-TRADING)))
(not (is-report-account? s-account)))
(if (not (split-seen? s))
(begin
(if (gnc-numeric-negative-p s-value)
(let ((s-account-in-collector (account-hashtable-ref money-in-hash s-account)))
;(gnc:debug "in:" (gnc-commodity-get-printname s-commodity)
; (gnc-numeric-to-double s-amount)
; (gnc-commodity-get-printname parent-currency)
; (gnc-numeric-to-double s-value))
(if (not s-account-in-collector)
(begin
(set! s-account-in-collector (gnc:make-commodity-collector))
(account-hashtable-set! money-in-hash s-account
s-account-in-collector)
(set! money-in-accounts (cons s-account money-in-accounts))
)
)
(let ((s-report-value (to-report-currency parent-currency
(gnc-numeric-neg s-value)
(gnc-transaction-get-date-posted
parent))))
(money-in-collector 'add report-currency s-report-value)
(s-account-in-collector 'add report-currency s-report-value))
)
(let ((s-account-out-collector (account-hashtable-ref money-out-hash s-account)))
;(gnc:debug "out:" (gnc-commodity-get-printname s-commodity)
; (gnc-numeric-to-double s-amount)
; (gnc-commodity-get-printname parent-currency)
; (gnc-numeric-to-double s-value))
(if (not s-account-out-collector)
(begin
(set! s-account-out-collector (gnc:make-commodity-collector))
(account-hashtable-set! money-out-hash s-account
s-account-out-collector)
(set! money-out-accounts (cons s-account money-out-accounts))
)
)
(let ((s-report-value (to-report-currency parent-currency
s-value
(gnc-transaction-get-date-posted
parent))))
(money-out-collector 'add report-currency s-report-value)
(s-account-out-collector 'add report-currency s-report-value))
)
)
)
)
)
)
)
(xaccTransGetSplitList parent)
)
)
)
)
)
;; Calculate money in and out for each split
(for-each work-per-split all-splits)
;; Return an association list of results
(list
(cons 'money-in-collector money-in-collector)
(cons 'money-out-collector money-out-collector))))
;; export to make uuid available to unit test: test-cashflow-barchart
(export cashflow-barchart-uuid)
(define cashflow-barchart-uuid "5426e4d987f6444387fe70880e5b28a0")
(gnc:define-report
'version 1
'name reportname
'report-guid cashflow-barchart-uuid
'menu-tip (N_ "Shows a barchart with cash flow over time")
'menu-path (list gnc:menuname-income-expense)
'options-generator cashflow-barchart-options-generator
'renderer cashflow-barchart-renderer)

View File

@@ -1,4 +1,5 @@
GNC_ADD_SCHEME_TEST(test-cash-flow test-cash-flow.scm)
GNC_ADD_SCHEME_TEST(test-cashflow-barchart test-cashflow-barchart.scm)
GNC_ADD_SCHEME_TEST(test-standard-category-report test-standard-category-report.scm)
GNC_ADD_SCHEME_TEST(test-standard-net-barchart test-standard-net-barchart.scm)
GNC_ADD_SCHEME_TEST(test-standard-net-linechart test-standard-net-linechart.scm)
@@ -20,5 +21,5 @@ GNC_ADD_SCHEME_TARGETS(scm-test-standard-reports
)
SET_DIST_LIST(test_standard_reports_DIST CMakeLists.txt Makefile.am ${scm_test_standard_reports_SOURCES}
test-cash-flow.scm test-standard-category-report.scm test-standard-net-barchart.scm
test-cash-flow.scm test-cashflow-barchart.scm test-standard-category-report.scm test-standard-net-barchart.scm
test-standard-net-linechart.scm)

View File

@@ -2,6 +2,7 @@ TESTS = $(SCM_TESTS)
SCM_TESTS = \
test-cash-flow \
test-cashflow-barchart \
test-standard-category-report \
test-standard-net-barchart \
test-standard-net-linechart

View File

@@ -0,0 +1,288 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(gnc:module-load "gnucash/report/report-system" 0)
(use-modules (gnucash engine))
(use-modules (sw_engine))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports cashflow-barchart))
(add-to-load-path "../../stylesheets/")
(use-modules (gnucash report stylesheets))
(use-modules (ice-9 format))
(use-modules (ice-9 streams))
(use-modules (srfi srfi-1))
(define (run-test)
(logging-and (test-in-txn)
(test-out-txn)
(test-null-txn)))
(define (set-option report page tag value)
((gnc:option-setter (gnc:lookup-option (gnc:report-options report)
page tag)) value))
(define constructor (record-constructor <report>))
(define structure
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
(list "Asset"
(list "Bank")
(list "Wallet"))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))))
;; Test two transactions from income to two different assets in two different days
(define (test-in-txn)
(let* ((template (gnc:find-report-template cashflow-barchart-uuid))
(options (gnc:make-report-options cashflow-barchart-uuid))
(report (constructor cashflow-barchart-uuid "bar" options
#t #t #f #f ""))
(renderer (gnc:report-template-renderer template)))
(let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
(bank-account (cdr (assoc "Bank" account-alist)))
(wallet-account (cdr (assoc "Wallet" account-alist)))
(expense-account (cdr (assoc "Expenses" account-alist)))
(income-account (cdr (assoc "Income" account-alist)))
(date-0 (gnc:get-start-this-month))
(date-1 (gnc:timepair-next-day date-0))
(date-2 (gnc:timepair-next-day date-1)))
(env-create-transaction env
date-1
bank-account
income-account
(gnc:make-gnc-numeric 1 1))
(env-create-transaction env
date-2
wallet-account
income-account
(gnc:make-gnc-numeric 5 1))
(begin
(set-option report gnc:pagename-display "Show Table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
(set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
(set-option report gnc:pagename-general "Step Size" 'DayDelta)
(set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
(set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
(set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
(let ((doc (renderer report)))
(gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
(list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
1 2 3)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result)))
(total (stream->list
(pattern-streamer "<tr><td>Total</td>"
(list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
(and (equal? (second row) (fourth row))
(= 0 (string->number (car (third row))))))
tbl)
(= 0 (tbl-ref->number tbl 0 1)) ; 1st day in =0
(= 1 (tbl-ref->number tbl 1 1)) ; 2nd day in =1
(= 5 (tbl-ref->number tbl 2 1)) ; 3rd day in =5
(= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) ; total in=total net
(= 0 (tbl-ref->number total 0 1)) ; total out=0
(= 3 (tbl-row-count tbl))
(= 4 (tbl-column-count tbl)))))
)
)
)
)
;; Test two transactions from two different assets to expense in two different days
(define (test-out-txn)
(let* ((template (gnc:find-report-template cashflow-barchart-uuid))
(options (gnc:make-report-options cashflow-barchart-uuid))
(report (constructor cashflow-barchart-uuid "bar" options
#t #t #f #f ""))
(renderer (gnc:report-template-renderer template)))
(let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
(bank-account (cdr (assoc "Bank" account-alist)))
(wallet-account (cdr (assoc "Wallet" account-alist)))
(expense-account (cdr (assoc "Expenses" account-alist)))
(income-account (cdr (assoc "Income" account-alist)))
(date-0 (gnc:get-start-this-month))
(date-1 (gnc:timepair-next-day date-0))
(date-2 (gnc:timepair-next-day date-1)))
(env-create-transaction env
date-1
bank-account
income-account
(gnc:make-gnc-numeric 100 1)) ; large in txn to avoid negative net (hard to parse)
(env-create-transaction env
date-1
expense-account
bank-account
(gnc:make-gnc-numeric 1 1))
(env-create-transaction env
date-2
wallet-account
income-account
(gnc:make-gnc-numeric 100 1)) ; large in txn to avoid negative net (hard to parse)
(env-create-transaction env
date-2
expense-account
wallet-account
(gnc:make-gnc-numeric 5 1))
(begin
(set-option report gnc:pagename-display "Show Table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
(set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
(set-option report gnc:pagename-general "Step Size" 'DayDelta)
(set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
(set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
(set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
(let ((doc (renderer report)))
(gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
(list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
1 2 3)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result)))
(total (stream->list
(pattern-streamer "<tr><td>Total</td>"
(list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row) ; test in-out=net in all rows (all days)
(let ((in (string->number (car (second row))))
(out (string->number (car (third row))))
(net (string->number (car (fourth row)))))
(= (- in out) net)))
tbl)
(= 0 (tbl-ref->number tbl 0 2)) ; 1st day out =0
(= 1 (tbl-ref->number tbl 1 2)) ; 2nd day out =1
(= 5 (tbl-ref->number tbl 2 2)) ; 3rd day out =5
(= (- (tbl-ref->number total 0 0) (tbl-ref->number total 0 1)) ; total in-total out=total net
(tbl-ref->number total 0 2))
(= 6 (tbl-ref->number total 0 1)) ; total out=6
(= 3 (tbl-row-count tbl))
(= 4 (tbl-column-count tbl)))))
)
)
)
)
;; Test null transaction (transaction between assets)
;; This test is identical to test-in-txn but with an extra transaction between assets
(define (test-null-txn)
(let* ((template (gnc:find-report-template cashflow-barchart-uuid))
(options (gnc:make-report-options cashflow-barchart-uuid))
(report (constructor cashflow-barchart-uuid "bar" options
#t #t #f #f ""))
(renderer (gnc:report-template-renderer template)))
(let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
(bank-account (cdr (assoc "Bank" account-alist)))
(wallet-account (cdr (assoc "Wallet" account-alist)))
(expense-account (cdr (assoc "Expenses" account-alist)))
(income-account (cdr (assoc "Income" account-alist)))
(date-0 (gnc:get-start-this-month))
(date-1 (gnc:timepair-next-day date-0))
(date-2 (gnc:timepair-next-day date-1)))
(env-create-transaction env
date-1
bank-account
income-account
(gnc:make-gnc-numeric 1 1))
(env-create-transaction env
date-1
bank-account
wallet-account
(gnc:make-gnc-numeric 20 1)) ; this transaction should not be counted
(env-create-transaction env
date-2
wallet-account
income-account
(gnc:make-gnc-numeric 5 1))
(begin
(set-option report gnc:pagename-display "Show Table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
(set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
(set-option report gnc:pagename-general "Step Size" 'DayDelta)
(set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
(set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
(set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
(let ((doc (renderer report)))
(gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
(list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
1 2 3)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result)))
(total (stream->list
(pattern-streamer "<tr><td>Total</td>"
(list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
(and (equal? (second row) (fourth row))
(= 0 (string->number (car (third row))))))
tbl)
(= 0 (tbl-ref->number tbl 0 1)) ; 1st day in =0
(= 1 (tbl-ref->number tbl 1 1)) ; 2nd day in =1
(= 5 (tbl-ref->number tbl 2 1)) ; 3rd day in =5
(= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) ; total in=total net
(= 0 (tbl-ref->number total 0 1)) ; total out=0
(= 3 (tbl-row-count tbl))
(= 4 (tbl-column-count tbl)))))
)
)
)
)