;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; net-charts.scm : Display a time series line or bar chart for
;; either net worth or net profit.
;;
;; By Robert Merkel <rgmerk@mira.net>
;; and Christian Stimming <stimming@tu-harburg.de>
;; and Mike Evans <mikee@saxicooa.co.uk>
;; and Christopher Lam to combine with net-barchart.scm
;;
;; 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 reports standard net-charts))

(use-modules (gnucash engine))
(use-modules (gnucash utilities))
(use-modules (gnucash core-utils))
(use-modules (gnucash app-utils))
(use-modules (gnucash report))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-26))

(define optname-from-date (N_ "Start Date"))
(define optname-to-date (N_ "End Date"))
(define optname-stepsize (N_ "Step Size"))
(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))

(define optname-accounts (N_ "Accounts"))

(define optname-inc-exp (N_ "Show Income/Expense"))
(define optname-show-profit (N_ "Show Net Profit"))

(define optname-sep-bars (N_ "Show Asset & Liability"))
(define optname-net-bars (N_ "Show Net Worth"))

(define optname-plot-width (N_ "Plot Width"))
(define optname-plot-height (N_ "Plot Height"))

(define optname-line-width (N_ "Line Width"))
(define opthelp-line-width (N_ "Set line width in pixels."))

(define optname-markers (N_ "Data markers?"))

;;(define optname-x-grid (N_ "X grid"))
(define optname-y-grid (N_ "Grid"))

(define (options-generator inc-exp? linechart?)
  (let* ((options (gnc-new-optiondb)))

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

    (gnc:options-add-interval-choice!
     options gnc:pagename-general optname-stepsize "b" 'MonthDelta)

    (gnc:options-add-currency!
     options gnc:pagename-general optname-report-currency "c")

    (gnc:options-add-price-source!
     options gnc:pagename-general
     optname-price-source "d" 'weighted-average)

    ;; Account tab

    (gnc-register-account-list-option
     options gnc:pagename-accounts optname-accounts
     "a"
     (N_ "Report on these accounts, if chosen account level allows.")
     (if inc-exp?
         (gnc:filter-accountlist-type
          (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
          (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))

         (filter
          (lambda (account) (not (gnc:account-is-inc-exp? account)))
          (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))))

    ;; Display tab
    (gnc-register-simple-boolean-option options
      gnc:pagename-display
      (if inc-exp? optname-inc-exp optname-sep-bars)
      "a"
      (if inc-exp?
          (N_ "Show Income and Expenses?")
          (N_ "Show the Asset and the Liability bars?"))
      #t)

    (gnc-register-simple-boolean-option options
      gnc:pagename-display
      (if inc-exp? optname-show-profit optname-net-bars)
      "b"
      (if inc-exp?
          (N_ "Show the net profit?")
          (N_ "Show a Net Worth bar?"))
      #t)

    (gnc-register-simple-boolean-option options
      gnc:pagename-display
      (N_ "Show table")
      "c" (N_ "Display a table of the selected data.")
      #f)

    (gnc:options-add-plot-size!
     options gnc:pagename-display
     optname-plot-width optname-plot-height "d" (cons 'percent 100.0) (cons 'percent 100.0))

    (if linechart?
        (begin

          (gnc-register-number-range-option options
            gnc:pagename-display optname-line-width
            "e" opthelp-line-width
            1.5 0.5 5 0.1 )

          (gnc-register-simple-boolean-option options
            gnc:pagename-display optname-y-grid
            "f" (N_ "Add grid lines.")
            #t)

          ;;(gnc-register-simple-boolean-option options
          ;;  gnc:pagename-display optname-x-grid
          ;;  "g" (N_ "Add vertical grid lines.")
          ;;  #f))

          (gnc-register-simple-boolean-option options
            gnc:pagename-display optname-markers
            "g" (N_ "Display a mark for each data point.")
            #t)
          ))

    (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 (net-renderer report-obj inc-exp? linechart? export-type)

  ;; This is a helper function for looking up option values.
  (define (get-option section name)
    (gnc-optiondb-lookup-value (gnc:report-options report-obj) section name))

  (gnc:report-starting "INC/EXP & A/L Charts")
  (let* ((to-date-t64 (gnc:time64-end-day-time
                       (gnc:date-option-absolute-time
                        (get-option gnc:pagename-general
                                    optname-to-date))))
         (from-date-t64 (gnc:time64-start-day-time
                         (gnc:date-option-absolute-time
                          (get-option gnc:pagename-general
                                      optname-from-date))))
         (interval (get-option gnc:pagename-general optname-stepsize))
         (report-currency (get-option gnc:pagename-general optname-report-currency))
         (price-source (get-option gnc:pagename-general optname-price-source))
         (accounts (get-option gnc:pagename-accounts optname-accounts))
         (show-sep? (get-option gnc:pagename-display (if inc-exp?
                                                         optname-inc-exp
                                                         optname-sep-bars)))
         (show-net? (get-option gnc:pagename-display (if inc-exp?
                                                         optname-show-profit
                                                         optname-net-bars)))
         (height (get-option gnc:pagename-display optname-plot-height))
         (width (get-option gnc:pagename-display optname-plot-width))
         (markers (and linechart?
                       (if (get-option gnc:pagename-display optname-markers) 3 0)))
         (line-width (and linechart?
                          (get-option gnc:pagename-display optname-line-width)))
         (y-grid (or (not linechart?) (get-option gnc:pagename-display optname-y-grid)))
         ;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid)))
         (commodity-list #f)
         (exchange-fn #f)
         (dates-list (gnc:make-date-list
                      ((if inc-exp?
                           gnc:time64-start-day-time
                           gnc:time64-end-day-time)
                       from-date-t64)
                      (gnc:time64-end-day-time to-date-t64)
                      (gnc:deltasym-to-delta interval)))
         (report-title (get-option gnc:pagename-general gnc:optname-reportname))
         (classified-accounts (gnc:decompose-accountlist accounts))
         (show-table? (get-option gnc:pagename-display (N_ "Show table")))
         (document (gnc:make-html-document))
         (chart (gnc:make-html-chart)))

    ;; This exchanges the commodity-collector 'c' to one single
    ;; 'report-currency' according to the exchange-fn. Returns an
    ;; amount.
    (define (collector->report-currency-amount c date)
      (fold
       (lambda (mon acc)
         (+ acc (gnc-numeric-convert
                 (gnc:gnc-monetary-amount (exchange-fn mon report-currency date))
                 (gnc-commodity-get-fraction report-currency)
                 GNC-RND-ROUND)))
       0 (c 'format gnc:make-gnc-monetary #f)))

    ;; gets an account alist balances
    ;; output: (list acc bal0 bal1 bal2 ...)
    (define (account->balancelist account)
      (let ((comm (xaccAccountGetCommodity account)))
        (cons account
              (gnc:account-accumulate-at-dates
               account dates-list
               #:split->elt (lambda (s)
                              (gnc:make-gnc-monetary
                               comm (xaccSplitGetNoclosingBalance s)))
               #:nosplit->elt (gnc:make-gnc-monetary comm 0)))))

    ;; This calculates the balances for all the 'account-balances' for
    ;; each element of the list 'dates'. Uses the collector->report-currency-amount
    ;; conversion function above. Returns a list of amounts.
    (define (process-datelist account-balances dates left-col?)

      (define accountlist
        (if inc-exp?
            (if left-col?
                (assoc-ref classified-accounts ACCT-TYPE-INCOME)
                (assoc-ref classified-accounts ACCT-TYPE-EXPENSE))
            (if left-col?
                (assoc-ref classified-accounts ACCT-TYPE-ASSET)
                (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))))

      (define filtered-account-balances
        (filter
         (lambda (a)
           (member (car a) accountlist))
         account-balances))

      (define (acc-balances->list-of-balances lst)
        ;; input: (list (list acc1 bal0 bal1 bal2 ...)
        ;;              (list acc2 bal0 bal1 bal2 ...) ...)
        ;; whereby list of balances are gnc-monetary objects
        ;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
        (define (call thunk) (thunk))
        (if (null? lst)
            (map call (make-list (length dates) gnc:make-commodity-collector))
            (apply map gnc:monetaries-add (map cdr lst))))

      (let loop ((dates dates)
                 (acct-balances (acc-balances->list-of-balances filtered-account-balances))
                 (result '()))
        (if (if inc-exp?
                (null? (cdr dates))
                (null? dates))
            (reverse result)
            (loop (cdr dates)
                  (cdr acct-balances)
                  (cons
                   (collector->report-currency-amount
                    (if inc-exp?
                        (gnc:collector- (car acct-balances) (cadr acct-balances))
                        (car acct-balances))
                    (if inc-exp? (cadr dates) (car dates)))
                   result)))))

    (gnc:report-percent-done 1)
    (set! commodity-list (gnc:accounts-get-commodities
                          (gnc-accounts-and-all-descendants accounts)
                          report-currency))
    (gnc:report-percent-done 10)
    (set! exchange-fn (gnc:case-exchange-time-fn
                       price-source report-currency
                       commodity-list to-date-t64
                       10 40))
    (gnc:report-percent-done 50)

    (if
     (not (null? accounts))
     (let* ((account-balancelist (map account->balancelist accounts))
            (dummy (gnc:report-percent-done 60))

            (minuend-balances (process-datelist account-balancelist dates-list #t))
            (dummy (gnc:report-percent-done 70))

            (subtrahend-balances (process-datelist account-balancelist dates-list #f))
            (dummy (gnc:report-percent-done 80))

            (difference-balances (map + minuend-balances subtrahend-balances))

            (dates-list (if inc-exp?
                            (list-head dates-list (1- (length dates-list)))
                            dates-list))

            (date-string-list (map qof-print-date dates-list)))

       (gnc:report-percent-done 90)

       (gnc:html-chart-set-type! chart (if linechart? 'line 'bar))
       (gnc:html-chart-set-width! chart width)
       (gnc:html-chart-set-height! chart height)
       (gnc:html-chart-set-title!
        chart (list report-title
                    (format #f (G_ "~a to ~a")
                            (qof-print-date from-date-t64)
                            (qof-print-date to-date-t64))))
       (gnc:html-chart-set-y-axis-label!
        chart (gnc-commodity-get-mnemonic report-currency))
       (gnc:html-chart-set-grid?! chart y-grid)
       (gnc:html-chart-set-currency-iso!
        chart (gnc-commodity-get-mnemonic report-currency))
       (gnc:html-chart-set-currency-symbol!
        chart (gnc-commodity-get-nice-symbol report-currency))

       (gnc:html-chart-set-data-labels! chart date-string-list)

       (when show-sep?
         (gnc:html-chart-add-data-series!
          chart
          (if inc-exp? (G_ "Income") (G_ "Assets"))
          minuend-balances
          "#0074D9"
          'fill (not linechart?)
          'pointRadius markers
          'borderWidth line-width
          'urls (gnc:make-report-anchor
                 (if inc-exp?
                     category-barchart-income-uuid
                     category-barchart-asset-uuid)
                 report-obj
                 (list
                  (list gnc:pagename-display "Use Stacked Charts" #t)
                  (list gnc:pagename-general
                        gnc:optname-reportname
                        (if inc-exp?
                            (G_ "Income Chart")
                            (G_ "Asset Chart"))))))

         (gnc:html-chart-add-data-series!
          chart
          (if inc-exp? (G_ "Expense") (G_ "Liabilities"))
          (map - subtrahend-balances)
          "#FF4136"
          'fill (not linechart?)
          'pointRadius markers
          'borderWidth line-width
          'urls (gnc:make-report-anchor
                 (if inc-exp?
                     category-barchart-expense-uuid
                     category-barchart-liability-uuid)
                 report-obj
                 (list
                  (list gnc:pagename-display "Use Stacked Charts"  #t)
                  (list gnc:pagename-general
                        gnc:optname-reportname
                        (if inc-exp?
                            (G_ "Expense Chart")
                            (G_ "Liability Chart")))))))

       (when show-net?
         (gnc:html-chart-add-data-series!
          chart
          (if inc-exp? (G_ "Net Profit") (G_ "Net Worth"))
          difference-balances
          "#2ECC40"
          'fill (not linechart?)
          'pointRadius markers
          'borderWidth line-width))

       ;; Test for all-zero data here.
       (if (gnc:not-all-zeros (append minuend-balances
                                      subtrahend-balances
                                      difference-balances))
           (begin
             (gnc:html-document-add-object! document chart)
             (if show-table?
                 (let ((table (gnc:make-html-table)))
                   (gnc:html-table-set-style!
                    table "table"
                    'attribute (list "border" 0)
                    'attribute (list "cellspacing" 0)
                    'attribute (list "cellpadding" 4))
                   (gnc:html-table-set-col-headers!
                    table
                    (append
                     (list (G_ "Date"))
                     (if show-sep?
                         (if inc-exp?
                             (list (G_ "Income") (G_ "Expense"))
                             (list (G_ "Assets") (G_ "Liabilities")))
                         '())
                     (if show-net?
                         (if inc-exp?
                             (list (G_ "Net Profit"))
                             (list (G_ "Net Worth")))
                         '())))

                   (for-each
                    (lambda (date minuend subtrahend difference)
                      (gnc:html-table-append-row!
                       table
                       (cons date
                             (map
                              (cut gnc:make-html-table-cell/markup "number-cell" <>)
                              (map
                               (cut gnc:make-gnc-monetary report-currency <>)
                               (append (if show-sep? (list minuend subtrahend) '())
                                       (if show-net? (list difference) '())))))))
                    date-string-list
                    minuend-balances
                    subtrahend-balances
                    difference-balances)

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

             (cond
              ((eq? export-type 'csv)
               (let ((iso-date (qof-date-format-get-string QOF-DATE-FORMAT-ISO)))
                 (gnc:html-document-set-export-string
                  document
                  (gnc:lists->csv
                   (cons (if inc-exp?
                             (map G_ '("Date" "Income" "Expense" "Net Profit"))
                             (map G_ '("Date" "Assets" "Liabilities" "Net Worth")))
                         (map list
                              (map (cut gnc-print-time64 <> iso-date) dates-list)
                              minuend-balances
                              subtrahend-balances difference-balances))))))))
           (gnc:html-document-add-object!
            document
            (gnc:html-make-empty-data-warning
             report-title (gnc:report-id report-obj)))))

     ;; else no accounts selected
     (gnc:html-document-add-object!
      document
      (gnc:html-make-no-account-warning
       report-title (gnc:report-id report-obj))))

    (unless (gnc:html-document-export-string document)
      (gnc:html-document-set-export-error document (G_ "No exportable data")))

    (gnc:report-finished)
    document))

;; Export reports

(export net-worth-barchart-uuid)
(export net-worth-linechart-uuid)
(export income-expense-barchart-uuid)

(define net-worth-linechart-uuid "d8b63264186b11e19038001558291366")
(define net-worth-barchart-uuid "cbba1696c8c24744848062c7f1cf4a72")
(define income-expense-barchart-uuid "80769921e87943adade887b9835a7685")

;; Here we define the actual report
(gnc:define-report
 'version 1
 'name (N_ "Net Worth Barchart")
 'report-guid net-worth-barchart-uuid
 'menu-path (list gnc:menuname-asset-liability)
 'options-generator (lambda () (options-generator #f #f))
 'renderer (lambda (report-obj) (net-renderer report-obj #f #f #f))
 'export-types '(("CSV" . csv))
 'export-thunk (lambda (report-obj export-type)
                 (net-renderer report-obj #f #f export-type)))

(gnc:define-report
 'version 1
 'name (N_ "Income/Expense Chart")
 'report-guid income-expense-barchart-uuid
 'menu-name (N_ "Income & Expense Barchart")
 'menu-path (list gnc:menuname-income-expense)
 'options-generator (lambda () (options-generator #t #f))
 'renderer (lambda (report-obj) (net-renderer report-obj #t #f #f))
 'export-types '(("CSV" . csv))
 'export-thunk (lambda (report-obj export-type)
                 (net-renderer report-obj #t #f export-type)))

(gnc:define-report
 'version 1
 'name (N_ "Net Worth Linechart")
 'report-guid net-worth-linechart-uuid
 'menu-path (list gnc:menuname-asset-liability)
 'options-generator (lambda () (options-generator #f #t))
 'renderer (lambda (report-obj) (net-renderer report-obj #f #t #f))
 'export-types '(("CSV" . csv))
 'export-thunk (lambda (report-obj export-type)
                 (net-renderer report-obj #f #t export-type)))

;; Not sure if a line chart makes sense for Income & Expense
;; Feel free to uncomment and try it though
(gnc:define-report
 'version 1
 'name (N_ "Income & Expense Linechart")
 'report-guid "e533c998186b11e1b2e2001558291366"
 'menu-name (N_ "Income & Expense Linechart")
 'menu-path (list gnc:menuname-income-expense)
 'options-generator (lambda () (options-generator #t #t))
 'renderer (lambda (report-obj) (net-renderer report-obj #t #t #f))
 'export-types '(("CSV" . csv))
 'export-thunk (lambda (report-obj export-type)
                 (net-renderer report-obj #t #t export-type)))
