Skip to content

Commit

Permalink
move more to TR, more tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@jbclements
jbclements committed Jul 2, 2018
1 parent c175159 commit 6dbe1ea
Show file tree
Hide file tree
Showing 3 changed files with 143 additions and 29 deletions.
106 changes: 101 additions & 5 deletions gnucash/examples/example.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,9 +47,105 @@
(net t (list checking-account-id) dollars)))
my-transactions))

(require rackunit)
;; regression test:
(check-equal?
(length (year->transactions 2007 transactions))
7)
(define checking-account
(find-account/prefix
'("Root Account" "Assets" "Current Assets" "Checking Account")
accounts))

(map (compose (curryr account-name-path accounts)
(curryr id->account accounts)
split-account
second)
(all-splits (first transactions)))

(module+ test

(require rackunit
srfi/19)
;; regression test:
(check-equal?
(length (year->transactions 2007 transactions))
7)

;; regression test:
(check-equal?
(take (apply append (map all-splits transactions))
6)
(list
(list
(make-time 'time-utc 0 1170144000)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "9374fea23a266b1ee6162c1c6f02cb77")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "100000/100")
(http://www.gnucash.org/XML/split:quantity "100000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "ae3cb692a4101e744f4ff021896178a8")))
(list
(make-time 'time-utc 0 1170144000)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "f59e16783fa01fd3cc60d9f4c06f082e")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "-100000/100")
(http://www.gnucash.org/XML/split:quantity "-100000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "679a80e5250a3d31670f64d8224d7a88")))
(list
(make-time 'time-utc 0 1172822400)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "f2e57c66fc214622acf9428c06b8807c")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "100000/100")
(http://www.gnucash.org/XML/split:quantity "100000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "ae3cb692a4101e744f4ff021896178a8")))
(list
(make-time 'time-utc 0 1172822400)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "ce2ca00fad0ad55a5ba05dba6da8fec1")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "-100000/100")
(http://www.gnucash.org/XML/split:quantity "-100000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "679a80e5250a3d31670f64d8224d7a88")))
(list
(make-time 'time-utc 0 1172995200)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "78d96a5fcc8ea3eb92a8679556d75b48")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "20000/100")
(http://www.gnucash.org/XML/split:quantity "20000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "5ae3bbafcf214a8b482ad01e13b7b922")))
(list
(make-time 'time-utc 0 1172995200)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "cc9f79157b32d8d80a6932992b9302ff")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "-20000/100")
(http://www.gnucash.org/XML/split:quantity "-20000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "ae3cb692a4101e744f4ff021896178a8"))))
16)

;; regression:
(check-equal?
(list->set (group-by-account (all-splits (first transactions))))
(set
(list
"679a80e5250a3d31670f64d8224d7a88"
(list
(list
(make-time 'time-utc 0 1170144000)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "f59e16783fa01fd3cc60d9f4c06f082e")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "-100000/100")
(http://www.gnucash.org/XML/split:quantity "-100000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "679a80e5250a3d31670f64d8224d7a88")))))
(list
"ae3cb692a4101e744f4ff021896178a8"
(list
(list
(make-time 'time-utc 0 1170144000)
'(http://www.gnucash.org/XML/trn:split
(http://www.gnucash.org/XML/split:id (@ (type "guid")) "9374fea23a266b1ee6162c1c6f02cb77")
(http://www.gnucash.org/XML/split:reconciled-state "n")
(http://www.gnucash.org/XML/split:value "100000/100")
(http://www.gnucash.org/XML/split:quantity "100000/100")
(http://www.gnucash.org/XML/split:account (@ (type "guid")) "ae3cb692a4101e744f4ff021896178a8"))))))))

24 changes: 0 additions & 24 deletions gnucash/libs.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,12 +32,9 @@

;; this provide is way too coarse, but I can't be bothered to fix it.
(provide (except-out (all-defined-out)
all-splits
group-by-account
account-group->dataset)
(contract-out
[all-splits (-> transaction?
splitlist/c)]
[group-by-account (-> splitlist/c
(listof
(list/c id-string?
Expand Down Expand Up @@ -71,22 +68,7 @@



;; find accounts whose name path starts with the given prefix
(define (find-account/prefix name-path accounts)
(filter (lambda (acct) (prefix? name-path (account-name-path acct accounts)))
accounts))

;; list list -> boolean
(define (prefix? a b)
(match (list a b)
[(list (list) any) #t]
[(list (cons a arest) (cons b brest)) (and (equal? a b) (prefix? arest brest))]
[else #f]))

(check-true (prefix? `() `()))
(check-true (prefix? `(a) `(a)))
(check-false (prefix? `(a b) `(a c)))
(check-true (prefix? `(a b c) `(a b c d)))

;; date date -> (transaction -> boolean)
(define (make-date-filter start end)
Expand Down Expand Up @@ -130,12 +112,6 @@
[date (transaction-date transaction)]
[externals (filter (lambda (s) (not (member (split-account s) account-ids))) splits)])
(map (lambda (split) (list (date->time-utc date) split)) externals)))

;; returns all the splits of the transaction
(define (all-splits transaction)
(let* ([splits (sxml:content (transaction-splits transaction))]
[date (transaction-date transaction)])
(map (lambda (split) (list (date->time-utc date) split)) splits)))

(define (print-transaction t)
(printf "~a\n" (date->string (transaction-date t)))
Expand Down
42 changes: 42 additions & 0 deletions gnucash/typed-libs.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,20 +9,27 @@

(require/typed srfi/19
[#:opaque date date?]
[#:opaque time time?]
[date->time-utc (date -> time)]
[string->date (String String -> date)])

(define-type Sxml (U String Symbol Number (Listof Sxml)))
(define-type Gnucash-Element (Pairof Symbol (Listof Sxml)))
(define-type Splitlist (Listof (List time Gnucash-Element)))

(define-predicate gnucash-element? Gnucash-Element)

;; migrating tiny bits from libs.rkt?

(provide gnucash-element-type
Gnucash-Element-Type
id->account
find-account
find-account/prefix
account-name-path
parsed->accounts
parsed->transactions
all-splits

book-id-tag
count-data-tag
Expand Down Expand Up @@ -133,6 +140,31 @@
(lambda () (format "no account named ~v" name-path))))


;; find accounts whose name path starts with the given prefix
(define (find-account/prefix [name-path : (Listof String)]
[accounts : (Listof Gnucash-Element)])
(filter (lambda ([acct : Gnucash-Element])
(prefix? name-path (account-name-path acct accounts)))
accounts))


;; list list -> boolean
;; is 'a' a prefix of 'b' ?
(: prefix? (All (T) ((Listof T) (Listof T) -> Boolean)))
(define (prefix? a b)
(match (list a b)
[(list (list) any) #t]
[(list (cons a arest) (cons b brest)) (and (equal? a b) (prefix? arest brest))]
[else #f]))

(module+ test
(require typed/rackunit)
(check-true (prefix? `() `()))
(check-true (prefix? `(a) `(a)))
(check-false (prefix? `(a b) `(a c)))
(check-true (prefix? `(a b c) `(a b c d))))


;; given a gnucash-element representing an account, return
;; a list of strings representing the name chain, e.g.
;; '("Root Account" "Assets" "Jewelry")
Expand Down Expand Up @@ -179,6 +211,16 @@
other)])]))



;; returns all the splits of the transaction
(define (all-splits [transaction : Gnucash-Element]) : Splitlist
(let* ([splits (sxml:content (transaction-splits transaction))]
[date (transaction-date transaction)])
(map (lambda ([split : Sxml])
(list (date->time-utc date) (assert split gnucash-element?)))
splits)))


;; return elt for lists of length one
(: oo (All (T) ((Listof T) -> T)))
(define oo
Expand Down

0 comments on commit 6dbe1ea

Please sign in to comment.