[commodity-utils] refactor inst price calculator

This commit is contained in:
Christopher Lam
2019-04-05 21:23:18 +08:00
parent 91f3e9fefe
commit 9ef2a2f3dd

View File

@@ -228,68 +228,49 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
(define (gnc:get-commodity-inst-prices (define (gnc:get-commodity-inst-prices
currency-accounts end-date price-commodity report-currency) currency-accounts end-date price-commodity report-currency)
;; go through all splits; convert all splits into a price. ;; go through all splits; convert all splits into a price.
(filter (let loop ((result '())
gnc:price-is-not-zero? (commodity-splits (gnc:get-match-commodity-splits-sorted
(map-in-order currency-accounts end-date price-commodity)))
(lambda (a) (if (null? commodity-splits)
(let* ((transaction-comm (xaccTransGetCurrency (reverse! result)
(xaccSplitGetParent a))) (let* ((a (car commodity-splits))
(account-comm (xaccAccountGetCommodity (txn-comm (xaccTransGetCurrency (xaccSplitGetParent a)))
(xaccSplitGetAccount a))) (acc-comm (xaccAccountGetCommodity (xaccSplitGetAccount a)))
(share-amount (abs (share-amt (abs (xaccSplitGetAmount a)))
(xaccSplitGetAmount a))) (value-amt (abs (xaccSplitGetValue a)))
(value-amount (abs (txn-date (xaccTransGetDate (xaccSplitGetParent a))))
(xaccSplitGetValue a))) (cond
(transaction-date (xaccTransGetDate ((or (zero? share-amt) (zero? value-amt))
(xaccSplitGetParent a))) (loop result
(foreignlist (cdr commodity-splits)))
(if (gnc-commodity-equiv transaction-comm price-commodity)
(list account-comm
share-amount value-amount)
(list transaction-comm
value-amount share-amount))))
;; Try EURO exchange if necessary ((gnc-commodity-equiv acc-comm report-currency)
(if (not (gnc-commodity-equiv (car foreignlist) (loop (cons (list txn-date (/ share-amt value-amt)) result)
report-currency)) (cdr commodity-splits)))
(let ((exchanged (gnc:exchange-by-euro-numeric
(car foreignlist) (cadr foreignlist)
report-currency transaction-date)))
(if exchanged
(set! foreignlist
(list report-currency
(gnc:gnc-monetary-amount exchanged)
(caddr foreignlist))))))
(list ((gnc-commodity-equiv txn-comm report-currency)
transaction-date (loop (cons (list txn-date (/ value-amt share-amt)) result)
(if (not (gnc-commodity-equiv (car foreignlist) (cdr commodity-splits)))
report-currency))
(begin ((gnc:exchange-by-euro-numeric txn-comm value-amt report-currency txn-date)
(warn "get-commodity-inst-prices: " => (lambda (amt)
"Sorry, currency exchange not yet implemented:" (loop (cons (list txn-date (/ (gnc:gnc-monetary-amount amt) share-amt))
(gnc:monetary->string result)
(gnc:make-gnc-monetary (cdr commodity-splits))))
(car foreignlist) (cadr foreignlist)))
" (buying " (else
(gnc:monetary->string (warn "get-commodity-inst-prices: "
(gnc:make-gnc-monetary "Sorry, currency exchange not yet implemented:"
price-commodity (caddr foreignlist))) (gnc:monetary->string
") =? " (gnc:make-gnc-monetary txn-comm value-amt))
(gnc:monetary->string " (buying "
(gnc:make-gnc-monetary (gnc:monetary->string
report-currency 0))) (gnc:make-gnc-monetary price-commodity share-amt))
0) ") =? "
(if (not (zero? (caddr foreignlist))) (gnc:monetary->string
(gnc-numeric-div (gnc:make-gnc-monetary report-currency 0)))
(cadr foreignlist) (loop result
(caddr foreignlist) (cdr commodity-splits))))))))
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) 0)))))
;; Get all the interesting splits, sorted by date.
(gnc:get-match-commodity-splits-sorted
currency-accounts
end-date price-commodity))))
;; Get the instantaneous prices for all commodities in ;; Get the instantaneous prices for all commodities in
;; 'commodity-list', i.e. the same thing as get-commodity-inst-prices ;; 'commodity-list', i.e. the same thing as get-commodity-inst-prices