mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[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.
This commit is contained in:
parent
820cd842f1
commit
9d25b25be3
@ -737,6 +737,8 @@
|
|||||||
(export gnc:select-assoc-account-balance)
|
(export gnc:select-assoc-account-balance)
|
||||||
(export gnc:get-assoc-account-balances-total)
|
(export gnc:get-assoc-account-balances-total)
|
||||||
(export make-file-url)
|
(export make-file-url)
|
||||||
|
(export gnc:strify)
|
||||||
|
(export gnc:pk)
|
||||||
|
|
||||||
(load-from-path "commodity-utilities")
|
(load-from-path "commodity-utilities")
|
||||||
(load-from-path "html-barchart")
|
(load-from-path "html-barchart")
|
||||||
|
@ -18,6 +18,7 @@
|
|||||||
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
||||||
|
|
||||||
(use-modules (srfi srfi-13))
|
(use-modules (srfi srfi-13))
|
||||||
|
(use-modules (ice-9 format))
|
||||||
|
|
||||||
(define (list-ref-safe list elt)
|
(define (list-ref-safe list elt)
|
||||||
(and (> (length 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)
|
(if (string-prefix? "file:///" url)
|
||||||
url
|
url
|
||||||
(string-append "file:///" 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))))
|
||||||
|
Loading…
Reference in New Issue
Block a user