IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[commodity-utils] refactor get-exchange-cost-totals

Browse Source
This commit is contained in:
Christopher Lam
2019-04-05 23:31:45 +08:00
parent b2dc906bcd
commit ce675eaac6
1 changed files with 74 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
gnucash/report/report-system/commodity-utilities.scm
View File

@@ -563,74 +563,83 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
;; gains and losses, of each commodity across all accounts. Returns a ;; gains and losses, of each commodity across all accounts. Returns a
;; report-list. ;; report-list.
(define (gnc:get-exchange-cost-totals report-commodity end-date) (define (gnc:get-exchange-cost-totals report-commodity end-date)
(let ((curr-accounts (let ((curr-accounts (gnc-account-get-descendants-sorted
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))) (gnc-get-current-root-account))))
(sumlist (list (list report-commodity '()))))
(if (not (null? curr-accounts)) (let loop ((comm-splits (gnc:get-all-commodity-splits curr-accounts end-date))
;; Go through all splits and add up all value-amounts (sumlist (list (list report-commodity '()))))
;; and share-amounts (cond
;; However skip splits in trading accounts as these counterbalance ((null? comm-splits)
;; the actual value and share amounts back to zero (gnc:resolve-unknown-comm sumlist report-commodity))
(for-each
(lambda (a)
(if (not (eq? (xaccAccountGetType (xaccSplitGetAccount a)) ACCT-TYPE-TRADING))
(let* ((transaction-comm (xaccTransGetCurrency
(xaccSplitGetParent a)))
(account-comm (xaccAccountGetCommodity
(xaccSplitGetAccount a)))
(share-amount (xaccSplitGetAmount a))
(value-amount (xaccSplitGetValue a))
(comm-list (or (assoc transaction-comm sumlist)
(assoc account-comm sumlist))))
;; entry exists already in comm-list? ;; However skip splits in trading accounts as these counterbalance
(if (not comm-list) ;; the actual value and share amounts back to zero
;; no, create sub-alist from scratch ((eqv? (xaccAccountGetType (xaccSplitGetAccount (car comm-splits)))
(let ((pair (list transaction-comm ACCT-TYPE-TRADING)
(cons (gnc:make-value-collector) (loop (cdr comm-splits)
sumlist))
;; Go through all splits and add up all value-amounts
;; and share-amounts
(else
(let* ((a (car comm-splits))
(txn-comm (xaccTransGetCurrency (xaccSplitGetParent a)))
(acc-comm (xaccAccountGetCommodity (xaccSplitGetAccount a)))
(share-amt (xaccSplitGetAmount a))
(value-amt (xaccSplitGetValue a)))
(cond
((assoc txn-comm sumlist)
=> (lambda (comm-list)
(cond
;; other commodity already exists in comm-list?
((assoc acc-comm (cadr comm-list))
=> (lambda (pair)
((caadr pair) 'add share-amt)
((cdadr pair) 'add value-amt)
(loop (cdr comm-splits)
sumlist)))
;; if not, create a new entry in comm-list.
(else
(let ((pair (list acc-comm (cons (gnc:make-value-collector)
(gnc:make-value-collector)))))
((caadr pair) 'add share-amt)
((cdadr pair) 'add value-amt)
(loop (cdr comm-splits)
(cons (list (car comm-list) (cons pair (cadr comm-list)))
(alist-delete
(car comm-list) sumlist))))))))
((assoc acc-comm sumlist)
=> (lambda (comm-list)
(cond
;; other commodity already exists in comm-list?
((assoc txn-comm (cadr comm-list))
=> (lambda (pair)
((caadr pair) 'add (- value-amt))
((cdadr pair) 'add (- share-amt))
(loop (cdr comm-splits)
sumlist)))
(else
(let ((pair (list txn-comm (cons (gnc:make-value-collector)
(gnc:make-value-collector)))))
;; And add the balances to the comm-list entry.
((caadr pair) 'add (- value-amt))
((cdadr pair) 'add (- share-amt))
(loop (cdr comm-splits)
(cons (list (car comm-list) (cons pair (cadr comm-list)))
(alist-delete
(car comm-list) sumlist))))))))
(else
;; no, create sub-alist from scratch
(let ((pair (list txn-comm (cons (gnc:make-value-collector)
(gnc:make-value-collector))))) (gnc:make-value-collector)))))
((caadr pair) 'add value-amount) ((caadr pair) 'add value-amt)
((cdadr pair) 'add share-amount) ((cdadr pair) 'add share-amt)
(set! comm-list (list account-comm (list pair))) ;; and add the new sub-alist to sumlist.
;; and add the new sub-alist to sumlist. (loop (cdr comm-splits)
(set! sumlist (cons comm-list sumlist))) (cons (list acc-comm (list pair)) sumlist)))))))))))
;; yes, check for second commodity.
(let*
;; Put the amounts in the right place.
((foreignlist
(if (gnc-commodity-equiv transaction-comm
(car comm-list))
(list account-comm
share-amount value-amount)
(list transaction-comm
(- value-amount)
(- share-amount))))
;; second commodity already existing in comm-list?
(pair (assoc (car foreignlist) (cadr comm-list))))
;; if not, create a new entry in comm-list.
(if (not pair)
(begin
(set!
pair (list (car foreignlist)
(cons (gnc:make-value-collector)
(gnc:make-value-collector))))
(set!
comm-list (list (car comm-list)
(cons pair (cadr comm-list))))
(set!
sumlist (cons comm-list
(alist-delete
(car comm-list) sumlist)))))
;; And add the balances to the comm-list entry.
((caadr pair) 'add (cadr foreignlist))
((cdadr pair) 'add (caddr foreignlist)))))))
(gnc:get-all-commodity-splits curr-accounts end-date)))
(gnc:resolve-unknown-comm sumlist report-commodity)))
;; Anybody feel free to reimplement any of these functions, either in
;; scheme or in C. -- cstim
(define (gnc:make-exchange-alist report-commodity end-date) (define (gnc:make-exchange-alist report-commodity end-date)
;; This returns the alist with the actual exchange rates, i.e. the ;; This returns the alist with the actual exchange rates, i.e. the