;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; advanced-portfolio.scm

;; by Martijn van Oosterhout (kleptog@svana.org) Feb 2002

;; modified for GnuCash 1.8 by Herbert Thoma (herbie@hthoma.de) Oct 2002

;;

;; Heavily based on portfolio.scm

;; by Robert Merkel (rgmerk@mira.net)

;;

;; This program is free software; you can redistribute it and/or    

;; modify it under the terms of the GNU General Public License as   

;; published by the Free Software Foundation; either version 2 of   

;; the License, or (at your option) any later version.              

;;                                                                  

;; This program is distributed in the hope that it will be useful,  

;; but WITHOUT ANY WARRANTY; without even the implied warranty of   

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    

;; GNU General Public License for more details.                     

;;                                                                  

;; You should have received a copy of the GNU General Public License

;; along with this program; if not, contact:

;;

;; Free Software Foundation           Voice:  +1-617-542-5942

;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652

;; Boston, MA  02110-1301,  USA       gnu@gnu.org

;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-module (local my-advanced-portfolio))

(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.

(use-modules (srfi srfi-1))

(use-modules (gnucash gnc-module))

(use-modules (gnucash gettext))

(use-modules (gnucash printf))

(gnc:module-load "gnucash/report/report-system" 0)

(define reportname (N_ "My Advanced Portfolio"))

(define optname-price-source (N_ "Price Source"))

(define optname-shares-digits (N_ "Share decimal places"))

(define optname-zero-shares (N_ "Include accounts with no shares"))

(define optname-show-symbol (N_ "Show ticker symbols"))

(define optname-show-listing (N_ "Show listings"))

(define optname-show-price (N_ "Show prices"))

(define optname-show-shares (N_ "Show number of shares"))

(define optname-basis-method (N_ "Basis calculation method"))

(define optname-prefer-pricelist (N_ "Set preference for price list data"))

(define optname-brokerage-fees (N_ "How to report brokerage fees"))

;; To avoid overflows in our calculations, define a denominator for prices and unit values

(define price-denom 100000000)

(define units-denom 100000000)

(define (options-generator)

  (let* ((options (gnc:new-options)) 

         ;; This is just a helper function for making options.

         ;; See gnucash/src/scm/options.scm for details.

         (add-option 

          (lambda (new-option)

            (gnc:register-option options new-option))))

    ;; General Tab

    ;; date at which to report balance

    (gnc:options-add-report-date!

     options gnc:pagename-general 

     (N_ "Date") "a")

    (gnc:options-add-currency! 

     options gnc:pagename-general (N_ "Report's currency") "c")

    (add-option

     (gnc:make-multichoice-option

      gnc:pagename-general optname-price-source

      "d" (N_ "The source of price information.") 'pricedb-nearest

      (list (vector 'pricedb-latest 

		    (N_ "Most recent")

		    (N_ "The most recent recorded price."))

	    (vector 'pricedb-nearest

		    (N_ "Nearest in time")

		    (N_ "The price recorded nearest in time to the report date."))

	    )))

    (add-option

     (gnc:make-multichoice-option

      gnc:pagename-general optname-basis-method

      "e" (N_ "Basis calculation method.") 'average-basis

      (list (vector 'average-basis

		    (N_ "Average")

		    (N_ "Use average cost of all shares for basis."))

	    (vector 'fifo-basis

		    (N_ "FIFO")

		    (N_ "Use first-in first-out method for basis."))

	    (vector 'filo-basis

		    (N_ "LIFO")

		    (N_ "Use last-in first-out method for basis."))

	    )))

    (add-option

     (gnc:make-simple-boolean-option

      gnc:pagename-general optname-prefer-pricelist "f" 

      (N_ "Prefer use of price editor pricing over transactions, where applicable.")

      #t))

    (add-option

     (gnc:make-multichoice-option

      gnc:pagename-general optname-brokerage-fees

      "g" (N_ "How to report commissions and other brokerage fees.") 'include-in-basis

      (list (vector 'include-in-basis

                    (N_ "Include in basis")

                    (N_ "Include brokerage fees in the basis for the asset."))

            (vector 'include-in-gain

                    (N_ "Include in gain")

                    (N_  "Include brokerage fees in the gain and loss but not in the basis."))

            (vector 'ignore-brokerage

                    (N_ "Ignore")

                    (N_ "Ignore brokerage fees entirely."))

            )))

    (gnc:register-option

      options

      (gnc:make-simple-boolean-option

	gnc:pagename-display optname-show-symbol "a"

	(N_ "Display the ticker symbols.")

	#t))

    (gnc:register-option

      options

      (gnc:make-simple-boolean-option

	gnc:pagename-display optname-show-listing "b"

	(N_ "Display exchange listings.")

	#t))

    (gnc:register-option

      options

      (gnc:make-simple-boolean-option

	gnc:pagename-display optname-show-shares "c"

	(N_ "Display numbers of shares in accounts.")

	#t))

    (add-option

     (gnc:make-number-range-option

      gnc:pagename-display optname-shares-digits

      "d" (N_ "The number of decimal places to use for share numbers.") 2

      0 6 0 1))

    (gnc:register-option

      options

      (gnc:make-simple-boolean-option

	gnc:pagename-display optname-show-price "e"

	(N_ "Display share prices.")

	#t))

    ;; Account tab

    (add-option

     (gnc:make-account-list-option

      gnc:pagename-accounts (N_ "Accounts")

      "b"

      (N_ "Stock Accounts to report on.")

      (lambda () (filter gnc:account-is-stock?

                         (gnc-account-get-descendants-sorted

                          (gnc-get-current-root-account))))

      (lambda (accounts) (list  #t 

                                (filter gnc:account-is-stock? accounts)))

      #t))

    (gnc:register-option 

     options 

     (gnc:make-simple-boolean-option

      gnc:pagename-accounts optname-zero-shares "e" 

      (N_ "Include accounts that have a zero share balances.")

      #f))

    (gnc:options-set-default-section options gnc:pagename-general)      

    options))

;; This is the rendering function. It accepts a database of options

;; and generates an object of type <html-document>.  See the file

;; report-html.txt for documentation; the file report-html.scm

;; includes all the relevant Scheme code. The option database passed

;; to the function is one created by the options-generator function

;; defined above.

(define (advanced-portfolio-renderer report-obj)

 (let ((work-done 0)

       (work-to-do 0)

       (warn-no-price #f)

       (warn-price-dirty #f))

  ;; These are some helper functions for looking up option values.

  (define (get-op section name)

    (gnc:lookup-option (gnc:report-options report-obj) section name))

  (define (get-option section name)

    (gnc:option-value (get-op section name)))

  (define (split-account-type? split type)

    (eq? type (xaccAccountGetType (xaccSplitGetAccount split))))

  (define (same-split? s1 s2)

    (equal? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))

  (define (same-account? a1 a2)

    (equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))

  (define (same-account-code? a1 a2)

    (equal? (xaccAccountGetCode a1) (xaccAccountGetCode a2)))

  ;; sum up the contents of the b-list built by basis-builder below

  (define (sum-basis b-list currency-frac)

    (if (not (eqv? b-list '()))

        (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)

                         (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)

        (gnc-numeric-zero)

        )

    )

  ;; sum up the total number of units in the b-list built by basis-builder below

  (define (units-basis b-list)

    (if (not (eqv? b-list '()))

        (gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) 

                         units-denom GNC-RND-ROUND)

        (gnc-numeric-zero)

        )

    )

  ;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs

  ;; I need to get a brain and use (map) for this.

  (define (apply-basis-ratio b-list units-ratio value-ratio)

    (if (not (eqv? b-list '()))

        (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)

                    (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))

              (apply-basis-ratio (cdr b-list) units-ratio value-ratio))

        '()

        )    

    )

  ;; this builds a list for basis calculation and handles average, fifo and lifo methods

  ;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one

  ;; cell that mutates to the new average. Need to add a date checker so that we allow for prices

  ;; coming in out of order, such as a transfer with a price adjusted to carryover the basis.

  (define (basis-builder b-list b-units b-value b-method currency-frac)

    (gnc:debug "actually in basis-builder")

    (gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units) 

               " b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)

    ;; if there is no b-value, then this is a split/merger and needs special handling

    (cond 

     ;; we have value and positive units, add units to basis

     ((and (not (gnc-numeric-zero-p b-value))

	   (gnc-numeric-positive-p b-units))

      (case b-method

	((average-basis) 

	 (if (not (eqv? b-list '()))

	     (list (cons (gnc-numeric-add b-units

					  (caar b-list) units-denom GNC-RND-ROUND) 

			 (gnc-numeric-div

			  (gnc-numeric-add b-value

					   (gnc-numeric-mul (caar b-list)

							    (cdar b-list) 

							    GNC-DENOM-AUTO GNC-DENOM-REDUCE)

					   GNC-DENOM-AUTO GNC-DENOM-REDUCE)

			  (gnc-numeric-add b-units

					   (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)

			  price-denom GNC-RND-ROUND)))

	     (append b-list 

		     (list (cons b-units (gnc-numeric-div

					  b-value b-units price-denom GNC-RND-ROUND))))))

	(else (append b-list 

		      (list (cons b-units (gnc-numeric-div

					   b-value b-units price-denom GNC-RND-ROUND)))))))

     ;; we have value and negative units, remove units from basis

     ((and (not (gnc-numeric-zero-p b-value))

	   (gnc-numeric-negative-p b-units))

      (if (not (eqv? b-list '()))

          (case b-method

            ((fifo-basis) 

             (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))

               ((-1)

                 ;; Sold less than the first lot, create a new first lot from the remainder

                 (let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)))

                        (cons (cons new-units (cdar b-list)) (cdr b-list))))

               ((0)

                 ;; Sold all of the first lot

                 (cdr b-list))

               ((1)  

                 ;; Sold more than the first lot, delete it and recurse

                 (basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)

                                b-value  ;; Only the sign of b-value matters since the new b-units is negative

                                b-method currency-frac))))

            ((filo-basis) 

             (let ((rev-b-list (reverse b-list)))

               (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))

                 ((-1)

                   ;; Sold less than the last lot

                 (let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)))

                        (reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list)))))

                 ((0)

                   ;; Sold all of the last lot

                   (reverse (cdr rev-b-list))

                 )

                 ((1)

                   ;; Sold more than the last lot

                   (basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)

                                           b-value b-method currency-frac)

                 ))))

            ((average-basis) 

             (list (cons (gnc-numeric-add

                          (caar b-list) b-units units-denom GNC-RND-ROUND) 

                         (cdar b-list)))))

          '()

          ))

     ;; no value, just units, this is a split/merge...

     ((and (gnc-numeric-zero-p b-value)

	   (not (gnc-numeric-zero-p b-units)))

	(let* ((current-units (units-basis b-list))

	       (units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE) 

					     current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE))

               ;; If the units ratio is zero the stock is worthless and the value should be zero too 

	       (value-ratio (if (gnc-numeric-zero-p units-ratio)

	                        (gnc-numeric-zero)

                                (gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))

	  (gnc:debug "blist is " b-list " current units is " 

	             (gnc-numeric-to-string current-units) 

	             " value ratio is " (gnc-numeric-to-string value-ratio)

	             " units ratio is " (gnc-numeric-to-string units-ratio))

	  (apply-basis-ratio b-list units-ratio value-ratio) 

	  ))

	;; If there are no units, just a value, then its a spin-off,

	;; calculate a ratio for the values, but leave the units alone

	;; with a ratio of 1

     ((and (gnc-numeric-zero-p b-units)

	   (not (gnc-numeric-zero-p b-value)))

      (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))

	     (value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE) 

					   current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)))

	(gnc:debug "this is a spinoff")

	(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))

	(apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio))

      )

     ;; when all else fails, just send the b-list back

     (else

      b-list)

     )

    )

  ;; Given a price list and a currency find the price for that currency on the list.

  ;; If there is none for the requested currency, return the first one.

  ;; The price list is released but the price returned is ref counted.

  (define (find-price price-list currency)

    (if (eqv? price-list '()) #f

      (let ((price (car price-list)))

        (for-each

          (lambda (p)

            (if (gnc-commodity-equiv currency (gnc-price-get-currency p))

                  (set! price p)))

          price-list)

        (gnc-price-ref price)

        (gnc-price-list-destroy price-list)

        price)))

  ;; Return true if either account is the parent of the other or they are siblings

  (define (parent-or-sibling? a1 a2)

    (let ((a2parent (gnc-account-get-parent a2))

          (a1parent (gnc-account-get-parent a1)))

          (or (same-account? a2parent a1)

              (same-account? a1parent a2) 

              (same-account? a1parent a2parent))))

  ;; Test whether the given split is the source of a spin off transaction

  ;; This will be a no-units split with only one other split.

  ;; xaccSplitGetOtherSplit only returns on a two-split txn.  It's not a spinoff

  ;; is the other split is in an income or expense account.

  (define (spin-off? split current)

     (let ((other-split (xaccSplitGetOtherSplit split)))

          (and (gnc-numeric-zero-p (xaccSplitGetAmount split))

               (same-account? current (xaccSplitGetAccount split))

               (not (null? other-split))

               (not (split-account-type? other-split ACCT-TYPE-EXPENSE))

               (not (split-account-type? other-split ACCT-TYPE-INCOME)))))

(define (table-add-stock-rows table accounts to-date

                                currency price-fn exchange-fn price-source

				include-empty show-symbol show-listing show-shares show-price

                                basis-method prefer-pricelist handle-brokerage-fees 

                                total-basis total-value

                                total-moneyin total-moneyout total-income total-gain 

                                total-ugain total-brokerage)

   (let ((share-print-info

	  (gnc-share-print-info-places

	   (inexact->exact (get-option gnc:pagename-display

      			       optname-shares-digits)))))

    (define (table-add-stock-rows-internal accounts odd-row?)

      (if (null? accounts) total-value

          (let* ((row-style (if odd-row? "normal-row" "alternate-row"))

                 (current (car accounts))

                 (rest (cdr accounts))

		 ;; commodity is the actual stock/thing we are looking at

                 (commodity (xaccAccountGetCommodity current))

                 (ticker-symbol (gnc-commodity-get-mnemonic commodity))

                 (listing (gnc-commodity-get-namespace commodity))

                 (unit-collector (gnc:account-get-comm-balance-at-date

                                  current to-date #f))

                 (units (cadr (unit-collector 'getpair commodity #f)))

                 ;; Counter to keep track of stuff

                 (brokeragecoll (gnc:make-commodity-collector))

                 (dividendcoll  (gnc:make-commodity-collector))

                 (moneyincoll   (gnc:make-commodity-collector))

                 (moneyoutcoll  (gnc:make-commodity-collector))

                 (gaincoll      (gnc:make-commodity-collector))

		 ;; the price of the commodity at the time of the report

                 (price (price-fn commodity currency to-date))

		 ;; the value of the commodity, expressed in terms of

		 ;; the report's currency.

                 (value (gnc:make-gnc-monetary currency (gnc-numeric-zero)))  ;; Set later

                 (currency-frac (gnc-commodity-get-fraction currency))

		 (pricing-txn #f)

		 (use-txn #f)

		 (basis-list '())

		 ;; setup an alist for the splits we've already seen.

		 (seen_trans '())

		 ;; Account used to hold remainders from income reinvestments and

		 ;; running total of amount moved there

		 (drp-holding-account #f)

		 (drp-holding-amount (gnc-numeric-zero))

		 )

            (define (my-exchange-fn fromunits tocurrency)

              (if (and (gnc-commodity-equiv currency tocurrency)

                       (gnc-commodity-equiv (gnc:gnc-monetary-commodity fromunits) commodity))

                    ;; Have a price for this commodity, but not necessarily in the report's

                    ;; currency.  Get the value in the commodity's currency and convert it to

                    ;; report currency.

                    (exchange-fn

                      ;; This currency will usually be the same as tocurrency so the

                      ;; call to exchange-fn below will do nothing

                      (gnc:make-gnc-monetary 

                        (if use-txn

                            (gnc:gnc-monetary-commodity price)

                            (gnc-price-get-currency price))

                        (gnc-numeric-mul (gnc:gnc-monetary-amount fromunits)

                                         (if use-txn

                                             (gnc:gnc-monetary-amount price)

                                             (gnc-price-get-value price))

                                         currency-frac GNC-RND-ROUND))

                      tocurrency)

                    (exchange-fn fromunits tocurrency)))

            (gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: " 

                   (if price

                     (gnc-commodity-value->string

	 	         (list (gnc-price-get-currency price) (gnc-price-get-value price))) 

	 	     #f))

            ;; If we have a price that can't be converted to the report currency

            ;; don't use it

            (if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount 

                                       (exchange-fn 

                                          (gnc:make-gnc-monetary 

                                            (gnc-price-get-currency price)

                                            (gnc:make-gnc-numeric 100 1))

                                          currency))))

                (set! price #f))

            ;; If we are told to use a pricing transaction, or if we don't have a price

            ;; from the price DB, find a good transaction to use.

            (if (and (not use-txn)

                     (or (not price) (not prefer-pricelist)))

                  (let ((split-list (reverse (gnc:get-match-commodity-splits-sorted 

                                                 (list current) 

                                                 (case price-source 

                                                   ((pricedb-latest) (gnc:get-today))

                                                   ((pricedb-nearest) to-date)

                                                   (else (gnc:get-today)))  ;; error, but don't crash

                                                 #f))))  ;; Any currency

                        ;; Find the first (most recent) one that can be converted to report currency

                        (while (and (not use-txn) (not (eqv? split-list '())))

                          (let ((split (car split-list)))

                            (if (and (not (gnc-numeric-zero-p (xaccSplitGetAmount split)))

                                     (not (gnc-numeric-zero-p (xaccSplitGetValue split))))

                              (let* ((trans (xaccSplitGetParent split))

                                     (trans-currency (xaccTransGetCurrency trans))

                                     (trans-price (exchange-fn (gnc:make-gnc-monetary

                                                                   trans-currency 

                                                                   (xaccSplitGetSharePrice split))

                                                               currency)))

                                (if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price)))

                                  ;; We can exchange the price from this transaction into the report currency

                                  (begin

                                    (if price (gnc-price-unref price))

                                    (set! pricing-txn trans)

                                    (set! price trans-price)

                                    (gnc:debug "Transaction price is " (gnc:monetary->string price))

                                    (set! use-txn #t))

                                  (set! split-list (cdr split-list))))

                              (set! split-list (cdr split-list)))

                            ))))

            ;; If we still don't have a price, use a price of 1 and complain later

            (if (not price)

              (begin

                (set! price (gnc:make-gnc-monetary currency (gnc:make-gnc-numeric 1 1)))

                ;; If use-txn is set, but pricing-txn isn't set, it's a bogus price

                (set! use-txn #t)

                (set! pricing-txn #f)

              )

            )  

            ;; Now that we have a pricing transaction if needed, set the value of the asset

            (set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))

            (gnc:debug "Value " (gnc:monetary->string value) 

                       " from " (gnc-commodity-numeric->string commodity units))