diff --git a/gnucash/report/reports/standard/ifrs-cost-basis.scm b/gnucash/report/reports/standard/ifrs-cost-basis.scm index 78f8d2846f..59ce4a446c 100644 --- a/gnucash/report/reports/standard/ifrs-cost-basis.scm +++ b/gnucash/report/reports/standard/ifrs-cost-basis.scm @@ -22,6 +22,7 @@ (define-module (gnucash reports standard ifrs-cost-basis)) (use-modules (srfi srfi-1)) +(use-modules (srfi srfi-9)) (use-modules (ice-9 match)) (use-modules (gnucash utilities)) (use-modules (gnucash report)) @@ -57,7 +58,7 @@ that this report will accurately portray this options activity."))) (define optname-proceeds-acct "Proceeds Account") (define optname-dividend-acct "Dividend Account") (define optname-capgains-acct "Cap Gains Account") -;; (define optname-fees-acct "Fees Account") +(define optname-fees-acct "Fees Account") (define optname-report-currency "Report's currency") (define optname-format-cells "Format monetary cells") @@ -71,6 +72,10 @@ for shorts. Disable to use alternate style every other row") (define opthelp-cap-purch-costs "Check this option to capitalise purchase \ commissions in cumulative average cost and gain/loss after commission") +(define optname-cap-fee-action "Action field filter for fees") +(define opthelp-cap-fee-action "This string will be used to compare with \ +the split action field to detect capitalized fees on stock activity") + (define (options-generator) (let ((options (gnc:new-options))) @@ -103,10 +108,14 @@ commissions in cumulative average cost and gain/loss after commission") gnc:pagename-general optname-capgains-acct "d" "Cap Gains Account" #f #f (list ACCT-TYPE-INCOME))) - ;; (add-option - ;; (gnc:make-account-sel-limited-option - ;; gnc:pagename-general optname-fees-acct "c" "Fees Account" - ;; #f #f (list ACCT-TYPE-EXPENSE))) + (add-option + (gnc:make-account-sel-limited-option + gnc:pagename-general optname-fees-acct "c5" "Fees Account" + #f #f (list ACCT-TYPE-EXPENSE))) + + (add-option + (gnc:make-string-option + gnc:pagename-general optname-cap-fee-action "d5" opthelp-cap-fee-action "Fee")) (add-option (gnc:make-simple-boolean-option @@ -170,6 +179,161 @@ commissions in cumulative average cost and gain/loss after commission") (define (trans-extract-amount trans account numfilter) (trans-extract trans account numfilter xaccSplitGetAmount)) +(define-record-type :txn-info + (make-txn-info stock-amt stock-val proceeds-val + fees-cap-val fees-exp-val dividend-val capgains-val) + txn-info? + (stock-amt get-stock-amt set-stock-amt!) + (stock-val get-stock-val set-stock-val!) + (proceeds-val get-proceeds-val set-proceeds-val!) + (fees-cap-val get-fees-cap-val set-fees-cap-val!) + (fees-exp-val get-fees-exp-val set-fees-exp-val!) + (dividend-val get-dividend-val set-dividend-val!) + (capgains-val get-capgains-val set-capgains-val!)) + +;; "bitfield" Nabc a=neg b=zero c=pos +(define (N001 x) (if (number? x) (> x 0) #f)) +(define (N100 x) (if (number? x) (< x 0) #f)) +(define (N010 x) (if (number? x) (= x 0) #t)) +(define (N011 x) (if (number? x) (>= x 0) #t)) +(define (N110 x) (if (number? x) (<= x 0) #t)) +(define (N111 x) #t) +;; N000 should be (not x) however we can accept a zero-amount split too +(define (N000 x) (if (number? x) (= x 0) #t)) + +;; --stock-- cash cap exp divi capg +;; amt val fees fees + +(define open-types + (list + (list N001 N001 N100 N011 N000 N000 N000 "Open Long") + (list N100 N100 N001 N011 N000 N000 N000 "Open Short"))) + +(define long-types + (list + (list N001 N001 N100 N011 N000 N000 N000 "Buy") + (list N100 N100 N011 N000 N011 N000 N111 "Sell") + (list N000 N000 N001 N000 N011 N100 N000 "Dividend") + (list N001 N001 N001 N011 N000 N100 N000 "Dividend reinvestment (w/ remainder)") + (list N001 N001 N000 N011 N000 N100 N000 "Dividend reinvestment (w/o remainder)") + (list N000 N100 N001 N011 N000 N000 N000 "Return of Capital") + (list N000 N001 N000 N000 N011 N100 N000 "Notional distribution") + (list N001 N000 N000 N011 N000 N000 N000 "Stock split") + (list N100 N000 N000 N011 N000 N000 N000 "Reverse split") + (list N100 N100 N001 N000 N011 N000 N111 "Reverse split w/ cash in lieu for fractionals"))) + +(define short-types + (list + (list N100 N100 N001 N011 N000 N000 N000 "Short Sell") + (list N001 N001 N110 N000 N011 N000 N111 "Cover Buy") + (list N000 N000 N100 N000 N011 N001 N000 "Compensatory dividend") + (list N000 N000 N000 N011 N000 N000 N000 "Dividend reinvestment (w remainder)") + (list N000 N000 N000 N011 N000 N000 N000 "Dividend reinvestment (w/o remainder)") + (list N000 N001 N100 N011 N000 N000 N000 "Compensatory return of capital") + (list N000 N100 N000 N000 N011 N001 N000 "Compensatory notional distribution") + (list N100 N000 N000 N011 N000 N000 N000 "Stock split") + (list N001 N000 N000 N011 N000 N000 N000 "Reverse split") + (list N001 N001 N100 N000 N011 N000 N111 "Reverse split w/ cash in lieu for fractionals"))) + +(define (cmp amt neg zero pos) + (cond ((< amt 0) neg) + ((= amt 0) zero) + (else pos))) + +(define shown-headers? #f) +(define (txn-identify trans txn-info cumul-units) + (define (get-amount mon) + (and (gnc:gnc-monetary? mon) + (gnc:gnc-monetary-amount mon))) + (define trans-units (get-amount (get-stock-amt txn-info))) + (define trans-value (get-amount (get-stock-val txn-info))) + (define cash-value (get-amount (get-proceeds-val txn-info))) + (define fees-stock (get-amount (get-fees-cap-val txn-info))) + (define fees-expense (get-amount (get-fees-exp-val txn-info))) + (define dividend (get-amount (get-dividend-val txn-info))) + (define capgains (get-amount (get-capgains-val txn-info))) + (let lp ((types (cmp cumul-units short-types open-types long-types))) + (match types + (() + ;; (gnc:pk (qof-print-date (xaccTransGetDate trans)) txn-info) + "Unknown") + (((amt-fn val-fn proc-fn fee-cap-fn fee-exp-fn div-fn capg-fn res) . tail) + (if (and (amt-fn trans-units) + (val-fn trans-value) + (proc-fn cash-value) + (fee-cap-fn fees-stock) + (fee-exp-fn fees-expense) + (div-fn dividend) + (capg-fn capgains)) + res + (lp tail)))))) + +(define (txn->info txn stock-acct cap-fee-action + proceeds-acct capgains-acct expenses-acct dividend-acct) + (define (from-acct? acct) + (lambda (split) + (equal? (xaccSplitGetAccount split) acct))) + (define (cap-expenses? split) + (and ((from-acct? stock-acct) split) + (equal? (gnc-get-action-num txn split) cap-fee-action))) + (define (make-monetary account amount) + (and amount (gnc:make-gnc-monetary (xaccAccountGetCommodity account) amount))) + (define (make-parent-monetary amount) + (and amount (gnc:make-gnc-monetary (gnc-account-get-currency-or-parent stock-acct) amount))) + (let lp ((splits (xaccTransGetSplitList txn)) + (stock-amt #f) + (stock-val #f) + (proceeds-val #f) + (fees-cap-val #f) + (fees-exp-val #f) + (dividend-val #f) + (capgains-val #f)) + (match splits + (() (make-txn-info + (make-monetary stock-acct stock-amt) + (make-parent-monetary stock-val) + (make-monetary proceeds-acct proceeds-val) + (make-parent-monetary fees-cap-val) + (make-monetary expenses-acct fees-exp-val) + (make-monetary dividend-acct dividend-val) + (make-monetary capgains-acct capgains-val))) + + (((? (from-acct? proceeds-acct) split) . rest) + (lp rest stock-amt stock-val + (M+ proceeds-val (xaccSplitGetAmount split)) + fees-cap-val fees-exp-val dividend-val capgains-val)) + + (((? (from-acct? capgains-acct) split) . rest) + (lp rest stock-amt stock-val proceeds-val fees-cap-val fees-exp-val dividend-val + (M+ capgains-val (xaccSplitGetAmount split)))) + + (((? (from-acct? expenses-acct) split) . rest) + (lp rest stock-amt stock-val proceeds-val fees-cap-val + (M+ fees-exp-val (xaccSplitGetAmount split)) + dividend-val capgains-val)) + + (((? (from-acct? dividend-acct) split) . rest) + (lp rest stock-amt stock-val proceeds-val fees-cap-val fees-exp-val + (M+ dividend-val (xaccSplitGetAmount split)) + capgains-val)) + + ;; testing capitalized fees must take place *before* processing + ;; stock amt/val because it belongs to the stock account. + (((? cap-expenses? split) . rest) + (lp rest stock-amt stock-val proceeds-val + (M+ fees-cap-val (xaccSplitGetValue split)) + fees-exp-val dividend-val capgains-val)) + + (((? (from-acct? stock-acct) split) . rest) + (lp rest + (M+ stock-amt (xaccSplitGetAmount split)) + (M+ stock-val (xaccSplitGetValue split)) + proceeds-val fees-cap-val fees-exp-val dividend-val capgains-val)) + + ((_ . rest) + (lp rest stock-amt stock-val proceeds-val fees-cap-val fees-exp-val + dividend-val capgains-val))))) + (define (ifrs-cost-basis-renderer report-obj) (define (opt-val section name) (gnc:option-value @@ -187,11 +351,12 @@ commissions in cumulative average cost and gain/loss after commission") (define proceeds-acct (opt-val gnc:pagename-general optname-proceeds-acct)) (define dividend-acct (opt-val gnc:pagename-general optname-dividend-acct)) (define capgains-acct (opt-val gnc:pagename-general optname-capgains-acct)) - ;; (define fees-acct (opt-val gnc:pagename-general optname-fees-acct)) + (define fees-acct (opt-val gnc:pagename-general optname-fees-acct)) (define report-currency (opt-val gnc:pagename-general optname-report-currency)) (define format-cells (opt-val gnc:pagename-general optname-format-cells)) (define short-alternate-format? (opt-val gnc:pagename-general optname-format-short)) (define cap-purch-costs? (opt-val gnc:pagename-general optname-cap-purch-costs)) + (define cap-fee-action (opt-val gnc:pagename-general optname-cap-fee-action)) (define document (gnc:make-html-document)) (define large 10000000) @@ -199,18 +364,9 @@ commissions in cumulative average cost and gain/loss after commission") (/ (gnc-pricedb-convert-balance-nearest-price-t64 db large from to time) large)) - (define (stock-split prev delta) - (let ((exact (/ (+ delta prev) prev))) - (format #f "~a:~a Split" (numerator exact) (denominator exact)))) - (define (to-cell elt) (gnc:make-html-table-cell/markup "number-cell" elt)) - (define (cmp amt neg zero pos) - (cond ((< amt 0) neg) - ((= amt 0) zero) - (else pos))) - (gnc:html-document-set-title! document "IFRS weighted average cost basis Report") (cond @@ -250,10 +406,10 @@ commissions in cumulative average cost and gain/loss after commission") (gnc:html-document-set-title! document - (format #f "Average-Cost (Basis) Report: From ~a to ~a. Report-currency ~a" - (qof-print-date startdate) - (qof-print-date enddate) - (gnc-commodity-get-mnemonic report-currency))) + (gnc:format "Average-Cost (Basis) Report: From ${startdate} to ${enddate}. Report-currency ${currency}" + 'startdate (qof-print-date startdate) + 'enddate (qof-print-date enddate) + 'currency (gnc-commodity-get-mnemonic report-currency))) (gnc:html-table-set-col-headers! table (list "date" "description" "trans-units" "cumul-units" "note" @@ -279,12 +435,15 @@ commissions in cumulative average cost and gain/loss after commission") ((split . rest-splits) (let* ((trans (xaccSplitGetParent split)) + (txn-info (txn->info trans stock-acct cap-fee-action proceeds-acct + capgains-acct fees-acct dividend-acct)) (trans-units (trans-extract-amount trans stock-acct #f)) (trans-value (trans-extract-value trans stock-acct #f)) - (proceeds-val (trans-extract-value trans proceeds-acct #f)) + (cash-value (trans-extract-value trans proceeds-acct #f)) (dividends-val (trans-extract-value trans dividend-acct #f)) (capgains-val (trans-extract-value trans capgains-acct #f)) - (fees-value (trans-extract-value trans #f "Fee")) + (fees-expense (trans-extract-value trans fees-acct #f)) + (fees-value (trans-extract-value trans #f cap-fee-action)) (new-units (M+ cumul-units trans-units)) (sale? @@ -296,7 +455,7 @@ commissions in cumulative average cost and gain/loss after commission") (purchase? (cond ((= trans-value 0) dividends-val) ;dividends - ((= trans-units 0) proceeds-val) ;return of capital + ((= trans-units 0) cash-value) ;return of capital ((> trans-units 0) (< 0 new-units)) ;regular buy ((< trans-units 0) (< new-units 0)))) ;buy during short @@ -307,7 +466,7 @@ commissions in cumulative average cost and gain/loss after commission") (purchase-val (and purchase? (M- trans-value purchase-cost))) (cash-dividends (M- dividends-val)) (proceeds-cost (and sale? fees-value)) - (proceeds-val (and sale? (M+ proceeds-val proceeds-cost))) + (proceeds-value (and sale? (M+ cash-value proceeds-cost))) ;; now convert to report-currency (fx (get-fx pricedb currency report-currency @@ -315,14 +474,14 @@ commissions in cumulative average cost and gain/loss after commission") (conv-purchase-val (M* fx purchase-val)) (conv-purchase-cost (M* fx purchase-cost)) (conv-dividends (M* fx cash-dividends)) - (conv-proceeds-val (M* fx proceeds-val)) + (conv-proceeds-value (M* fx proceeds-value)) (conv-proceeds-cost (M* fx proceeds-cost)) ;; now perform AVERAGE-COST-BASIS calculations (average-cost-basis/unit-for-sale (M-abs (M/ cumul-average-cost-basis cumul-units))) (average-cost-basis-of-sale - (and proceeds-val (M* average-cost-basis/unit-for-sale + (and proceeds-value (M* average-cost-basis/unit-for-sale trans-units))) (cumul-average-cost-basis (M+ cumul-average-cost-basis @@ -330,11 +489,11 @@ commissions in cumulative average cost and gain/loss after commission") (and cap-purch-costs? conv-purchase-cost) average-cost-basis-of-sale)) - (net-proceeds (M- conv-proceeds-val conv-proceeds-cost)) + (net-proceeds (M- conv-proceeds-value conv-proceeds-cost)) (gain-post-commission (M+ net-proceeds average-cost-basis-of-sale (and (not cap-purch-costs?) conv-purchase-cost))) - (gain-pre-commission (M+ conv-proceeds-val + (gain-pre-commission (M+ conv-proceeds-value average-cost-basis-of-sale)) (new-gross-profit (M+ cumul-gross-profit gain-pre-commission)) @@ -343,7 +502,7 @@ commissions in cumulative average cost and gain/loss after commission") conv-dividends))) ;; (gnc:pk trans 'trans-units trans-units 'trans-value trans-value - ;; 'cumul-units cumul-units 'proceeds-val proceeds-val + ;; 'cumul-units cumul-units 'proceeds-value proceeds-value ;; 'sale? sale? 'purchase? purchase?) (cond ((not (< startdate (xaccTransGetDate (xaccSplitGetParent (car splits))) @@ -368,37 +527,18 @@ commissions in cumulative average cost and gain/loss after commission") (cond ((< new-units 0 cumul-units) "ERROR: long→short") ((< cumul-units 0 new-units) "ERROR: short→long") - ((= 0 cumul-units) (cmp new-units "Open Short" "1" "Open Long")) - ((= 0 new-units) (cmp trans-units "Close Long" "2" "Close Short")) - ((= 0 trans-units trans-value) - (cmp cumul-units "Compensatory Dividend" "7" "Dividend")) - ((= 0 trans-units) - (cond (cash-dividends - (cmp cumul-units - "Compensatory Notional Distribution" - "7" - "Notional Distribution")) - (purchase-val - (cmp cumul-units - "Compensatory Return Capital" - "8" - "Return Capital")) - (else "3"))) - ((= 0 trans-value) (stock-split cumul-units trans-units)) - (purchase-val (cmp purchase-val "Short Sell" "5" "Buy")) - (proceeds-val (cmp proceeds-val "Short Buy" "6" "Sell")) - (else "4")) + (else (txn-identify trans txn-info cumul-units))) (gnc-commodity-get-mnemonic currency) (to-cell (gnc:default-price-renderer report-currency fx)) (to-cell (to-orig-currency purchase-val)) (to-cell (to-orig-currency purchase-cost)) (to-cell (to-orig-currency cash-dividends)) - (to-cell (to-orig-currency proceeds-val)) + (to-cell (to-orig-currency proceeds-value)) (to-cell (to-orig-currency proceeds-cost)) (to-cell (to-report-currency conv-purchase-val)) (to-cell (to-report-currency conv-purchase-cost)) (to-cell (to-report-currency conv-dividends)) - (to-cell (to-report-currency conv-proceeds-val)) + (to-cell (to-report-currency conv-proceeds-value)) (to-cell (to-report-currency conv-proceeds-cost)) (to-cell (to-report-currency average-cost-basis/unit-for-sale)) (to-cell (to-report-currency (M- average-cost-basis-of-sale))) diff --git a/gnucash/report/reports/standard/test/test-ifrs-cost-basis.scm b/gnucash/report/reports/standard/test/test-ifrs-cost-basis.scm index a37ed1d347..f4c7d2c2de 100644 --- a/gnucash/report/reports/standard/test/test-ifrs-cost-basis.scm +++ b/gnucash/report/reports/standard/test/test-ifrs-cost-basis.scm @@ -250,6 +250,8 @@ (set-option! options "General" "Report's currency" (mnemonic->commodity "CAD")) (set-option! options "General" "Proceeds Account" (assoc-ref account-alist "USD Cash")) + (set-option! options "General" "Fees Account" + (assoc-ref account-alist "USD Commissions")) (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 2019))) (set-option! options "General" "End Date" @@ -284,7 +286,7 @@ (sxml->table-row-col sxml 1 4 #f)) (test-equal "Return Capital $2500" - '("04/16/20" "Return of Capital" "0 SPY" "325 SPY" "Return Capital" + '("04/16/20" "Return of Capital" "0 SPY" "325 SPY" "Return of Capital" "CAD" "C$1.0000" "-C$2,500.00" "-C$2,500.00" "C$184.68" "C$57,519.90" "-C$6,009.95" "-C$6,019.90" "-C$6,019.90") (sxml->table-row-col sxml 1 5 #f)) @@ -296,7 +298,7 @@ (sxml->table-row-col sxml 1 6 #f)) (test-equal "2:1 split" - '("05/11/20" "stock split" "450 SPY" "900 SPY" "2:1 Split" + '("05/11/20" "stock split" "450 SPY" "900 SPY" "Stock split" "CAD" "C$1.0000" "C$233.38" "C$105,019.90" "-C$6,009.95" "-C$6,019.90" "-C$6,019.90") (sxml->table-row-col sxml 1 7 #f)) @@ -315,7 +317,7 @@ (sxml->table-row-col sxml 1 9 #f)) (test-equal "sell 915 SPY close long" - '("06/10/20" "Sell SPY" "-915 SPY" "0 SPY" "Close Long" "CAD" + '("06/10/20" "Sell SPY" "-915 SPY" "0 SPY" "Sell" "CAD" "C$1.0000" "C$128,100.00" "C$9.95" "C$128,100.00" "C$9.95" "C$120.51" "C$110,266.92" "C$0.00" "C$17,823.14" "C$17,833.08" "C$128,090.05" "C$17,570.15" "C$17,540.30" "C$17,540.30") @@ -334,14 +336,14 @@ (sxml->table-row-col sxml 1 12 #f)) (test-equal "buy 50 SPY short" - '("06/18/20" "Buy SPY Close Short" "50 SPY" "-100 SPY" "Short Buy" + '("06/18/20" "Buy SPY Close Short" "50 SPY" "-100 SPY" "Cover Buy" "CAD" "C$1.0000" "-C$5,000.00" "C$9.95" "-C$5,000.00" "C$9.95" "C$152.87" "-C$7,643.37" "-C$15,286.73" "C$2,633.42" "C$2,643.37" "-C$5,009.95" "C$20,213.52" "C$20,173.72" "C$20,173.72") (sxml->table-row-col sxml 1 13 #f)) (test-equal "BUY 100 SPY close short" - '("06/20/20" "Buy SPY Close Short" "100 SPY" "0 SPY" "Close Short" + '("06/20/20" "Buy SPY Close Short" "100 SPY" "0 SPY" "Cover Buy" "CAD" "C$1.0000" "-C$8,000.00" "C$4.98" "-C$8,000.00" "C$4.98" "C$152.87" "-C$15,286.73" "C$0.00" "C$7,281.75" "C$7,286.73" "-C$8,004.98" "C$27,500.25" "C$27,455.47" "C$27,455.47")