Skip to content

Commit

Permalink
new columns, better reconciliation
Browse files Browse the repository at this point in the history
  • Loading branch information
@gknauth
gknauth committed Nov 28, 2017
1 parent 9ba1faf commit 2899f71
Show file tree
Hide file tree
Showing 5 changed files with 169 additions and 87 deletions.
3 changes: 3 additions & 0 deletions data/ledger-example
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
(170101 %a00 0.00 (x tbd) (x tbd) ("-*- mode: racket -*-"))
(170101 %b-chk-bf 123.45 (a chk) (e tbd) ("Bank of GNU" "balance forward 20161231"))
(170101 %b-sav-bf 543.21 (a sav) (e tbd) ("Bank of GNU" "balance forward 20161231"))
0 ledger-dbaccess-example.rkt → examples/ledger-dbaccess-example.rkt
View file
File renamed without changes.
0 ledger-prefs-example.rkt → examples/ledger-prefs-example.rkt
View file
File renamed without changes.
20 changes: 13 additions & 7 deletions main.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@

(define cols (vector "acct" "date" "book" "ext" "(- ext book)"
"stmt" "stmt-bal" "sync"
"new-dr" "new-cr" "reconciliation"))
"new-dr" "new-cr" "reconciliation" "more-seen" "should-match"))
(define rows (list->vector (cons empty accounts-to-show)))
(define cells (make-vector (* (vector-length cols) (vector-length rows))))

Expand Down Expand Up @@ -74,6 +74,8 @@
(let ([bals (get-statement-balances acct)])
(hash-set! all-stmt-bals acct bals))))))

(define std-col-width 60)

(define (setup-cells)
(for ([row (in-range (vector-length rows))])
(let ([acct (vector-ref rows row)])
Expand All @@ -83,15 +85,15 @@
(new message%
(parent table-panel)
(label (vector-ref cols col))
(min-width 100))
(min-width std-col-width))
(cond [(= col (col-name-index "stmt")) (new combo-field%
(parent table-panel)
(label "")
(choices (reverse (map (λ (x) (number->string (first x)))
(hash-ref all-stmt-bals acct))))
(callback (λ (t e)
(stmt-date-changed t e row)))
(min-width 100))]
(min-width std-col-width))]
[(= col (col-name-index "sync")) (new button%
(label "◀")
(parent table-panel)
Expand Down Expand Up @@ -164,7 +166,12 @@
(format-exact new-cr 2))
(when (not (string=? s-stmt-bal "n/a"))
(send (vector-ref cells (ij-s row "reconciliation")) set-value
(format-exact reconciliation 2)))))))
(format-exact reconciliation 2))
(let ([more-seen (sum-ledger-items acct (filtered-unmatched-ledger-items acct stmt-ymd8))])
(send (vector-ref cells (ij-s row "more-seen")) set-value
(format-exact more-seen 2))
(send (vector-ref cells (ij-s row "should-match")) set-value
(format-exact (+ reconciliation more-seen) 2))))))))

(define (update-date-book-ext-diff row)
(let* ([acct (vector-ref rows row)]
Expand All @@ -185,9 +192,8 @@
(let ([bal (get-bal-for-date acct-date-bals (string->number s-which-stmt-date))])
(if bal (format-exact bal 2) "n/a"))
""))
(send (vector-ref cells (ij-s row "new-cr")) set-value "")
(send (vector-ref cells (ij-s row "new-dr")) set-value "")
(send (vector-ref cells (ij-s row "reconciliation")) set-value "")))
(for/list ([colname (list "new-cr" "new-dr" "reconciliation" "more-seen" "should-match")])
(send (vector-ref cells (ij-s row colname)) set-value ""))))

(define (get-bal-for-date date-bals ymd8)
(cond [(null? date-bals) #f]
Expand Down
233 changes: 153 additions & 80 deletions reconciliation.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,6 @@
#:password db-passwd
#:port db-port))

(define today (today->ymd8))

(define (sub-false-for-sql-null x)
(if (sql-null? x) #f x))

Expand Down Expand Up @@ -146,66 +144,66 @@
ledger-items))

(define (statement<=ymd8 ymd8 statement-items)
(filter (λ (srow) (<= (statement-item-date srow) ymd8)) statement-items))
(filter (λ (si) (<= (statement-item-date si) ymd8)) statement-items))

(define (statement>=ymd8 ymd8 statement-items)
(filter (λ (srow) (>= (statement-item-date srow) ymd8)) statement-items))
(filter (λ (si) (>= (statement-item-date si) ymd8)) statement-items))

(define (statement-range ymd8-a ymd8-b statement-items)
(filter (λ (srow)
(and (>= (statement-item-date srow) ymd8-a) (<= (statement-item-date srow) ymd8-b)))
(filter (λ (si)
(and (>= (statement-item-date si) ymd8-a) (<= (statement-item-date si) ymd8-b)))
statement-items))

(define (ledger<=ymd8 ymd8 lst)
(filter (λ (lrow) (<= (ledger-item-date lrow) ymd8)) lst))
(define (ledger<=ymd8 ymd8 ledger-items)
(filter (λ (li) (<= (ledger-item-date li) ymd8)) ledger-items))

(define (ledger>=ymd8 ymd8 lst)
(filter (λ (lrow) (>= (ledger-item-date lrow) ymd8)) lst))
(define (ledger>=ymd8 ymd8 ledger-items)
(filter (λ (li) (>= (ledger-item-date li) ymd8)) ledger-items))

(define (ledger-range ymd8-a ymd8-b lst)
(filter (λ (lrow)
(and (>= (ledger-item-date lrow) ymd8-a) (<= (ledger-item-date lrow) ymd8-b)))
lst))
(define (ledger-range ymd8-a ymd8-b ledger-items)
(filter (λ (li)
(and (>= (ledger-item-date li) ymd8-a) (<= (ledger-item-date li) ymd8-b)))
ledger-items))

(define (ledger-range-acct acct ymd8-a ymd8-b lst)
(filter (λ (lrow)
(or (string=? acct (ledger-item-dr-acct lrow))
(string=? acct (ledger-item-cr-acct lrow))))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct lst))))
(define (ledger-range-acct acct ymd8-a ymd8-b ledger-items)
(filter (λ (li)
(or (string=? acct (ledger-item-dr-acct li))
(string=? acct (ledger-item-cr-acct li))))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct ledger-items))))

(define (ledger-range-acct-dr acct ymd8-a ymd8-b lst)
(filter (λ (lrow)
(string=? acct (ledger-item-dr-acct lrow)))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct lst))))
(define (ledger-range-acct-dr acct ymd8-a ymd8-b ledger-items)
(filter (λ (li)
(string=? acct (ledger-item-dr-acct li)))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct ledger-items))))

(define (ledger-range-acct-cr acct ymd8-a ymd8-b lst)
(filter (λ (lrow)
(string=? acct (ledger-item-cr-acct lrow)))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct lst))))
(define (ledger-range-acct-cr acct ymd8-a ymd8-b ledger-items)
(filter (λ (li)
(string=? acct (ledger-item-cr-acct li)))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct ledger-items))))

(define (ledger-range-signed-amounts acct ymd8-a ymd8-b lst)
(map (λ (lrow)
(ledger-signed-amount acct lrow))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct lst))))
(define (ledger-range-signed-amounts acct ymd8-a ymd8-b ledger-items)
(map (λ (li)
(ledger-signed-amount acct li))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct ledger-items))))

(define (ledger-range-signed-amounts-seen acct ymd8-a ymd8-b lst)
(map (λ (lrow)
(ledger-signed-amount-seen acct lrow))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct lst))))
(define (ledger-range-signed-amounts-seen acct ymd8-a ymd8-b ledger-items)
(map (λ (li)
(ledger-signed-amount-seen acct li))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct ledger-items))))

(define (ledger-range-signed-amounts-unseen acct ymd8-a ymd8-b lst)
(map (λ (lrow)
(ledger-signed-amount-unseen acct lrow))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct lst))))
(define (ledger-range-signed-amounts-unseen acct ymd8-a ymd8-b ledger-items)
(map (λ (li)
(ledger-signed-amount-unseen acct li))
(ledger-range ymd8-a ymd8-b (ledger-filter-acct acct ledger-items))))

(define (sum-ledger-range-signed-amounts acct ymd8-a ymd8-b lst)
(foldl + 0 (ledger-range-signed-amounts acct ymd8-a ymd8-b lst)))
(define (sum-ledger-range-signed-amounts acct ymd8-a ymd8-b ledger-items)
(foldl + 0 (ledger-range-signed-amounts acct ymd8-a ymd8-b ledger-items)))

(define (sum-ledger-range-signed-amounts-seen acct ymd8-a ymd8-b lst)
(foldl + 0 (ledger-range-signed-amounts-seen acct ymd8-a ymd8-b lst)))
(define (sum-ledger-range-signed-amounts-seen acct ymd8-a ymd8-b ledger-items)
(foldl + 0 (ledger-range-signed-amounts-seen acct ymd8-a ymd8-b ledger-items)))

(define (sum-ledger-range-signed-amounts-unseen acct ymd8-a ymd8-b lst)
(foldl + 0 (ledger-range-signed-amounts-unseen acct ymd8-a ymd8-b lst)))
(define (sum-ledger-range-signed-amounts-unseen acct ymd8-a ymd8-b ledger-items)
(foldl + 0 (ledger-range-signed-amounts-unseen acct ymd8-a ymd8-b ledger-items)))

(define (ledger-amount-dr acct a-ledger-item)
(if (string=? acct (ledger-item-dr-acct a-ledger-item))
Expand Down Expand Up @@ -235,10 +233,10 @@
(ledger-item-amount a-ledger-item)
0))

(define (ledger-amount-cr-unseen acct lrow)
(if (and (not (ledger-item-cr-seen lrow))
(string=? acct (ledger-item-cr-acct lrow)))
(ledger-item-amount lrow)
(define (ledger-amount-cr-unseen acct a-ledger-item)
(if (and (not (ledger-item-cr-seen a-ledger-item))
(string=? acct (ledger-item-cr-acct a-ledger-item)))
(ledger-item-amount a-ledger-item)
0))

(define (ledger-signed-amount acct a-ledger-item)
Expand Down Expand Up @@ -278,8 +276,8 @@
(define (get-ledger-bal-items acct)
(get-ledger-bal-items-from acct all-ledger-items 0 0))

(define (get-ledger-bal-items-from acct
ledger-items starting-balance starting-balance-seen)
(define (get-ledger-bal-items-from
acct ledger-items starting-balance starting-balance-seen)
(define (helper ins outs running-balance running-balance-seen)
(if (empty? ins)
outs
Expand Down Expand Up @@ -360,66 +358,141 @@
[(= mask 5) 'acct-cr-matches]
[else false])))

; Smonth==11 and num(Ldr-tag)==(+ 11 (* 12 (- statement-year ledger-year)))
(define (does-ledger-tag-match-statement acct ymd8-statement lrow acct-amount-match)
; eg: Smonth==11 and num(Ldr-tag)==(+ 11 (* 12 (- statement-year ledger-year)))
(define (does-ledger-tag-match-statement acct ymd8-statement a-ledger-item acct-amount-match)
(let* ([statement-year (quotient ymd8-statement 10000)]
[statement-month (quotient (remainder ymd8-statement 10000) 100)]
[ledger-item-year (quotient (ledger-item-date lrow) 10000)]
[ledger-item-month (quotient (remainder (ledger-item-date lrow) 10000) 100)]
[ledger-item-year (quotient (ledger-item-date a-ledger-item) 10000)]
[ledger-item-month (quotient (remainder (ledger-item-date a-ledger-item) 10000) 100)]
[expected-ledger-tag (+ statement-month (* 12 (- statement-year ledger-item-year)))]
[s-expected-ledger-tag (fmt-i-02d expected-ledger-tag)]
[signed-amount (ledger-signed-amount acct lrow)]
[signed-amount (ledger-signed-amount acct a-ledger-item)]
[actual-ledger-tag
(cond [(symbol=? acct-amount-match 'acct-amount-dr-and-cr-match)
(cond [(< signed-amount 0) (ledger-item-cr-seen lrow)]
[(> signed-amount 0) (ledger-item-dr-seen lrow)]
[else (let ([ctag (ledger-item-cr-seen lrow)]
[dtag (ledger-item-dr-seen lrow)])
(cond [(< signed-amount 0) (ledger-item-cr-seen a-ledger-item)]
[(> signed-amount 0) (ledger-item-dr-seen a-ledger-item)]
[else (let ([ctag (ledger-item-cr-seen a-ledger-item)]
[dtag (ledger-item-dr-seen a-ledger-item)])
(if (string? ctag)
(if (string? dtag)
(if (string=? ctag dtag)
ctag
false)
(error "do-ledger-statement-tags-match: No? ~a ~a [~a] ~a"
(ledger-item-date lrow)
(ledger-item-date a-ledger-item)
(format-float (exact->inexact signed-amount 2))
dtag ctag))
(error "do-ledger-statement-tags-match: No? ~a ~a ~a [~a]"
(ledger-item-date lrow)
(ledger-item-date a-ledger-item)
(format-float (exact->inexact signed-amount 2))
dtag ctag)))])]
[(symbol=? acct-amount-match 'acct-amount-dr-matches) (ledger-item-dr-seen lrow)]
[(symbol=? acct-amount-match 'acct-amount-cr-matches) (ledger-item-cr-seen lrow)]
[(symbol=? acct-amount-match 'acct-amount-dr-matches) (ledger-item-dr-seen a-ledger-item)]
[(symbol=? acct-amount-match 'acct-amount-cr-matches) (ledger-item-cr-seen a-ledger-item)]
[else false])])
(and (string? actual-ledger-tag) (string=? actual-ledger-tag s-expected-ledger-tag))))

(define (appropriate-ledger-item-seen-tag acct a-ledger-item)
(let ([signed-amount (ledger-signed-amount acct a-ledger-item)])
(cond [(< signed-amount 0) (ledger-item-cr-seen a-ledger-item)]
[(> signed-amount 0) (ledger-item-dr-seen a-ledger-item)]
[else (let ([ctag (ledger-item-cr-seen a-ledger-item)]
[dtag (ledger-item-dr-seen a-ledger-item)])
(if (equal? ctag dtag)
ctag
false))])))

(define std-skip-tags (list "bf" "v"))

(define (sum-ledger-items acct ledger-items)
(foldl + 0 (map (λ (li) (ledger-signed-amount acct li)) ledger-items)))

(define (pr-ledger-items acct ledger-items)
(for-each (λ (li) (pr-ledger-item acct li)) ledger-items))

(define (pr-filtered-unmatched-ledger-items acct ymd8-end)
(pr-ledger-items acct (filtered-unmatched-ledger-items acct ymd8-end)))

(define (filtered-unmatched-ledger-items acct ymd8-end)
(let* ([a (unmatched-ledger-items-to-date acct ymd8-end)]
[b (ledger-items-exclude-tags std-skip-tags acct a)]
[c (ledger-items-exclude-prior-matches acct ymd8-end b)])
c))

(define (year-month ymd8)
(let ([yyyy (quotient ymd8 10000)]
[mm (quotient (remainder ymd8 10000) 100)])
(+ (* 100 yyyy) mm)))

(define (effective-year-month ymd8 tag-month)
; 2017mmdd 01 -> 201701
; 2016mmdd 13 -> 201701
; 2015mmdd 25 -> 201701
(let-values ([(quo rem) (quotient/remainder tag-month 12)])
(+ (* 100 (+ (quotient ymd8 10000) (* quo))) rem)))

(define (compare-year-months a b)
(cond [(< a b) -1]
[(= a b) 0]
[(> a b) 1]))

(define (ledger-items-exclude-prior-matches acct ymd8-end ledger-items)
(filter (λ (a-ledger-item)
(not (is-prior-month-match acct ymd8-end a-ledger-item)))
ledger-items))

(define (is-prior-month-match acct ymd8-end a-ledger-item)
(let ([yyyymm-current (year-month ymd8-end)]) ; eg, 201602
(let* ([yyyymmdd-li (ledger-item-date a-ledger-item)] ; eg, 20160115
[yyyymm-li (year-month (ledger-item-date a-ledger-item))] ; eg, 201601
[tag (appropriate-ledger-item-seen-tag acct a-ledger-item)]) ; eg, "01"
(if (number? (string->number tag))
(< (effective-year-month yyyymmdd-li (string->number tag)) yyyymm-current)
false))))

(define (ledger-items-exclude-tags tags-to-exclude acct ledger-items)
(filter (λ (li)
(not (member (if (> (ledger-signed-amount acct li) 0)
(ledger-item-dr-seen li)
(ledger-item-cr-seen li))
tags-to-exclude)))
ledger-items))

(define (unmatched-ledger-items-to-date acct ymd8-end)
(let-values ([(statement-unmatched ledger-unmatched) (examine-acct acct ymd8-end)])
(map (λ (x)
(send x get-item))
ledger-unmatched)))

(define (pr-examine-acct acct ymd8-end)
(let-values ([(statement-unmatched ledger-unmatched) (examine-acct acct ymd8-end)])
(printf "====== Statement items not in ledger:\n")
(for-each (λ (x)
(let ([srow (send x get-item)])
(printf "~a ~a ~a\n" (statement-item-date srow)
(let ([si (send x get-item)])
(printf "~a ~a ~a\n" (statement-item-date si)
(~a (format-float
(exact->inexact (statement-item-amount srow)) 2)
(exact->inexact (statement-item-amount si)) 2)
#:min-width 9 #:align 'right)
(statement-item-description srow))))
(statement-item-description si))))
statement-unmatched)
(printf "\n====== Ledger items not in loaded statements:\n")
(for-each (λ (x)
(let ([lrow (send x get-item)])
(printf "~a ~a ~a ~a / ~a\n"
(ledger-item-date lrow)
(~a (format-float
(exact->inexact (ledger-signed-amount acct lrow)) 2)
#:min-width 9 #:align 'right)
(~a (if (> (ledger-signed-amount acct lrow) 0)
(ledger-item-dr-seen lrow)
(ledger-item-cr-seen lrow))
#:min-width 2 #:align 'left)
(ledger-item-payee lrow)
(ledger-item-description lrow))))
(let ([li (send x get-item)])
(pr-ledger-item acct li)))
ledger-unmatched)))

(define (pr-ledger-item acct li)
(printf "~a ~a ~a ~a / ~a\n"
(ledger-item-date li)
(~a (format-float
(exact->inexact (ledger-signed-amount acct li)) 2)
#:min-width 9 #:align 'right)
(~a (if (> (ledger-signed-amount acct li) 0)
(ledger-item-dr-seen li)
(ledger-item-cr-seen li))
#:min-width 2 #:align 'left)
(ledger-item-payee li)
(ledger-item-description li)))

(define (examine-acct acct ymd8-end)
(let* ([statement-acct-items (statement-filter-acct acct (statement-range jan01 ymd8-end all-statement-items))]
[ledger-acct-items (ledger-filter-acct acct (ledger-range jan01 ymd8-end all-ledger-items))]
Expand Down

0 comments on commit 2899f71

Please sign in to comment.