;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cash-flow.scm: cash flow report 
;; 
;; By Herbert Thoma <herbie@hthoma.de>
;;
;; based on balance-sheet.scm by:
;; Robert Merkel <rgmerk@mira.net>
;; and pnl.scm by:
;; Christian Stimming <stimming@tu-harburg.de>
;;
;; 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 (gnucash report cash-flow))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (ice-9 slib))
(use-modules (gnucash gnc-module))

(require 'printf)
(require 'sort)

(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc:html-build-url

(define reportname (N_ "Cash Flow"))

;; define all option's names so that they are properly defined
;; in *one* place.
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))

(define optname-display-depth (N_ "Account Display Depth"))
(define optname-show-subaccounts (N_ "Always show sub-accounts"))
(define optname-accounts (N_ "Account"))

(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
(define optname-show-rates (N_ "Show Exchange Rates"))
(define optname-show-full-names (N_ "Show Full Account Names"))

;; options generator
(define (cash-flow-options-generator)
  (let ((options (gnc:new-options)))

    ;; date interval
    (gnc:options-add-date-interval!
     options gnc:pagename-general 
     optname-from-date optname-to-date "a")

    ;; all about currencies
    (gnc:options-add-currency!
     options gnc:pagename-general
     optname-report-currency "b")

    (gnc:options-add-price-source! 
     options gnc:pagename-general
     optname-price-source "c" 'pricedb-nearest)

    (gnc:register-option 
     options
     (gnc:make-simple-boolean-option
      gnc:pagename-general optname-show-rates
      "d" (N_ "Show the exchange rates used") #f))

    (gnc:register-option 
     options
     (gnc:make-simple-boolean-option
      gnc:pagename-general optname-show-full-names
      "e" (N_ "Show full account names (including parent accounts)") #t))

    ;; accounts to work on
    (gnc:options-add-account-selection! 
     options gnc:pagename-accounts
     optname-display-depth optname-show-subaccounts
     optname-accounts "a" 2
     (lambda ()
       (gnc:filter-accountlist-type 
        '(bank cash asset stock mutual-fund)
        (gnc:group-get-subaccounts (gnc:get-current-group))))
     #f)
    
    ;; Set the general page as default option tab
    (gnc:options-set-default-section options gnc:pagename-general)      

    options))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cash-flow-renderer
;; set up the document and add the table
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (cash-flow-renderer report-obj)
  (define (get-option pagename optname)
    (gnc:option-value
     (gnc:lookup-option 
      (gnc:report-options report-obj) pagename optname)))

  (gnc:report-starting reportname)

  ;; get all option's values
  (let* ((display-depth (get-option gnc:pagename-accounts 
                                    optname-display-depth))
         (show-subaccts? (get-option gnc:pagename-accounts
                                     optname-show-subaccounts))
         (accounts (get-option gnc:pagename-accounts
                               optname-accounts))
         (row-num 0)
	 (work-done 0)
	 (work-to-do 0)
         (report-currency (get-option gnc:pagename-general
                                      optname-report-currency))
         (price-source (get-option gnc:pagename-general
                                   optname-price-source))
         (show-rates? (get-option gnc:pagename-general 
                                  optname-show-rates))
         (show-full-names? (get-option gnc:pagename-general 
                                       optname-show-full-names))
         (from-date-tp (gnc:timepair-start-day-time 
                        (gnc:date-option-absolute-time
                         (get-option gnc:pagename-general
                                     optname-from-date))))
         (to-date-tp (gnc:timepair-end-day-time 
                      (gnc:date-option-absolute-time
                       (get-option gnc:pagename-general
                                   optname-to-date))))

         ;; calculate the exchange rates
         (exchange-fn (gnc:case-exchange-fn
                       price-source report-currency to-date-tp))

         (doc (gnc:make-html-document))
         (table (gnc:make-html-table))
         (txt (gnc:make-html-text)))

    ;; is account in list of accounts?
    (define (same-account? a1 a2)
      (string=? (gnc:account-get-guid a1) (gnc:account-get-guid a2)))

    (define (same-split? s1 s2) 
      (string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2)))

    (define account-in-list?
      (lambda (account accounts)
        (cond
          ((null? accounts) #f)
          ((same-account? (car accounts) account) #t)
          (else (account-in-list? account (cdr accounts))))))

    (define split-in-list? 
      (lambda (split splits)
	(cond 
	 ((null? splits) #f)
	 ((same-split? (car splits) split) #t)
	 (else (split-in-list? split (cdr splits))))))

    (define account-in-alist
      (lambda (account alist)
        (cond
	   ((null? alist) #f)
           ((same-account? (caar alist) account) (car alist))
           (else (account-in-alist account (cdr alist))))))

    ;; helper for sorting of account list
    (define (account-full-name<? a b)
      (string<? (gnc:account-get-full-name a) (gnc:account-get-full-name b)))

    ;; helper for account depth
    (define (account-get-depth account)
      (define (account-get-depth-internal account-internal depth)
        (let ((parent (gnc:account-get-parent-account account-internal)))
          (if parent
            (account-get-depth-internal parent (+ depth 1))
            depth)))
      (account-get-depth-internal account 1))

    (define (accounts-get-children-depth accounts)
      (apply max
	     (map (lambda (acct)
		    (let ((children 
			   (gnc:account-get-immediate-subaccounts acct)))
		      (if (null? children)
			  1
			  (+ 1 (accounts-get-children-depth children)))))
		  accounts)))


    (gnc:html-document-set-title! 
     doc (sprintf #f (_ "%s - %s to %s for")
		  (get-option gnc:pagename-general gnc:optname-reportname)
                  (gnc:print-date from-date-tp) (gnc:print-date to-date-tp)))


    ;; add subaccounts if requested
    (if show-subaccts?
        (let ((sub-accounts (gnc:acccounts-get-all-subaccounts accounts)))
          (for-each
            (lambda (sub-account)
              (if (not (account-in-list? sub-account accounts))
                  (set! accounts (append accounts sub-accounts))))
            sub-accounts)))


    (if (not (null? accounts))

        (let* ((tree-depth (if (equal? display-depth 'all)
                               (accounts-get-children-depth accounts) 
                               display-depth))
               (account-disp-list '())

               (money-in-accounts '())
               (money-in-alist '())
               (money-in-collector (gnc:make-commodity-collector))

               (money-out-accounts '())
               (money-out-alist '())
               (money-out-collector (gnc:make-commodity-collector))

               (money-diff-collector (gnc:make-commodity-collector))
	       (splits-to-do (gnc:accounts-count-splits accounts))
	       (seen-split-list '())
	       (time-exchange-fn #f)
	       (commodity-list #f))

	  ;; Helper function to convert currencies
	  (define (to-report-currency currency amount date)
	    (gnc:gnc-monetary-amount
	     (time-exchange-fn (gnc:make-gnc-monetary currency amount)
			       report-currency
			       date)))

          ;; function to add inflow and outflow of money
          (define (calc-money-in-out accounts)
            (define (calc-money-in-out-internal accounts-internal)
              (if (not (null? accounts-internal))
                (let* ((current (car accounts-internal))
                       (rest (cdr accounts-internal))
                       (name (gnc:account-get-name current))
                       (curr-commodity (gnc:account-get-commodity current))
                      )

                  ;(gnc:debug "calc-money-in-out-internal---" name "---" (gnc:commodity-get-printname curr-commodity))

                  (for-each
                    (lambda (split)
		      (set! work-done (+ 1 work-done))
		      (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))
                      (let ((parent (gnc:split-get-parent split)))
                        (if (and (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date-tp)
                                 (gnc:timepair-ge (gnc:transaction-get-date-posted parent) from-date-tp))
                          (let* ((parent-description (gnc:transaction-get-description parent))
                                 (parent-currency (gnc:transaction-get-currency parent)))
                            ;(gnc:debug parent-description
                            ;           " - " 
                            ;           (gnc:commodity-get-printname parent-currency))
                            (for-each
                              (lambda (s)
                                (let* ((s-account (gnc:split-get-account s))
                                       (s-amount (gnc:split-get-amount s))
                                       (s-value (gnc:split-get-value s))
                                       (s-commodity (gnc:account-get-commodity s-account)))
				  ;; Check if this is a dangling split
				  ;; and print a warning
				  (if (not s-account)
				      (display
				       (string-append
					"WARNING: s-account is NULL for split: "
					(gnc:split-get-guid s) "\n")))

                                  ;(gnc:debug (gnc:account-get-name s-account))
                                  (if (and	 ;; make sure we don't have
				       s-account ;;  any dangling splits
				       (not (account-in-list? s-account accounts)))
				      (if (not (split-in-list? s seen-split-list))
					  (begin  
					    (set! seen-split-list (cons s seen-split-list))
					    (if (gnc:numeric-negative-p s-value)
						(let ((pair (account-in-alist s-account money-in-alist)))
						  ;(gnc:debug "in:" (gnc:commodity-get-printname s-commodity)
						;	     (gnc:numeric-to-double s-amount) 
						;	     (gnc:commodity-get-printname parent-currency)
						;	     (gnc:numeric-to-double s-value))
						  (if (not pair)
						      (begin
							(set! pair (list s-account (gnc:make-commodity-collector)))
							(set! money-in-alist (cons pair money-in-alist))
							(set! money-in-accounts (cons s-account money-in-accounts))
							;(gnc:debug money-in-alist)
							)
						      )
						  (let ((s-account-in-collector (cadr pair))
							(s-report-value (to-report-currency parent-currency
											    (gnc:numeric-neg s-value)
											    (gnc:transaction-get-date-posted
											     parent))))
						    (money-in-collector 'add report-currency s-report-value)
						    (s-account-in-collector 'add report-currency s-report-value))
						  )
						(let ((pair (account-in-alist s-account money-out-alist)))
						  ;(gnc:debug "out:" (gnc:commodity-get-printname s-commodity)
						;	     (gnc:numeric-to-double s-amount) 
						;	     (gnc:commodity-get-printname parent-currency)
						;	     (gnc:numeric-to-double s-value))
						  (if (not pair)
						      (begin
							(set! pair (list s-account (gnc:make-commodity-collector)))
							(set! money-out-alist (cons pair money-out-alist))
							(set! money-out-accounts (cons s-account money-out-accounts))
							;(gnc:debug money-out-alist)
							)
						      )
						  (let ((s-account-out-collector (cadr pair))
							(s-report-value (to-report-currency parent-currency
											    s-value
											    (gnc:transaction-get-date-posted
											     parent))))
						    (money-out-collector 'add report-currency s-report-value)
						    (s-account-out-collector 'add report-currency s-report-value))
						  )
						)
					    )
					  )
				      )
				  )
				)
                              (gnc:transaction-get-splits parent)
                            )
                          )
                        )
                      )
                    )
                    (gnc:account-get-split-list current)
                  )

                  (calc-money-in-out-internal rest))))

            (calc-money-in-out-internal accounts))

	  ;; Get an exchange function that will convert each transaction using the
	  ;; nearest available exchange rate if that is what is specified
	  (set! commodity-list (gnc:accounts-get-commodities
				accounts
				report-currency))
	  (set! time-exchange-fn (gnc:case-exchange-time-fn
				  price-source report-currency
				  commodity-list to-date-tp
				  0 0))


          (calc-money-in-out accounts)

          (money-diff-collector 'merge money-in-collector #f)
          (money-diff-collector 'minusmerge money-out-collector #f)

          (set! accounts (sort accounts account-full-name<?))
          (set! money-in-accounts (sort money-in-accounts account-full-name<?))
          (set! money-out-accounts (sort money-out-accounts account-full-name<?))


	  (set! work-done 0)
	  (set! work-to-do (length accounts))
          (for-each
            (lambda (account)
              (set! work-done (+ 1 work-done))
              (gnc:report-percent-done (+ 85 (* 5 (/ work-done work-to-do))))
              (if (<= (account-get-depth account) tree-depth)
                (let* ((anchor (gnc:html-markup/format
                                 (if (and (= (account-get-depth account) tree-depth)
                                          (not (eq? (gnc:account-get-immediate-subaccounts account) '())))
                                   (if show-subaccts?
                                     (_ "%s and subaccounts")
                                     (_ "%s and selected subaccounts"))
                                   "%s")
                                 (gnc:html-markup-anchor
                                   (gnc:account-anchor-text account)
                                   (if show-full-names?
                                     (gnc:account-get-full-name account)
                                     (gnc:account-get-name account))))))
                  
                  (set! account-disp-list (cons anchor account-disp-list))
                )
              )
            )
            accounts
          )


	  (gnc:html-document-add-object!
	   doc
	   (gnc:make-html-text (_ "Selected Accounts")))

          (gnc:html-document-add-object!
           doc
           (gnc:make-html-text
            (gnc:html-markup-ul
              (reverse account-disp-list))))

          (gnc:html-table-append-ruler! table 2)

          (gnc:html-table-append-row/markup!
           table
           "primary-subheading"
           (list
             (_ "Money into selected accounts comes from")
             ""))

          (set! row-num 0)
	  (set! work-done 0)
	  (set! work-to-do (length money-in-alist))
          (for-each
            (lambda (account)
              (set! row-num (+ 1 row-num))
	      (set! work-done (+ 1 work-done))
	      (gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do))))
              (let* ((pair (account-in-alist account money-in-alist))
                     (acct (car pair)))
                (gnc:html-table-append-row/markup!
                 table
                 (if (odd? row-num) "normal-row" "alternate-row")
                 (list
                  ;(gnc:html-account-anchor acct)
                  (gnc:make-html-text
                    (gnc:html-markup-anchor
                      (gnc:account-anchor-text acct)
                      (if show-full-names?
                        (gnc:account-get-full-name acct)
                        (gnc:account-get-name acct))))
                  (gnc:make-html-table-header-cell/markup
                   "number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))
              )
            )
            money-in-accounts
          )

          (gnc:html-table-append-row/markup!
           table
           "grand-total"
           (list
             (_ "Money In")
             (gnc:make-html-table-header-cell/markup
              "total-number-cell" (gnc:sum-collector-commodity money-in-collector report-currency exchange-fn))))

          (gnc:html-table-append-ruler! table 2)

          (gnc:html-table-append-row/markup!
           table
           "primary-subheading"
           (list
             (_ "Money out of selected accounts goes to")
             ""))

          (set! row-num 0)
	  (set! work-done 0)
	  (set! work-to-do (length money-out-alist))
          (for-each
            (lambda (account)
              (set! row-num (+ 1 row-num))
	      (set! work-done (+ 1 work-done))
	      (gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do))))
              (let* ((pair (account-in-alist account money-out-alist))
                     (acct (car pair)))
                (gnc:html-table-append-row/markup!
                 table
                 (if (odd? row-num) "normal-row" "alternate-row")
                 (list
                  ;(gnc:html-account-anchor acct)
                  (gnc:make-html-text
                    (gnc:html-markup-anchor
                      (gnc:account-anchor-text acct)
                      (if show-full-names?
                        (gnc:account-get-full-name acct)
                        (gnc:account-get-name acct))))
                  (gnc:make-html-table-header-cell/markup
                   "number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))
              )
            )
            money-out-accounts
          )

          (gnc:html-table-append-row/markup!
           table
           "grand-total"
           (list
             (_ "Money Out")
             (gnc:make-html-table-header-cell/markup
              "total-number-cell" (gnc:sum-collector-commodity money-out-collector report-currency exchange-fn))))

          (gnc:html-table-append-ruler! table 2)

          (gnc:html-table-append-row/markup!
           table
           "grand-total"
           (list
             (_ "Difference")
             (gnc:make-html-table-header-cell/markup
              "total-number-cell" (gnc:sum-collector-commodity money-diff-collector report-currency exchange-fn))))

          (gnc:html-document-add-object! doc table)


          ;; add currency information
          (if show-rates?
              (gnc:html-document-add-object! 
               doc ;;(gnc:html-markup-p
               (gnc:html-make-exchangerates 
                report-currency exchange-fn accounts))))

        
        
        ;; error condition: no accounts specified
        
        (gnc:html-document-add-object! 
         doc 
         (gnc:html-make-no-account-warning 
	  reportname (gnc:report-id report-obj))))

    (gnc:report-finished)
    doc))

(gnc:define-report 
 'version 1
 'name reportname
 'menu-path (list gnc:menuname-income-expense)
 'options-generator cash-flow-options-generator
 'renderer cash-flow-renderer)
