[new-owner-report] use gnc-lot API for searching business links

Previous would search invoices->payments and payment->invoices during
the report by analysing each posting and payment txn.

This change will remove the splits searching and use gnc-lot API to
find these links.

* also use ice-9 match for easier matching
* also use global gnc:multiline-to-html-text
* also remove some duplicate sanity checks

gnucash/report/business-reports/new-owner-report.scm

@@ -31,6 +31,7 @@
 (use-modules (srfi srfi-1))
 (use-modules (srfi srfi-8))
 (use-modules (srfi srfi-11))             ;for let-values
+(use-modules (ice-9 match))
 (use-modules (gnucash gnc-module))
 (use-modules (gnucash utilities))        ; for gnc:debug
 (use-modules (gnucash gettext))
@@ -306,97 +307,104 @@
     (add-row table odd-row? used-columns start-date #f "" (_ "Balance") ""
              currency total #f #f #f #f (list (make-list link-cols #f))))
 
-  (define (make-invoice->payments-table invoice invoice-splits currency txn)
+  (define (make-invoice->payments-table invoice)
-    (let lp ((invoice-splits invoice-splits) (result '()))
+    (define lot (gncInvoiceGetPostedLot invoice))
-      (cond
+    (let lp ((invoice-splits (delete (gnc-lot-get-earliest-split lot)
-       ((null? invoice-splits)
+                                     (gnc-lot-get-split-list lot)))
-        (reverse
+             (result '()))
-         (if (gncInvoiceIsPaid invoice)
+      (match invoice-splits
-             result
+        ;; finished. test for underpayment and add outstanding balance
-             (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
+        (() (reverse
-                         (make-cell
+             (if (gncInvoiceIsPaid invoice)
-                          (gnc:make-gnc-monetary
+                 result
-                           currency
+                 (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
-                           (AP-negate (gnc-lot-get-balance
+                             (make-cell
-                                       (gncInvoiceGetPostedLot invoice))))))
+                              (gnc:make-gnc-monetary
-                   result))))
+                               currency (AP-negate (gnc-lot-get-balance lot)))))
-       (else
+                       result))))
-        (let* ((lot-split (car invoice-splits))
-               (lot-txn (xaccSplitGetParent lot-split))
-               (tfr-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
-          (let lp1 ((tfr-splits tfr-splits) (result result))
-            (cond
-             ((equal? lot-txn txn) (lp (cdr invoice-splits) result))
-             ((null? tfr-splits) (lp (cdr invoice-splits) result))
-             (else
-              (let* ((tfr-split (car tfr-splits))
-                     (tfr-acct (xaccSplitGetAccount tfr-split))
-                     (tfr-curr (xaccAccountGetCommodity tfr-acct))
-                     (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
-                (lp1 (cdr tfr-splits)
-                     (cons (list
-                            (qof-print-date (xaccTransGetDate lot-txn))
-                            (let ((num (gnc-get-num-action lot-txn lot-split)))
-                              (if (string-null? num) (_ "Payment") num))
-                            (make-cell
-                             (gnc:make-html-text
-                              (gnc:html-markup-anchor
-                               (gnc:split-anchor-text tfr-split)
-                               (gnc:make-gnc-monetary tfr-curr tfr-amt)))))
-                           result)))))))))))
 
-  (define (make-payment->invoices-list invoice payment-splits)
+        ;; invoice's lot's payment splits
+        ((lot-split . rest-lot-splits)
+         (let* ((lot-txn (xaccSplitGetParent lot-split))
+                (tfr-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
+           (let lp1 ((tfr-splits tfr-splits) (result result))
+             (match tfr-splits
+               (() (lp rest-lot-splits result))
+               ((tfr-split . rest-tfr-splits)
+                (let* ((tfr-acct (xaccSplitGetAccount tfr-split))
+                       (tfr-curr (xaccAccountGetCommodity tfr-acct))
+                       (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
+                  (lp1 rest-tfr-splits
+                       (cons (list
+                              (qof-print-date (xaccTransGetDate lot-txn))
+                              (let ((num (gnc-get-num-action lot-txn lot-split)))
+                                (if (string-null? num) (_ "Payment") num))
+                              (make-cell
+                               (gnc:make-html-text
+                                (gnc:html-markup-anchor
+                                 (gnc:split-anchor-text tfr-split)
+                                 (gnc:make-gnc-monetary tfr-curr tfr-amt)))))
+                             result)))))))))))
+
+  (define (payment-txn->overpayment-and-invoices txn)
+    (let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
+             (overpayment 0)
+             (invoices '()))
+      (match splits
+        (() (cons (AP-negate overpayment) invoices))
+        ((split . rest)
+         (let ((invoice (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split))))
+           (if (null? invoice)
+               (lp rest
+                   (- overpayment (xaccSplitGetAmount split))
+                   invoices)
+               (lp rest
+                   overpayment
+                   (cons invoice invoices))))))))
+
+  (define (make-payment->invoices-list txn)
     (list
      (list
       (apply
        gnc:make-html-text
        (map
-        (lambda (inv-splits)
+        (lambda (inv)
           (gnc:html-markup-anchor
-           (gnc:invoice-anchor-text (car inv-splits))
+           (gnc:invoice-anchor-text inv)
            (gnc-get-num-action
-            (gncInvoiceGetPostedTxn (car inv-splits))
+            (gncInvoiceGetPostedTxn inv)
             #f)))
-        payment-splits)))))
+        (cdr (payment-txn->overpayment-and-invoices txn)))))))
 
-  (define (make-payment->invoices-table txn payment-splits currency)
+  (define (make-payment->invoices-table txn)
-    (let lp ((payment-splits payment-splits)
+    (define overpayment-and-invoices (payment-txn->overpayment-and-invoices txn))
+    (let lp ((invoices (cdr overpayment-and-invoices))
              (result '()))
-      (cond
+      (match invoices
-       ((null? payment-splits)
+        (()
-        (let ((overpayment
+         (let ((overpayment (car overpayment-and-invoices)))
-               (fold
+           (reverse
-                (lambda (a b)
+            (if (zero? overpayment)
-                  (if (null? (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot a)))
+                result
-                      (- b (xaccSplitGetAmount a))
+                (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Prepayments"))
-                      b))
+                            (make-cell (gnc:make-gnc-monetary currency overpayment)))
-                0 (xaccTransGetAPARAcctSplitList txn #f))))
+                      result)))))
-          (reverse
+        ((inv . rest)
-           (if (positive? overpayment)
+         (lp rest
-               (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Prepayments"))
+             (cons (list
-                           (make-cell (gnc:make-gnc-monetary currency overpayment)))
+                    (qof-print-date (gncInvoiceGetDatePosted inv))
-                     result)
+                    (gnc:make-html-text
-               result))))
+                     (gnc:html-markup-anchor
-       (else
+                      (gnc:invoice-anchor-text inv)
-        (let* ((payment-split (car payment-splits))
+                      (gnc-get-num-action (gncInvoiceGetPostedTxn inv) #f)))
-               (inv (car payment-split))
+                    (make-cell (gnc:make-gnc-monetary currency (invoice->total inv))))
-               (inv-amount (gncInvoiceGetTotal inv)))
+                   result))))))
-          (lp (cdr payment-splits)
-              (cons (list
-                     (qof-print-date (gncInvoiceGetDatePosted inv))
-                     (gnc:make-html-text
-                      (gnc:html-markup-anchor
-                       (gnc:invoice-anchor-text inv)
-                       (gnc-get-num-action (gncInvoiceGetPostedTxn inv) #f)))
-                     (make-cell (gnc:make-gnc-monetary currency inv-amount)))
-                    result)))))))
 
   (define (split->type-str split)
     (let* ((txn (xaccSplitGetParent split))
            (invoice (gncInvoiceGetInvoiceFromTxn txn)))
       (cond
-       ((and (txn-is-invoice? txn)
+       ((txn-is-invoice? txn)
-             (not (null? invoice)))
         (gnc:make-html-text
          (gnc:html-markup-anchor
           (gnc:invoice-anchor-text invoice)
@@ -420,6 +428,11 @@
          ((if (gncInvoiceGetIsCreditNote invoice) - identity)
           (gncInvoiceGetTotalTax invoice))))
 
+  (define (invoice->total invoice)
+    (and (not (null? invoice))
+         ((if (gncInvoiceGetIsCreditNote invoice) - identity)
+          (gncInvoiceGetTotal invoice))))
+
   (define (invoice->due-date invoice)
     (and (not (null? invoice))
          (gncInvoiceIsPosted invoice)
@@ -432,8 +445,7 @@
            (debit 0)
            (credit 0)
            (tax 0)
-           (sale 0)
+           (sale 0))
-           (links '()))
     (cond
 
      ((null? splits)
@@ -452,7 +464,7 @@
      ;; not an invoice/payment. skip transaction.
      ((not (or (txn-is-invoice? (xaccSplitGetParent (car splits)))
                (txn-is-payment? (xaccSplitGetParent (car splits)))))
-      (lp printed? odd-row? (cdr splits) total debit credit tax sale links))
+      (lp printed? odd-row? (cdr splits) total debit credit tax sale))
 
      ;; invalid case: txn-type-invoice but no associated invoice, nor lot
      ((let* ((txn (xaccSplitGetParent (car splits)))
@@ -461,26 +473,15 @@
              (or (null? invoice)
                  (null? (gncInvoiceGetPostedLot invoice)))))
       (gnc:warn "sanity check fail" txn)
-      (lp printed? odd-row? (cdr splits) total debit credit tax sale links))
+      (lp printed? odd-row? (cdr splits) total debit credit tax sale))
 
      ;; start printing txns.
      (else
       (let* ((split (car splits))
              (txn (xaccSplitGetParent split))
              (date (xaccTransGetDate txn))
-             (value (xaccTransGetAccountAmount txn acc))
+             (value (AP-negate (xaccTransGetAccountAmount txn acc)))
-             (value (if payable? (- value) value))
+             (invoice (gncInvoiceGetInvoiceFromTxn txn)))
-             (invoice (gncInvoiceGetInvoiceFromTxn txn))
-             (invoice-splits
-              (and (txn-is-invoice? txn)
-                   (gnc-lot-get-split-list
-                    (gncInvoiceGetPostedLot invoice))))
-             (payment-splits
-              (and (txn-is-payment? txn)
-                   (filter
-                    (lambda (inv-split)
-                      (member txn (map xaccSplitGetParent (cdr inv-split))))
-                    links))))
 
         (cond
          ;; txn-date < start-date. skip display, accumulate amounts
@@ -488,15 +489,14 @@
           (lp printed? odd-row? (cdr splits) (+ total value)
               (if (negative? value) (+ debit value) debit)
               (if (negative? value) credit (+ credit value))
-              tax sale (if (null? invoice) links
+              tax sale))
-                           (acons invoice invoice-splits links))))
 
          ;; if balance row hasn't been rendered, consider
          ;; adding here.  skip if value=0.
          ((not printed?)
           (let ((print? (and (value-col used-columns) (not (zero? total)))))
             (if print? (add-balance-row odd-row? total))
-            (lp #t (not print?) splits total debit credit tax sale links)))
+            (lp #t (not print?) splits total debit credit tax sale)))
 
          (else
           (add-row
@@ -506,26 +506,23 @@
            (and (>= value 0) value) (and (< value 0) value)
            (invoice->sale invoice) (invoice->tax invoice)
            (cond
-            ((and invoice-splits (eq? link-option 'simple))
+            ((and (txn-is-invoice? txn) (eq? link-option 'simple))
-             (if (gnc-lot-is-closed (gncInvoiceGetPostedLot invoice))
+             (if (gncInvoiceIsPaid invoice)
                  (list (list (_ "Paid")))
                  (list (list #f))))
-            ((and invoice-splits (eq? link-option 'detailed))
+            ((and (txn-is-invoice? txn) (eq? link-option 'detailed))
-             (make-invoice->payments-table invoice invoice-splits currency txn))
+             (make-invoice->payments-table invoice))
-            ((and payment-splits (eq? link-option 'simple))
+            ((and (txn-is-payment? txn) (eq? link-option 'simple))
-             (make-payment->invoices-list invoice payment-splits))
+             (make-payment->invoices-list txn))
-            ((and payment-splits (eq? link-option 'detailed))
+            ((and (txn-is-payment? txn) (eq? link-option 'detailed))
-             (make-payment->invoices-table txn payment-splits currency))
+             (make-payment->invoices-table txn currency))
-            ;; some error occurred, show 1 line containing empty-list
             (else '(()))))
 
           (lp printed? (not odd-row?) (cdr splits) (+ total value)
               (if (negative? value) (+ debit value) debit)
               (if (negative? value) credit (+ credit value))
               (+ tax (or (invoice->tax invoice) 0))
-              (+ sale (or (invoice->sale invoice) 0))
+              (+ sale (or (invoice->sale invoice) 0))))))))))
-              (if (null? invoice) links
-                  (acons invoice invoice-splits links))))))))))
 
 (define (options-generator owner-type)
 
@@ -632,17 +629,6 @@ invoices and amounts.")))))
 
   gnc:*report-options*)
 
-(define (multiline-to-html-text str)
-  ;; simple function - splits string containing #\newline into
-  ;; substrings, and convert to a gnc:make-html-text construct which
-  ;; adds gnc:html-markup-br after each substring.
-  (let loop ((list-of-substrings (string-split str #\newline))
-             (result '()))
-    (if (null? list-of-substrings)
-        (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
-        (loop (cdr list-of-substrings)
-              (cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
-
 (define (setup-query q owner accounts end-date job?)
   (let ((guid (gncOwnerReturnGUID (if job? owner (gncOwnerGetEndOwner owner))))
         (last-param (if job? QOF-PARAM-GUID OWNER-PARENTG)))
@@ -670,7 +656,7 @@ invoices and amounts.")))))
      'attribute (list "cellpadding" 0)
      'attribute (list "valign" "top"))
     (gnc:html-table-append-row!
-     table (multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
+     table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
     table))
 
 (define (make-myname-table book date-format)
@@ -689,7 +675,7 @@ invoices and amounts.")))))
     (when name
       (gnc:html-table-append-row! table (list name)))
     (when addy
-      (gnc:html-table-append-row! table (multiline-to-html-text addy)))
+      (gnc:html-table-append-row! table (gnc:multiline-to-html-text addy)))
     (gnc:html-table-append-row!
      table (list (gnc-print-time64 (gnc:get-today) date-format)))
     table))
@@ -730,7 +716,7 @@ invoices and amounts.")))))
          (document (gnc:make-html-document))
          (table (gnc:make-html-table))
          (headings (make-heading-list used-columns link-option))
-         (report-title (string-append (_ (owner-string type)) " " (_ "Report"))))
+         (report-title (string-append (_ owner-descr) " " (_ "Report"))))
 
     (cond
      ((not (gncOwnerIsValid owner))