1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2;; 3;; This program is free software; you can redistribute it and/or 4;; modify it under the terms of the GNU General Public License as 5;; published by the Free Software Foundation; either version 2 of 6;; the License, or (at your option) any later version. 7;; 8;; This program is distributed in the hope that it will be useful, 9;; but WITHOUT ANY WARRANTY; without even the implied warranty of 10;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11;; GNU General Public License for more details. 12;; 13;; You should have received a copy of the GNU General Public License 14;; along with this program; if not, contact: 15;; 16;; Free Software Foundation Voice: +1-617-542-5942 17;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 18;; Boston, MA 02110-1301, USA gnu@gnu.org 19;; 20;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 22(define-module (gnucash reports standard ifrs-cost-basis)) 23 24(use-modules (srfi srfi-1)) 25(use-modules (srfi srfi-9)) 26(use-modules (ice-9 match)) 27(use-modules (gnucash utilities)) 28(use-modules (gnucash report)) 29(use-modules (gnucash core-utils)) 30(use-modules (gnucash app-utils)) 31(use-modules (gnucash engine)) 32 33(define disclaimer 34 (gnc:make-html-text 35 (gnc:html-markup-p "This report is designed for cost basis 36accumulation and capital gain/loss reporting using the weighted 37average cost basis method, which is most consistent with typical 38accounting frameworks (US GAAP, IFRS, etc.). This report allows for 39for the choice to capitalize (most consistent with typical accounting 40frameworks) vs expense (used by some taxing jurisdictions) commissions 41paid on purchase.") 42 (gnc:html-markup-p "This report is not appropriate for FIFO, LIFO, or 43specific-identification methods for cost basis accumulation and 44capital gain/loss reporting. This report may not be appropriate for 45tax purposes, if the taxing jurisdiction requires a method other than 46the weighted average cost basis method.") 47 (gnc:html-markup-p "This report is not designed with options 48reporting in mind. If your activity involves options and/or futures 49that are purchased, written, and/or exercised, there is no guarantee 50that this report will accurately portray this options activity."))) 51 52(define reportname "IFRS weighted-average cost basis report") 53 54(define optname-startdate (N_ "Start Date")) 55(define optname-enddate (N_ "End Date")) 56 57(define optname-stock-acct "Stock Account") 58(define optname-proceeds-acct "Proceeds Account") 59(define optname-dividend-acct "Dividend Account") 60(define optname-capgains-acct "Cap Gains Account") 61(define optname-fees-acct "Fees Account") 62(define optname-report-currency "Report's currency") 63 64(define optname-format-cells "Format monetary cells") 65(define opthelp-format-cells "Check this option to show cells with currency") 66 67(define optname-format-short "Alternative row-style for shorts") 68(define opthelp-format-short "Check this option to use alternate style \ 69for shorts. Disable to use alternate style every other row") 70 71(define optname-cap-purch-costs "Capitalise purchase commissions") 72(define opthelp-cap-purch-costs "Check this option to capitalise purchase \ 73commissions in cumulative average cost and gain/loss after commission") 74 75(define optname-cap-fee-action "Action field filter for fees") 76(define opthelp-cap-fee-action "This string will be used to compare with \ 77the split action field to detect capitalized fees on stock activity") 78 79(define (options-generator) 80 (let ((options (gnc:new-options))) 81 82 (define (add-option new-option) 83 (gnc:register-option options new-option)) 84 85 (gnc:options-add-date-interval! 86 options gnc:pagename-general optname-startdate optname-enddate " ") 87 88 (gnc:options-add-currency! 89 options gnc:pagename-general optname-report-currency "a") 90 91 (add-option 92 (gnc:make-account-sel-limited-option 93 gnc:pagename-general optname-stock-acct "b" "Stock Account" 94 #f #f (list ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL))) 95 96 (add-option 97 (gnc:make-account-sel-limited-option 98 gnc:pagename-general optname-proceeds-acct "c" "Proceeds Account" 99 #f #f (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))) 100 101 (add-option 102 (gnc:make-account-sel-limited-option 103 gnc:pagename-general optname-dividend-acct "c" "Dividend Account" 104 #f #f (list ACCT-TYPE-INCOME))) 105 106 (add-option 107 (gnc:make-account-sel-limited-option 108 gnc:pagename-general optname-capgains-acct "d" "Cap Gains Account" 109 #f #f (list ACCT-TYPE-INCOME))) 110 111 (add-option 112 (gnc:make-account-sel-limited-option 113 gnc:pagename-general optname-fees-acct "c5" "Fees Account" 114 #f #f (list ACCT-TYPE-EXPENSE))) 115 116 (add-option 117 (gnc:make-string-option 118 gnc:pagename-general optname-cap-fee-action "d5" opthelp-cap-fee-action "Fee")) 119 120 (add-option 121 (gnc:make-simple-boolean-option 122 gnc:pagename-general optname-format-cells "e" opthelp-format-cells #t)) 123 124 (add-option 125 (gnc:make-simple-boolean-option 126 gnc:pagename-general optname-format-short "f" opthelp-format-short #t)) 127 128 (add-option 129 (gnc:make-simple-boolean-option 130 gnc:pagename-general optname-cap-purch-costs "g" opthelp-cap-purch-costs #t)) 131 132 options)) 133 134(define M+ 135 (case-lambda 136 (() (error "M+ needs at least 1 arg")) 137 ((a b) (if a (if b (+ a b) a) b)) 138 ((head . tail) (fold M+ head tail)))) 139 140(define M-abs 141 (case-lambda 142 (() (error "M-abs needs 1 arg")) 143 ((a) (and a (abs a))))) 144 145(define M* 146 (case-lambda 147 (() (error "M* needs at least 1 arg")) 148 ((a b) (and a b (* a b))) 149 ((head . tail) (fold M* head tail)))) 150 151(define M- 152 (case-lambda 153 (() (error "M- needs at least 1 arg")) 154 ((n) (and n (- n))) 155 ((minuend head . tail) (M+ minuend (M- (fold M+ head tail)))))) 156 157(define M/ 158 (case-lambda 159 (() (error "M/ needs at least 1 arg")) 160 ((n) (and n (not (zero? n)) (/ n))) 161 ((divisor head . tail) (M* divisor (M/ (fold M* head tail)))))) 162 163(define-record-type :txn-info 164 (make-txn-info stock-amt stock-val proceeds-val 165 fees-cap-val fees-exp-val dividend-val capgains-val) 166 txn-info? 167 (stock-amt get-stock-amt set-stock-amt!) 168 (stock-val get-stock-val set-stock-val!) 169 (proceeds-val get-proceeds-val set-proceeds-val!) 170 (fees-cap-val get-fees-cap-val set-fees-cap-val!) 171 (fees-exp-val get-fees-exp-val set-fees-exp-val!) 172 (dividend-val get-dividend-val set-dividend-val!) 173 (capgains-val get-capgains-val set-capgains-val!)) 174 175;; "bitfield" Nabc a=neg b=zero c=pos 176(define (N001 x) (if (number? x) (> x 0) #f)) 177(define (N100 x) (if (number? x) (< x 0) #f)) 178(define (N010 x) (if (number? x) (= x 0) #t)) 179(define (N011 x) (if (number? x) (>= x 0) #t)) 180(define (N110 x) (if (number? x) (<= x 0) #t)) 181(define (N111 x) #t) 182;; N000 should be (not x) however we can accept a zero-amount split too 183(define (N000 x) (if (number? x) (= x 0) #t)) 184 185;; --stock-- cash cap exp divi capg 186;; amt val fees fees 187 188(define open-types 189 (list 190 (list N001 N001 N100 N011 N000 N000 N000 "Open Long") 191 (list N100 N100 N001 N011 N000 N000 N000 "Open Short"))) 192 193(define long-types 194 (list 195 (list N001 N001 N100 N011 N000 N000 N000 "Buy") 196 (list N100 N100 N011 N000 N011 N000 N111 "Sell") 197 (list N000 N000 N001 N000 N011 N100 N000 "Dividend") 198 (list N001 N001 N001 N011 N000 N100 N000 "Dividend reinvestment (w/ remainder)") 199 (list N001 N001 N000 N011 N000 N100 N000 "Dividend reinvestment (w/o remainder)") 200 (list N000 N100 N001 N011 N000 N000 N000 "Return of Capital") 201 (list N000 N001 N000 N000 N011 N100 N000 "Notional distribution") 202 (list N001 N000 N000 N011 N000 N000 N000 "Stock split") 203 (list N100 N000 N000 N011 N000 N000 N000 "Reverse split") 204 (list N100 N100 N001 N000 N011 N000 N111 "Reverse split w/ cash in lieu for fractionals"))) 205 206(define short-types 207 (list 208 (list N100 N100 N001 N011 N000 N000 N000 "Short Sell") 209 (list N001 N001 N110 N000 N011 N000 N111 "Cover Buy") 210 (list N000 N000 N100 N000 N011 N001 N000 "Compensatory dividend") 211 (list N000 N000 N000 N011 N000 N000 N000 "Dividend reinvestment (w remainder)") 212 (list N000 N000 N000 N011 N000 N000 N000 "Dividend reinvestment (w/o remainder)") 213 (list N000 N001 N100 N011 N000 N000 N000 "Compensatory return of capital") 214 (list N000 N100 N000 N000 N011 N001 N000 "Compensatory notional distribution") 215 (list N100 N000 N000 N011 N000 N000 N000 "Stock split") 216 (list N001 N000 N000 N011 N000 N000 N000 "Reverse split") 217 (list N001 N001 N100 N000 N011 N000 N111 "Reverse split w/ cash in lieu for fractionals"))) 218 219(define (cmp amt neg zero pos) 220 (cond ((< amt 0) neg) 221 ((= amt 0) zero) 222 (else pos))) 223 224(define shown-headers? #f) 225(define (txn-identify trans txn-info cumul-units) 226 (let lp ((types (cmp cumul-units short-types open-types long-types))) 227 (match types 228 (() 229 ;; (gnc:pk (qof-print-date (xaccTransGetDate trans)) txn-info) 230 "Unknown") 231 (((amt-fn val-fn proc-fn fee-cap-fn fee-exp-fn div-fn capg-fn res) . tail) 232 (if (and (amt-fn (get-stock-amt txn-info)) 233 (val-fn (get-stock-val txn-info)) 234 (proc-fn (get-proceeds-val txn-info)) 235 (fee-cap-fn (get-fees-cap-val txn-info)) 236 (fee-exp-fn (get-fees-exp-val txn-info)) 237 (div-fn (get-dividend-val txn-info)) 238 (capg-fn (get-capgains-val txn-info))) 239 res 240 (lp tail)))))) 241 242(define (txn->info txn stock-acct cap-fee-action 243 proceeds-acct capgains-acct expenses-acct dividend-acct) 244 (define (from-acct? acct) 245 (lambda (split) 246 (equal? (xaccSplitGetAccount split) acct))) 247 (define (cap-expenses? split) 248 (and ((from-acct? stock-acct) split) 249 (equal? (gnc-get-action-num txn split) cap-fee-action))) 250 (let lp ((splits (xaccTransGetSplitList txn)) 251 (stock-amt #f) 252 (stock-val #f) 253 (proceeds-val #f) 254 (fees-cap-val #f) 255 (fees-exp-val #f) 256 (dividend-val #f) 257 (capgains-val #f)) 258 (match splits 259 (() (make-txn-info stock-amt stock-val proceeds-val fees-cap-val 260 fees-exp-val dividend-val capgains-val)) 261 262 (((? (from-acct? proceeds-acct) split) . rest) 263 (lp rest stock-amt stock-val 264 (M+ proceeds-val (xaccSplitGetAmount split)) 265 fees-cap-val fees-exp-val dividend-val capgains-val)) 266 267 (((? (from-acct? capgains-acct) split) . rest) 268 (lp rest stock-amt stock-val proceeds-val fees-cap-val fees-exp-val dividend-val 269 (M+ capgains-val (xaccSplitGetAmount split)))) 270 271 (((? (from-acct? expenses-acct) split) . rest) 272 (lp rest stock-amt stock-val proceeds-val fees-cap-val 273 (M+ fees-exp-val (xaccSplitGetAmount split)) 274 dividend-val capgains-val)) 275 276 (((? (from-acct? dividend-acct) split) . rest) 277 (lp rest stock-amt stock-val proceeds-val fees-cap-val fees-exp-val 278 (M+ dividend-val (xaccSplitGetAmount split)) 279 capgains-val)) 280 281 ;; testing capitalized fees must take place *before* processing 282 ;; stock amt/val because it belongs to the stock account. 283 (((? cap-expenses? split) . rest) 284 (lp rest stock-amt stock-val proceeds-val 285 (M+ fees-cap-val (xaccSplitGetValue split)) 286 fees-exp-val dividend-val capgains-val)) 287 288 (((? (from-acct? stock-acct) split) . rest) 289 (lp rest 290 (M+ stock-amt (xaccSplitGetAmount split)) 291 (M+ stock-val (xaccSplitGetValue split)) 292 proceeds-val fees-cap-val fees-exp-val dividend-val capgains-val)) 293 294 ((_ . rest) 295 (lp rest stock-amt stock-val proceeds-val fees-cap-val fees-exp-val 296 dividend-val capgains-val))))) 297 298(define (ifrs-cost-basis-renderer report-obj) 299 (define (opt-val section name) 300 (gnc:option-value 301 (gnc:lookup-option (gnc:report-options report-obj) section name))) 302 303 (define opt-startdate (opt-val gnc:pagename-general optname-startdate)) 304 (define opt-enddate (opt-val gnc:pagename-general optname-enddate)) 305 (define startdate 306 (gnc:time64-start-day-time 307 (gnc:date-option-absolute-time opt-startdate))) 308 (define enddate 309 (gnc:time64-start-day-time 310 (gnc:date-option-absolute-time opt-enddate))) 311 (define stock-acct (opt-val gnc:pagename-general optname-stock-acct)) 312 (define proceeds-acct (opt-val gnc:pagename-general optname-proceeds-acct)) 313 (define dividend-acct (opt-val gnc:pagename-general optname-dividend-acct)) 314 (define capgains-acct (opt-val gnc:pagename-general optname-capgains-acct)) 315 (define fees-acct (opt-val gnc:pagename-general optname-fees-acct)) 316 (define report-currency (opt-val gnc:pagename-general optname-report-currency)) 317 (define format-cells (opt-val gnc:pagename-general optname-format-cells)) 318 (define short-alternate-format? (opt-val gnc:pagename-general optname-format-short)) 319 (define cap-purch-costs? (opt-val gnc:pagename-general optname-cap-purch-costs)) 320 (define cap-fee-action (opt-val gnc:pagename-general optname-cap-fee-action)) 321 (define document (gnc:make-html-document)) 322 323 (define large 10000000) 324 (define (get-fx db from to time) 325 (/ (gnc-pricedb-convert-balance-nearest-price-t64 db large from to time) 326 large)) 327 328 (define (to-cell elt) 329 (gnc:make-html-table-cell/markup "number-cell" elt)) 330 331 (gnc:html-document-set-title! document "IFRS weighted average cost basis Report") 332 333 (cond 334 ((null? stock-acct) 335 (gnc:html-document-add-object! 336 document (gnc:html-make-generic-options-warning 337 reportname (gnc:report-id report-obj)))) 338 339 (else 340 (let ((commodity (xaccAccountGetCommodity stock-acct)) 341 (currency (gnc-account-get-currency-or-parent stock-acct)) 342 (pricedb (gnc-pricedb-get-db (gnc-get-current-book))) 343 (splits 344 (let ((query (qof-query-create-for-splits))) 345 (qof-query-set-book query (gnc-get-current-book)) 346 (xaccQueryAddSingleAccountMatch query stock-acct QOF-QUERY-AND) 347 (let ((result (xaccQueryGetSplitsUniqueTrans query))) 348 (qof-query-destroy query) 349 result)))) 350 351 (define (to-commodity amt) 352 (if format-cells 353 (and amt (gnc:make-gnc-monetary commodity amt)) 354 amt)) 355 356 (define (to-orig-currency amt) 357 (if format-cells 358 (and amt (gnc:make-gnc-monetary currency amt)) 359 amt)) 360 361 (define (to-report-currency amt) 362 (if format-cells 363 (and amt (gnc:make-gnc-monetary report-currency amt)) 364 amt)) 365 366 (define table (gnc:make-html-table)) 367 368 (gnc:html-document-set-title! 369 document 370 (gnc:format "Average-Cost (Basis) Report: From ${startdate} to ${enddate}. Report-currency ${currency}" 371 'startdate (qof-print-date startdate) 372 'enddate (qof-print-date enddate) 373 'currency (gnc-commodity-get-mnemonic report-currency))) 374 375 (gnc:html-table-set-col-headers! 376 table (list "date" "description" "trans-units" "cumul-units" "note" 377 "curr" "fx" "purchase-val" "purchase-cost" "cash-dividends" 378 "proceeds-val" "proceeds-cost" "conv-purchase-val" 379 "conv-purchase-cost" "conv-dividends" 380 "conv-proceeds-val" "conv-proceeds-cost" 381 "cumulative-average-cost-basis" 382 "average-cost-basis/unit-for-sale" "average-cost-basis-of-sale" 383 "net-proceeds" "gain-post-commission" "gain-pre-commission" 384 "cumul-gross-profit" "cumul-net-profit" "cumul-tot-return")) 385 386 (let lp ((splits splits) 387 (odd-row? #t) 388 (cumul-units 0) 389 (cumul-average-cost-basis 0) 390 (cumul-gross-profit 0) 391 (cumul-net-profit 0) 392 (cumul-tot-return 0)) 393 394 (match splits 395 (() (gnc:html-document-add-object! document table)) 396 397 ((split . rest-splits) 398 (let* ((trans (xaccSplitGetParent split)) 399 (txn-info (txn->info trans stock-acct cap-fee-action proceeds-acct 400 capgains-acct fees-acct dividend-acct)) 401 (trans-units (get-stock-amt txn-info)) 402 (cash-value (get-proceeds-val txn-info)) 403 (dividends-val (get-dividend-val txn-info)) 404 (capgains-val (get-capgains-val txn-info)) 405 (fees-expense (get-fees-exp-val txn-info)) 406 (fees-value (M+ (get-fees-cap-val txn-info) fees-expense)) 407 (trans-value (M+ (get-stock-val txn-info) 408 (get-fees-cap-val txn-info))) 409 (new-units (M+ cumul-units trans-units)) 410 411 (sale? 412 (cond 413 ((< trans-units 0) (<= 0 new-units)) 414 ((> trans-units 0) (<= new-units 0)) 415 (else #f))) 416 417 (purchase? 418 (cond 419 ((= trans-value 0) dividends-val) ;dividends 420 ((= trans-units 0) cash-value) ;return of capital 421 ((> trans-units 0) (< 0 new-units)) ;regular buy 422 ((< trans-units 0) (< new-units 0)))) ;buy during short 423 424 (shorting? (or (< new-units 0) 425 (and (= new-units 0) (< 0 trans-units)))) 426 427 (purchase-cost (and purchase? fees-value)) 428 (purchase-val (and purchase? (M- trans-value purchase-cost))) 429 (cash-dividends (M- dividends-val)) 430 (proceeds-cost (and sale? fees-value)) 431 (proceeds-value (and sale? (M+ cash-value proceeds-cost))) 432 433 ;; now convert to report-currency 434 (fx (get-fx pricedb currency report-currency 435 (time64CanonicalDayTime (xaccTransGetDate trans)))) 436 (conv-purchase-val (M* fx purchase-val)) 437 (conv-purchase-cost (M* fx purchase-cost)) 438 (conv-dividends (M* fx cash-dividends)) 439 (conv-proceeds-value (M* fx proceeds-value)) 440 (conv-proceeds-cost (M* fx proceeds-cost)) 441 442 ;; now perform AVERAGE-COST-BASIS calculations 443 (average-cost-basis/unit-for-sale 444 (M-abs (M/ cumul-average-cost-basis cumul-units))) 445 (average-cost-basis-of-sale 446 (and proceeds-value (M* average-cost-basis/unit-for-sale 447 trans-units))) 448 (cumul-average-cost-basis 449 (M+ cumul-average-cost-basis 450 conv-purchase-val 451 (and cap-purch-costs? conv-purchase-cost) 452 average-cost-basis-of-sale)) 453 454 (net-proceeds (M- conv-proceeds-value conv-proceeds-cost)) 455 (gain-post-commission (M+ net-proceeds average-cost-basis-of-sale 456 (and (not cap-purch-costs?) 457 conv-purchase-cost))) 458 (gain-pre-commission (M+ conv-proceeds-value 459 average-cost-basis-of-sale)) 460 461 (new-gross-profit (M+ cumul-gross-profit gain-pre-commission)) 462 (new-net-profit (M+ cumul-net-profit gain-post-commission)) 463 (new-tot-return (M+ cumul-tot-return gain-post-commission 464 conv-dividends))) 465 466 ;; (gnc:pk trans 'trans-units trans-units 'trans-value trans-value 467 ;; 'cumul-units cumul-units 'proceeds-value proceeds-value 468 ;; 'sale? sale? 'purchase? purchase?) 469 (cond 470 ((not (< startdate (xaccTransGetDate (xaccSplitGetParent (car splits))) 471 enddate)) 472 (lp rest-splits 473 odd-row? 474 new-units 475 cumul-average-cost-basis 476 new-gross-profit 477 new-net-profit 478 new-tot-return)) 479 480 (else 481 (gnc:html-table-append-row/markup! 482 table (if short-alternate-format? 483 (if shorting? "alternate-row" "normal-row") 484 (if odd-row? "normal-row" "alternate-row")) 485 (list (qof-print-date (xaccTransGetDate trans)) 486 (gnc:html-string-sanitize (xaccTransGetDescription trans)) 487 (to-cell (gnc:html-split-anchor split (to-commodity trans-units))) 488 (to-cell (to-commodity new-units)) 489 (cond 490 ((< new-units 0 cumul-units) "ERROR: long→short") 491 ((< cumul-units 0 new-units) "ERROR: short→long") 492 (else (txn-identify trans txn-info cumul-units))) 493 (gnc-commodity-get-mnemonic currency) 494 (to-cell (gnc:default-price-renderer report-currency fx)) 495 (to-cell (to-orig-currency purchase-val)) 496 (to-cell (to-orig-currency purchase-cost)) 497 (to-cell (to-orig-currency cash-dividends)) 498 (to-cell (to-orig-currency proceeds-value)) 499 (to-cell (to-orig-currency proceeds-cost)) 500 (to-cell (to-report-currency conv-purchase-val)) 501 (to-cell (to-report-currency conv-purchase-cost)) 502 (to-cell (to-report-currency conv-dividends)) 503 (to-cell (to-report-currency conv-proceeds-value)) 504 (to-cell (to-report-currency conv-proceeds-cost)) 505 (to-cell (to-report-currency cumul-average-cost-basis)) 506 (to-cell (to-report-currency average-cost-basis/unit-for-sale)) 507 (to-cell (to-report-currency (M- average-cost-basis-of-sale))) 508 (to-cell (to-report-currency net-proceeds)) 509 (to-cell (to-report-currency gain-post-commission)) 510 (to-cell (to-report-currency gain-pre-commission)) 511 (to-cell (to-report-currency new-gross-profit)) 512 (to-cell (to-report-currency new-net-profit)) 513 (to-cell (to-report-currency new-tot-return)))) 514 515 (lp rest-splits 516 (not odd-row?) 517 new-units 518 cumul-average-cost-basis 519 new-gross-profit 520 new-net-profit 521 new-tot-return)))))))))) 522 523 ;; (gnc:dump-all-transactions) 524 (gnc:html-document-add-object! document disclaimer) 525 document) 526 527 528;; Here we define the actual report 529(gnc:define-report 530 'version 1 531 'name reportname 532 'report-guid "15d5b744176c4625a703720338725291" 533 'menu-path (list gnc:menuname-experimental) 534 'options-generator options-generator 535 'renderer ifrs-cost-basis-renderer) 536