reports: Add account and split module, plus tests.

Remove common functions from the budget and cashflow reports.
Add into separate modules, plus some tests for these newly exposed
functions.

src/report/report-system/Makefile.am

@@ -69,10 +69,11 @@ gncscm_DATA = \
 
 gncmodscmdir = ${GNC_SCM_INSTALL_DIR}/gnucash/report/report-system
 gncmodscm_DATA = \
+     account.scm \
      collectors.scm \
      list-extras.scm \
-     report-collectors.scm
-
+     report-collectors.scm \
+     split.scm
 
 gncscmmoddir = ${GNC_SCM_INSTALL_DIR}/gnucash/report/
 gncscmmod_DATA = \

src/report/report-system/account.scm

@@ -0,0 +1,62 @@
+(define-module (gnucash report report-system account))
+(use-modules (gnucash gnc-module))
+(use-modules (gnucash gnc-module))
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-13))
+
+(gnc:module-begin-syntax (gnc:module-load "gnucash/engine" 0))
+
+(export account-same?)
+(export account-in-list?)
+(export account-in-list-pred)
+(export account-in-alist)
+(export account-full-name<?)
+(export account-list-predicate)
+(export accounts-get-children-depth)
+
+;; is account in list of accounts?
+(define (account-same? a1 a2)
+  (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
+
+(define account-in-list?
+  (lambda (account accounts)
+    (cond
+     ((null? accounts) #f)
+     ((account-same? (car accounts) account) #t)
+     (else (account-in-list? account (cdr accounts))))))
+
+;; Optimized version of accout-in-list if we know
+;; the list in advance.
+(define (account-in-list-pred accounts)
+  (define (my-assoc str alist)
+    (find (lambda (pair) (account-same? str (car pair))) alist))
+  (define (my-hash acc size)
+    (remainder (string-hash (gncAccountGetGUID acc)) size))
+  (let ((hash-table (make-hash-table)))
+    (for-each (lambda (acc) (hashx-set! my-hash my-assoc hash-table acc #t))
+	      accounts)
+    (lambda (account)
+      (hashx-ref my-hash my-assoc hash-table account))))
+
+(define account-in-alist
+  (lambda (account alist)
+    (cond
+     ((null? alist) #f)
+     ((account-same? (caar alist) account) (car alist))
+     (else (account-in-alist account (cdr alist))))))
+
+;; helper for sorting of account list
+(define (account-full-name<? a b)
+  (string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
+
+;; return maximum depth over accounts and their children, if any
+(define (accounts-get-children-depth accounts)
+  (apply max
+	 (map (lambda (acct)
+		(let ((acct-depth (gnc-account-get-current-depth acct)))
+		  (+ acct-depth (- (gnc-account-get-tree-depth acct) 1))))
+	      accounts)))
+
+
+

src/report/report-system/split.scm

@@ -0,0 +1,20 @@
+(define-module (gnucash report report-system split))
+(use-modules (gnucash gnc-module))
+
+(gnc:module-begin-syntax (gnc:module-load "gnucash/engine" 0))
+
+(use-modules (sw_engine))
+
+(export split-same?)
+(export split-in-list?)
+
+(define (split-same? s1 s2) 
+  (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
+
+(define split-in-list? 
+  (lambda (split splits)
+    (cond 
+     ((null? splits) #f)
+     ((split-same? (car splits) split) #t)
+     (else (split-in-list? split (cdr splits))))))
+

src/report/report-system/test/Makefile.am

@@ -21,7 +21,9 @@ TESTS = \
 SCM_TESTS = \
 	test-collectors \
 	test-list-extras \
-	test-test-extras
+	test-test-extras \
+	test-account  \
+	test-split
 
 SCM_TEST_SRCS = $(SCM_TESTS:%=%.scm)
 

src/report/report-system/test/test-account.scm

@@ -0,0 +1,47 @@
+(use-modules (gnucash report report-system account))
+
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (sw_engine))
+
+(define (run-test)
+  (test test-account-same?)
+  (test test-account-in-list?)
+  (test test-account-in-alist?)
+  (test test-account-list-predicate))
+
+(define (test-account-same?)
+  (let* ((env (create-test-env))
+	 (account-alist (env-create-test-accounts env))
+	 (bank-account (cdr (assoc "Bank" account-alist)))
+	 (expense-account (cdr (assoc "Expenses" account-alist))))
+    (and (account-same? bank-account bank-account)
+	 (not (account-same? bank-account expense-account)))))
+
+(define (test-account-in-alist?)
+  (let* ((env (create-test-env))
+	 (account-alist (env-create-test-accounts env))
+	 (bank-account (cdr (assoc "Bank" account-alist)))
+	 (wallet-account (cdr (assoc "Wallet" account-alist)))
+	 (expense-account (cdr (assoc "Expenses" account-alist))))
+    (let ((alist (list (cons bank-account "Bank") (cons expense-account "Expenses"))))
+      (and (account-in-alist bank-account alist)
+	   (account-in-alist expense-account alist)
+	   (not (account-in-alist wallet-account alist))))))
+
+(define (test-account-in-list?)
+  (test-account-list-predicate-generic
+   (lambda (accounts) (lambda (account) (account-in-list? account accounts)))))
+
+(define (test-account-list-predicate)
+  (test-account-list-predicate-generic account-in-list-pred))
+
+(define (test-account-list-predicate-generic predicate)
+  (let* ((env (create-test-env))
+	 (account-alist (env-create-test-accounts env))
+	 (bank-account (cdr (assoc "Bank" account-alist)))
+	 (wallet-account (cdr (assoc "Wallet" account-alist)))
+	 (other-account (cdr (assoc "Other" account-alist)))
+	 (bank-or-wallet? (predicate (list bank-account wallet-account))))
+    (and (bank-or-wallet? bank-account)
+	 (bank-or-wallet? wallet-account)
+	 (not (bank-or-wallet? other-account)))))

src/report/report-system/test/test-extras.scm

@@ -54,8 +54,10 @@
 (export env-create-transaction)
 (export env-create-account)
 (export env-create-root-account)
+(export env-create-test-accounts)
 (export env-create-daily-transactions)
 (export env-create-account-structure)
+(export env-create-account-structure-alist)
 (export env-expense-account-structure)
 
 (export pattern-streamer)
@@ -235,6 +237,15 @@
 			 options
 			 account-structure)))
 
+(define (env-create-account-structure-alist env account-structure)
+  (let ((accounts (env-create-account-structure env account-structure)))
+    (define (flatten l)
+      (if (null? l) '()
+	  (if (not (pair? l)) (list l)
+	      (append (flatten (car l)) (flatten (cdr l))))))
+    (map (lambda (acct) (cons (xaccAccountGetName acct) acct))
+	 (flatten accounts))))
+
 (define (env-expense-account-structure env)
   (env-create-account-structure
    env
@@ -247,6 +258,15 @@
 	       (list "Parking")
 	       (list "Petrol")))))
 
+(define (env-create-test-accounts env)
+  (env-create-account-structure-alist env
+				      (list "Root"
+					    (list (cons 'type ACCT-TYPE-ASSET))
+					    (list "Bank")
+					    (list "Wallet")
+					    (list "Other")
+					    (list "Expenses"
+						  (list (cons 'type ACCT-TYPE-EXPENSE))))))
 ;; Date sequences
 ;;
 

src/report/report-system/test/test-split.scm

@@ -0,0 +1,33 @@
+(use-modules (gnucash gnc-module))
+(use-modules (srfi srfi-1))
+
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+
+(use-modules (gnucash report report-system split))
+(use-modules (gnucash report report-system test test-extras))
+
+(use-modules (gnucash report report-system))
+
+(define (run-test)
+  (test test-split-in-list?))
+
+(define (test-split-in-list?)
+  (let* ((env (create-test-env))
+	 (today (gnc:date->timepair (localtime (current-time))))
+	 (account-alist (env-create-test-accounts env))
+	 (bank-account (cdr (assoc "Bank" account-alist)))
+	 (expense-account (cdr (assoc "Expenses" account-alist)))
+	 (wallet-account (cdr (assoc "Wallet" account-alist)))
+	 (tx1 (env-create-transaction env today bank-account wallet-account (gnc:make-gnc-numeric 20 1)))
+	 (tx2 (env-create-transaction env today bank-account expense-account (gnc:make-gnc-numeric 10 1)))
+	 (splits-tx1 (xaccTransGetSplitList tx1))
+	 (splits-tx2 (xaccTransGetSplitList tx2)))
+    (and (split-in-list? (first splits-tx1) splits-tx1)
+	 (split-in-list? (second splits-tx1) splits-tx1)
+	 (not (split-in-list? (first splits-tx1) splits-tx2))
+	 (not (split-in-list? (second splits-tx1) splits-tx2))
+	 (not (split-in-list? (first splits-tx1) '())))))
+
+							   
+
+  

src/report/standard-reports/budget.scm

@@ -31,6 +31,8 @@
 (use-modules (gnucash gettext))
 
 (use-modules (gnucash printf))
+(use-modules (gnucash report report-system account))
+(use-modules (gnucash report report-system split))
 
 (gnc:module-load "gnucash/report/report-system" 0)
 (gnc:module-load "gnucash/gnome-utils" 0) ;for gnc-build-url
@@ -557,47 +559,6 @@
          ;;(txt (gnc:make-html-text))
          )
 
-    ;; is account in list of accounts?
-    (define (same-account? a1 a2)
-      (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
-
-    (define (same-split? s1 s2)
-      (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
-
-    (define account-in-list?
-      (lambda (account accounts)
-        (cond
-          ((null? accounts) #f)
-          ((same-account? (car accounts) account) #t)
-          (else (account-in-list? account (cdr accounts))))))
-
-    (define split-in-list?
-      (lambda (split splits)
-    (cond
-     ((null? splits) #f)
-     ((same-split? (car splits) split) #t)
-     (else (split-in-list? split (cdr splits))))))
-
-    (define account-in-alist
-      (lambda (account alist)
-        (cond
-       ((null? alist) #f)
-           ((same-account? (caar alist) account) (car alist))
-           (else (account-in-alist account (cdr alist))))))
-
-    ;; helper for sorting of account list
-    (define (account-full-name<? a b)
-      (string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
-
-    ;; helper for account depth
-    (define (accounts-get-children-depth accounts)
-      (apply max
-         (map (lambda (acct)
-            (let ((children (gnc-account-get-children acct)))
-              (if (null? children)
-              1
-              (+ 1 (accounts-get-children-depth children)))))
-          accounts)))
     ;; end of defines
 
     ;; add subaccounts if requested

src/report/standard-reports/cash-flow.scm

@@ -31,6 +31,8 @@
 (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
 (use-modules (gnucash gnc-module))
 (use-modules (gnucash gettext))
+(use-modules (gnucash report report-system account))
+(use-modules (gnucash report report-system split))
 
 (use-modules (gnucash printf))
 
@@ -158,47 +160,6 @@
          (table (gnc:make-html-table))
          (txt (gnc:make-html-text)))
 
-    ;; is account in list of accounts?
-    (define (same-account? a1 a2)
-      (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
-
-    (define (same-split? s1 s2) 
-      (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
-
-    (define account-in-list?
-      (lambda (account accounts)
-        (cond
-          ((null? accounts) #f)
-          ((same-account? (car accounts) account) #t)
-          (else (account-in-list? account (cdr accounts))))))
-
-    (define split-in-list? 
-      (lambda (split splits)
-	(cond 
-	 ((null? splits) #f)
-	 ((same-split? (car splits) split) #t)
-	 (else (split-in-list? split (cdr splits))))))
-
-    (define account-in-alist
-      (lambda (account alist)
-        (cond
-	   ((null? alist) #f)
-           ((same-account? (caar alist) account) (car alist))
-           (else (account-in-alist account (cdr alist))))))
-
-    ;; helper for sorting of account list
-    (define (account-full-name<? a b)
-      (string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
-
-    ;; return maximum depth over accounts and their children, if any
-    (define (accounts-get-children-depth accounts)
-      (apply max
-	     (map (lambda (acct)
-		    (let ((acct-depth (gnc-account-get-current-depth acct)))
-		      (+ acct-depth (- (gnc-account-get-tree-depth acct) 1))))
-		  accounts)))
-
-
     (gnc:html-document-set-title! 
      doc (string-append
 	  (get-option gnc:pagename-general gnc:optname-reportname)