From 9d25b25be30b8ac15b5423e5e02f913142d1a7e9 Mon Sep 17 00:00:00 2001
From: Christopher Lam <christopher.lck@gmail.com>
Date: Wed, 19 Sep 2018 11:34:07 +0800
Subject: [PATCH] [report-utilities] add (gnc:strify) and (gnc:pk) for
 debugging

The (gnc:strify) function will take an object, and try various methods
to display a useful output. Instead of a cryptic "#<swig-pointer
Split * 55a7079b2660> () # ?" message it can show
"Split<d:02/05/2018,acc:Bank1,amt:$20,val:$20>"

The (gnc:pk) function is a debugging tool. It will dump all arguments
via gnc:strify to console and return the last argument. In addition,
it will print the time stamp since the procedure was defined, and the
delta time since the last (gnc:pk) call.

(gnc:pk "call weird-fn with " acc " = " (weird-fn acc))
(gnc:pk "call another-fn =" (another-fn))

[d2.3243 t2.3243] call weird-fn with Acc<Bank> = Mon<$25.00>
[d0.1000 t2.4243] call another-fn = #t

This would suggest that (weird-fn acc) ran for 0.1 seconds, and
returned a gnc:gnc-monetary object.
---
 .../report/report-system/report-system.scm    |  2 +
 .../report/report-system/report-utilities.scm | 87 +++++++++++++++++++
 2 files changed, 89 insertions(+)

diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 73357a646d..f600835cf1 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -737,6 +737,8 @@
 (export gnc:select-assoc-account-balance)
 (export gnc:get-assoc-account-balances-total)
 (export make-file-url)
+(export gnc:strify)
+(export gnc:pk)
 
 (load-from-path "commodity-utilities")
 (load-from-path "html-barchart")
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 1b8cde8f04..f01a97a4d5 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -18,6 +18,7 @@
 ;; Boston, MA  02110-1301,  USA       gnu@gnu.org
 
 (use-modules (srfi srfi-13))
+(use-modules (ice-9 format))
 
 (define (list-ref-safe list elt)
   (and (> (length list) elt)
@@ -966,3 +967,89 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
   (if (string-prefix? "file:///" url)
      url
      (string-append "file:///" url)))
+
+(define-public (gnc:strify d)
+  ;; any object -> string.  The option is passed to various
+  ;; scm->string converters; ultimately a generic stringify
+  ;; function handles symbol/string/other types.
+  (define (split->str spl)
+    (let ((txn (xaccSplitGetParent spl)))
+      (format #f "Split<d:~a,acc:~a,amt:~a,val:~a>"
+              (qof-print-date (xaccTransGetDate txn))
+              (xaccAccountGetName (xaccSplitGetAccount spl))
+              (gnc:monetary->string
+               (gnc:make-gnc-monetary
+                (xaccTransGetCurrency txn)
+                (xaccSplitGetValue spl)))
+              (gnc:monetary->string
+               (gnc:make-gnc-monetary
+                (xaccAccountGetCommodity
+                 (xaccSplitGetAccount spl))
+                (xaccSplitGetAmount spl))))))
+  (define (trans->str txn)
+    (format #f "Txn<d:~a>" (qof-print-date (xaccTransGetDate txn))))
+  (define (account->str acc)
+    (format #f "Acc<~a>" (xaccAccountGetName acc)))
+  (define (monetary-collector->str coll)
+    (format #f "Mon-coll<~a>"
+            (map gnc:strify (coll 'format gnc:make-gnc-monetary #f))))
+  (define (value-collector->str coll)
+    (format #f "Val-coll<~a>"
+            (map gnc:strify (coll 'total gnc:make-gnc-monetary))))
+  (define (procedure->str proc)
+    (format #f "Proc<~a>"
+            (or (procedure-name proc) "unk")))
+  (define (monetary->string mon)
+    (format #f "Mon<~a>"
+            (gnc:monetary->string mon)))
+  (define (try proc)
+    ;; Try proc with d as a parameter, catching 'wrong-type-arg
+    ;; exceptions to return #f to the (or) evaluator below.
+    (catch 'wrong-type-arg
+      (lambda () (proc d))
+      (const #f)))
+  (or (and (boolean? d) (if d "#t" "#f"))
+      (and (null? d) "#null")
+      (and (symbol? d) (format #f "'~a" d))
+      (and (string? d) d)
+      (and (list? d) (string-append
+                      "(list "
+                      (string-join (map gnc:strify d) " ")
+                      ")"))
+      (and (pair? d) (format #f "(~a . ~a)"
+                             (gnc:strify (car d))
+                             (if (eq? (car d) 'absolute)
+                                 (qof-print-date (cdr d))
+                                 (gnc:strify (cdr d)))))
+      (try procedure->str)
+      (try gnc-commodity-get-mnemonic)
+      (try account->str)
+      (try split->str)
+      (try trans->str)
+      (try monetary-collector->str)
+      (try value-collector->str)
+      (try monetary->string)
+      (try gnc-budget-get-name)
+      (object->string d)))
+
+(define (pair->num pair)
+  (+ (car pair)
+     (/ (cdr pair) 1000000)))
+
+(define (delta t1 t2)
+  (exact->inexact
+   (- (pair->num t2)
+      (pair->num t1))))
+
+(define-public gnc:pk
+  (let* ((start-time (gettimeofday))
+         (last-time start-time))
+    (lambda args
+      (let ((now (gettimeofday)))
+        (format #t "d~,4f t~,3f: "
+                (delta last-time now)
+                (delta start-time now))
+        (set! last-time now))
+      (display (map gnc:strify args))
+      (newline)
+      (last args))))