diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt index 35c53c2b44..2ff9016e41 100644 --- a/gnucash/report/standard-reports/CMakeLists.txt +++ b/gnucash/report/standard-reports/CMakeLists.txt @@ -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 diff --git a/gnucash/report/standard-reports/Makefile.am b/gnucash/report/standard-reports/Makefile.am index e95f3692c3..7040d880b9 100644 --- a/gnucash/report/standard-reports/Makefile.am +++ b/gnucash/report/standard-reports/Makefile.am @@ -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 \ diff --git a/gnucash/report/standard-reports/cashflow-barchart.scm b/gnucash/report/standard-reports/cashflow-barchart.scm new file mode 100644 index 0000000000..0589a34989 --- /dev/null +++ b/gnucash/report/standard-reports/cashflow-barchart.scm @@ -0,0 +1,521 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; cashflow-barchart.scm: cash flow barchart report +;; +;; By Jose Marino +;; +;; based on cash-flow.scm by: +;; Herbert Thoma +;; and net-barchart by: +;; Robert Merkel +;; +;; 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) diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt index a77118683c..7be4c9c672 100644 --- a/gnucash/report/standard-reports/test/CMakeLists.txt +++ b/gnucash/report/standard-reports/test/CMakeLists.txt @@ -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) diff --git a/gnucash/report/standard-reports/test/Makefile.am b/gnucash/report/standard-reports/test/Makefile.am index d6d5153af0..2a4e80803b 100644 --- a/gnucash/report/standard-reports/test/Makefile.am +++ b/gnucash/report/standard-reports/test/Makefile.am @@ -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 diff --git a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm new file mode 100644 index 0000000000..e4f7dde654 --- /dev/null +++ b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm @@ -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 )) + + +(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 "" + (list (list "([0-9]+)/([0-9]+)/([0-9]+)" + 1 2 3) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1)) + result))) + (total (stream->list + (pattern-streamer "Total" + (list (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 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 "" + (list (list "([0-9]+)/([0-9]+)/([0-9]+)" + 1 2 3) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1)) + result))) + (total (stream->list + (pattern-streamer "Total" + (list (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 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 "" + (list (list "([0-9]+)/([0-9]+)/([0-9]+)" + 1 2 3) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1)) + result))) + (total (stream->list + (pattern-streamer "Total" + (list (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 1) + (list "[^0-9]*([^<]*)" 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))))) + ) + ) + ) + )