;; -*-scheme-*-

(define-module (gnucash reports example account-customer-matrix))

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Options Configuration Layout
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (account-customer-matrix-options)
  (let* ((options (gnc:new-options))
         (optiondb (options #t)))

    (gnc-register-date-option-set
     optiondb
     "General" "Start Date"
     "1-start-date" "Beginning of reporting period."
     '(today 
       start-cur-month 
       start-prev-month 
       start-cur-quarter 
       start-prev-quarter 
       start-cal-year 
       start-prev-year 
       start-accounting-period)
     #t)

    (gnc-register-date-option-set
     optiondb
     "General" "End Date"
     "2-end-date" "End of reporting period."
     '(today 
       end-cur-month 
       end-prev-month 
       end-cur-quarter 
       end-prev-quarter 
       end-cal-year 
       end-prev-year 
       end-accounting-period)
     #t)

    (gnc-register-account-list-option 
     optiondb
     "General"
     "Select Accounts to Display"
     "3-accounts"
     "" 
     (gnc-account-list-from-types
      (gnc-get-current-book)
      (list ACCT-TYPE-BANK ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)))

    options))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Account filtering & Naming Maps
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define account-types
  (list
   ACCT-TYPE-BANK
   ACCT-TYPE-ASSET
   ACCT-TYPE-LIABILITY
   ACCT-TYPE-INCOME
   ACCT-TYPE-EXPENSE))

(define (get-account-type-name type-id)
  (cond
   ((= type-id ACCT-TYPE-BANK) "BANK")
   ((= type-id ACCT-TYPE-ASSET) "ASSET")
   ((= type-id ACCT-TYPE-LIABILITY) "LIABILITY")
   ((= type-id ACCT-TYPE-INCOME) "INCOME")
   ((= type-id ACCT-TYPE-EXPENSE) "EXPENSE")
   (else "OTHER")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customer classification
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (lower-case text)
  (string-downcase (or text "")))

(define (split-customer split)
  (let* ((transaction (xaccSplitGetParent split))
         (split-memo (lower-case (xaccSplitGetMemo split)))
         (description (lower-case (xaccTransGetDescription transaction)))
         (notes (lower-case (xaccTransGetNotes transaction))))

    (cond
     ((or (string-contains split-memo "customer 1")
          (string-contains description "customer 1")
          (string-contains notes "customer 1"))
      "Customer 1")

     ((or (string-contains split-memo "customer 2")
          (string-contains description "customer 2")
          (string-contains notes "customer 2"))
      "Customer 2")

     (else "Other"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Quantitative Balance Collectors
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (account-fraction account)
  (let ((commodity (xaccAccountGetCommodity account)))
    (if commodity
        (gnc-commodity-get-fraction commodity)
        100)))

(define (split-value split account)
  (gnc-numeric-to-double (xaccSplitGetValue split)))

(define (split-in-period? split start-time end-time)
  (let* ((transaction (xaccSplitGetParent split))
         (tx-date (xaccTransGetDate transaction))) 
    (cond
     ((and start-time end-time) (and (>= tx-date start-time) (<= tx-date end-time)))
     (start-time (>= tx-date start-time))
     (end-time (<= tx-date end-time))
     (else #t))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTML Helpers (Aligned to Style Sheet Class Tokens)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (number-cell value)
  (gnc:make-html-table-cell/markup "number-cell" (format #f "~,2f" value)))

(define (text-cell value)
  (gnc:make-html-table-cell/markup "text-cell" value))

(define (header-cell value)
  (gnc:make-html-table-cell/markup "column-heading-left" value))

(define (type-heading-cell value)
  (gnc:make-html-table-header-cell/markup "column-heading-left" value))

(define (empty-cell)
  (gnc:make-html-table-cell/markup "text-cell" ""))

(define (bold-text-cell value)
  (gnc:make-html-table-cell/markup "total-label-cell" value))

(define (bold-number-cell value)
  (gnc:make-html-table-cell/markup "total-number-cell" (format #f "~,2f" value)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Renderer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (account-customer-matrix-renderer report-obj)
  (define (op-value section name)
    (let ((options-raw (gnc:report-options report-obj)))
      (gnc-optiondb-lookup-value (if (procedure? options-raw) (options-raw 'lookup) options-raw)
                                  section name)))

  (let* ((customer-1 "Customer 1")
         (customer-2 "Customer 2")
         (other      "Other")
         
         (start-date-opt (op-value "General" "Start Date"))
         (end-date-opt   (op-value "General" "End Date"))
         
         (start-date (and start-date-opt (gnc:date-option-absolute-time start-date-opt)))
         (end-date   (and end-date-opt   (gnc:date-option-absolute-time end-date-opt)))

         (selected-accounts (op-value "General" "Select Accounts to Display"))

         (document (gnc:make-html-document))
         (table    (gnc:make-html-table))
         (root     (gnc-get-current-root-account))
         
         (all-accounts (if (and selected-accounts (not (null? selected-accounts)))
                           selected-accounts
                           (gnc-account-get-descendants root))))

    ;; DATA COLLECTION ENGINE
    (define (get-total account target-cust)
      (let ((splits (xaccAccountGetSplitList account)))
        (fold
         (lambda (split accum)
           (let* ((cust-name (split-customer split))
                  (val (gnc-numeric-to-double (xaccSplitGetValue split))))
             (cond
              ((not (split-in-period? split start-date end-date)) accum)
              ((not target-cust) (+ accum val))
              ((string=? cust-name target-cust) (+ accum val))
              (else accum))))
         0.0
         splits)))

    ;; FULL PATH BUILDER
    (define (build-full-name account)
      (let loop ((acc account) (path-list '()))
        (if (or (not acc) (gnc-account-is-root acc))
            (string-join path-list ":")
            (loop (gnc-account-get-parent acc) 
                  (cons (xaccAccountGetName acc) path-list)))))

    (gnc:html-document-set-title! document (N_ "Account Customer Matrix"))

    ;; Dynamic Date range subtitle line rendering logic
    (let ((start-str (if start-date (qof-print-date start-date) #f))
          (end-str   (if end-date   (qof-print-date end-date)   #f)))
      (gnc:html-document-add-object! document
        (gnc:make-html-text
         (format #f "<p style=\"font-weight: bold; margin-bottom: 15px;\">Period: ~a</p>"
                 (cond ((and start-str end-str) (format #f "~a to ~a" start-str end-str))
                       (start-str (format #f "From ~a onwards" start-str))
                       (end-str   (format #f "Up to ~a" end-str))
                       (else "All Time"))))))

    ;; Header row
    (gnc:html-table-append-row!
     table
     (list
      (header-cell "Account")
      (header-cell customer-1)
      (header-cell customer-2)
      (header-cell other)
      (header-cell "Total")))

    ;; Loop groups dynamically over filtered type boundaries
    (for-each
     (lambda (type-id)
       (let ((type-accounts
              (filter
               (lambda (acc) (= (xaccAccountGetType acc) type-id))
               all-accounts)))
         
         (if (not (null? type-accounts))
             (begin
               ;; Divider Row (Now cleanly outputs UPPERCASE BOLD section titles)
               (gnc:html-table-append-row/markup!
                table
                "primary-subheading"
                (list (type-heading-cell (string-upcase (get-account-type-name type-id)))
                      (empty-cell) (empty-cell) (empty-cell) (empty-cell)))
               
               ;; Output Child Balance Records using filtering math logic
               (for-each
                (lambda (account)
                  (let ((c1-val (get-total account customer-1))
                        (c2-val (get-total account customer-2))
                        (ot-val (get-total account other))
                        (tt-val (get-total account #f)))
                    
                    (gnc:html-table-append-row!
                     table
                     (list
                      (text-cell (build-full-name account))
                      (number-cell c1-val)
                      (number-cell c2-val)
                      (number-cell ot-val)
                      (number-cell tt-val)))))
                type-accounts)

               ;; Compute Section Totals using safe aggregation matching structures
               (let ((sub-c1 (fold (lambda (a t) (+ t (get-total a customer-1))) 0.0 type-accounts))
                     (sub-c2 (fold (lambda (a t) (+ t (get-total a customer-2))) 0.0 type-accounts))
                     (sub-ot (fold (lambda (a t) (+ t (get-total a other))) 0.0 type-accounts))
                     (sub-tt (fold (lambda (a t) (+ t (get-total a #f))) 0.0 type-accounts)))
                 (gnc:html-table-append-row!
                  table
                  (list
                   (bold-text-cell (format #f "Total ~a" (string-titlecase (get-account-type-name type-id))))
                   (bold-number-cell sub-c1)
                   (bold-number-cell sub-c2)
                   (bold-number-cell sub-ot)
                   (bold-number-cell sub-tt))))))))
     account-types)

    ;; Consolidated Grand Matrix Calculation
    (let ((grand-c1 (fold (lambda (a t) (+ t (get-total a customer-1))) 0.0 all-accounts))
          (grand-c2 (fold (lambda (a t) (+ t (get-total a customer-2))) 0.0 all-accounts))
          (grand-ot (fold (lambda (a t) (+ t (get-total a other))) 0.0 all-accounts))
          (grand-tt (fold (lambda (a t) (+ t (get-total a #f))) 0.0 all-accounts)))
      (gnc:html-table-append-row/markup!
       table
       "grand-total"
       (list
        (bold-text-cell "Grand Total")
        (bold-number-cell grand-c1)
        (bold-number-cell grand-c2)
        (bold-number-cell grand-ot)
        (bold-number-cell grand-tt))))

    ;; Custom Footer Disclaimer Lines (Red 12px)
    (gnc:html-document-add-object! 
     document 
     (gnc:make-html-text 
      "<p style=\"margin-top: 30px; font-style: italic; color: red; font-size: 12px;\">"
      "Use code with caution.<br/>"
      "AI Generated concept with minimal verification."
      "</p>"))

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Report registration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(gnc:define-report
 'version 1
 'name (N_ "Account Customer Matrix")
 'report-guid "7b37f3b79b2f4b2f8b2d0bb91b5f3db7"
 'menu-path (list gnc:menuname-example)
 'options-generator account-customer-matrix-options
 'renderer account-customer-matrix-renderer)