From 51a0a55e43c742cbdb58440dce479e4e348e0a29 Mon Sep 17 00:00:00 2001 From: christopherlam Date: Tue, 24 Oct 2017 08:04:27 +0800 Subject: [PATCH] Change critical code to pure FP The function split-adder is the most crucial code in this report. This commit changes it to pure functional programming. --- .../standard-reports/income-gst-statement.scm | 39 +++++++------------ 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm index a74092fde4..f820d3f131 100644 --- a/gnucash/report/standard-reports/income-gst-statement.scm +++ b/gnucash/report/standard-reports/income-gst-statement.scm @@ -1173,33 +1173,22 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.") (letrec ((myadd (lambda (X Y) (if X (if Y (gnc-numeric-add X Y GNC-DENOM-AUTO GNC-RND-ROUND) X) Y))) (myneg (lambda (X) (if X (gnc-numeric-neg X) #f))) - (split-adder (lambda (split accountlist typefilter) + (split-adder (lambda (split accountlist) (let* ((transaction (xaccSplitGetParent split)) (splits-in-transaction (xaccTransGetSplitList transaction)) - (sum #f)) - (for-each (lambda (s) - (let* ((splitAcc (xaccSplitGetAccount s)) - (splitVal (if (xaccTransGetVoidStatus transaction) - (xaccSplitVoidFormerValue s) - (xaccSplitGetValue s))) - (splitCommodity (xaccAccountGetCommodity splitAcc)) - (splitAccType (xaccAccountGetType splitAcc)) - (splitAccName (xaccAccountGetName splitAcc))) - (if accountlist - (if (member splitAcc accountlist) - (set! sum (myadd sum splitVal)))) - (if typefilter - (if (eq? typefilter splitAccType) - (set! sum (myadd sum splitVal)))))) - splits-in-transaction) - sum))) - ;(sales-without-tax (lambda (s) (split-adder s #f ACCT-TYPE-INCOME))) - ;(purchases-without-tax (lambda (s) (split-adder s #f ACCT-TYPE-EXPENSE))) - (tax-on-sales (lambda (s) (split-adder s accounts-tax-collected #f))) - (tax-on-purchases (lambda (s) (split-adder s accounts-tax-paid #f))) - (sales-without-tax (lambda (s) (split-adder s accounts-sales #f))) - (purchases-without-tax (lambda (s) (split-adder s accounts-purchases #f))) - (account-adder (lambda (acc) (lambda (s) (split-adder s (list acc) #f)))) + (split-get-value (lambda (s) + (if (xaccTransGetVoidStatus transaction) + (xaccSplitVoidFormerValue s) + (xaccSplitGetValue s)))) + (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist))) + (filtered-splits (filter include-split? splits-in-transaction)) + (list-of-values (map split-get-value filtered-splits))) + (fold myadd #f list-of-values)))) + (tax-on-sales (lambda (s) (split-adder s accounts-tax-collected))) + (tax-on-purchases (lambda (s) (split-adder s accounts-tax-paid))) + (sales-without-tax (lambda (s) (split-adder s accounts-sales))) + (purchases-without-tax (lambda (s) (split-adder s accounts-purchases))) + (account-adder (lambda (acc) (lambda (s) (split-adder s (list acc))))) (total-sales (lambda (s) (myadd (tax-on-sales s) (sales-without-tax s)))) (total-purchases (lambda (s) (myadd (tax-on-purchases s) (purchases-without-tax s)))) (bank-remittance (lambda (s) (myneg (myadd (total-sales s) (total-purchases s)))))