a number of nice fixes.
This commit is contained in:
@@ -201,8 +201,108 @@
|
||||
(catch Exception e
|
||||
(log/error e)))))
|
||||
|
||||
(mount/defstate reconciliation-frequency :start 60000)
|
||||
(mount/defstate reconciliation-frequency :start (* 1000 60 60))
|
||||
|
||||
(mount/defstate ledger-reconciliation-worker
|
||||
:start (scheduler/every reconciliation-frequency reconcile-ledger)
|
||||
:stop (scheduler/stop ledger-reconciliation-worker))
|
||||
|
||||
|
||||
(defn touch-transaction [e]
|
||||
@(d/transact conn [[:db/retractEntity [:journal-entry/original-entity e]]])
|
||||
@(d/transact conn [{:db/id "datomic.tx"
|
||||
:db/doc "touching transaction to update ledger"}
|
||||
(entity-change->ledger (d/db conn)
|
||||
[:transaction e])]))
|
||||
|
||||
(defn touch-invoice [e]
|
||||
@(d/transact conn [[:db/retractEntity [:journal-entry/original-entity e]]])
|
||||
@(d/transact conn [{:db/id "datomic.tx"
|
||||
:db/doc "touching invoice to update ledger"}
|
||||
(entity-change->ledger (d/db conn)
|
||||
[:invoice e])]))
|
||||
(defn mismatched-transactions []
|
||||
(let [jel-accounts (reduce
|
||||
(fn [acc [e lia]]
|
||||
(update acc e (fnil conj #{} ) lia))
|
||||
{}
|
||||
(d/query {:query {:find ['?e '?lia]
|
||||
:in ['$]
|
||||
:where ['[?je :journal-entry/line-items ?li]
|
||||
'[?je :journal-entry/original-entity ?e]
|
||||
'[?li :journal-entry-line/account ?lia]
|
||||
'[?lia :account/name]]}
|
||||
:args [(d/db auto-ap.datomic/conn)]}))
|
||||
transaction-accounts (reduce
|
||||
(fn [acc [e lia]]
|
||||
(update acc e (fnil conj #{} ) lia))
|
||||
{}
|
||||
(d/query {:query {:find ['?e '?lia]
|
||||
:in ['$]
|
||||
:where ['[?e :transaction/accounts ?li]
|
||||
'(not [?e :transaction/approval-status :transaction-approval-status/excluded])
|
||||
'[?li :transaction-account/account ?lia]
|
||||
|
||||
'[?lia :account/name]]}
|
||||
:args [(d/db auto-ap.datomic/conn)]}))
|
||||
]
|
||||
(filter
|
||||
(fn [[e accounts]] (not= accounts (get jel-accounts e)))
|
||||
transaction-accounts)))
|
||||
|
||||
(defn mismatched-invoices []
|
||||
(let [jel-accounts (reduce
|
||||
(fn [acc [e lia]]
|
||||
(update acc e (fnil conj #{} ) lia))
|
||||
{}
|
||||
(d/query {:query {:find ['?e '?lia]
|
||||
:in ['$]
|
||||
:where ['[?je :journal-entry/line-items ?li]
|
||||
'[?je :journal-entry/original-entity ?e]
|
||||
'[?li :journal-entry-line/account ?lia]
|
||||
'(not [?lia :account/numeric-code 21000])
|
||||
'[?lia :account/name]]}
|
||||
:args [(d/db auto-ap.datomic/conn)]}))
|
||||
invoice-accounts (reduce
|
||||
(fn [acc [e lia]]
|
||||
(update acc e (fnil conj #{} ) lia))
|
||||
{}
|
||||
(d/query {:query {:find ['?e '?lia]
|
||||
:in ['$]
|
||||
:where ['[?e :invoice/expense-accounts ?li]
|
||||
'[?li :invoice-expense-account/account ?lia]
|
||||
'[?lia :account/name]
|
||||
'(not [?lia :account/numeric-code 21000])
|
||||
'(not [?e :invoice/status :invoice-status/voided])
|
||||
'(not [?e :invoice/exclude-from-ledger true])
|
||||
'[?e :invoice/import-status :import-status/imported]]}
|
||||
:args [(d/db auto-ap.datomic/conn)]}))
|
||||
]
|
||||
(filter
|
||||
(fn [[e accounts]] (not= accounts (get jel-accounts e)))
|
||||
invoice-accounts)))
|
||||
|
||||
(defn touch-broken-ledger []
|
||||
(lc/with-context {:source "touch-broken-ledger"}
|
||||
(try
|
||||
(log/info "Attempting to fix transactions that are in the ledger but are wrong")
|
||||
(let [mismatched-ts (mismatched-transactions)]
|
||||
(if (seq mismatched-ts)
|
||||
(do
|
||||
(log/warn (count mismatched-ts) " transactions exist but don't match ledger ")
|
||||
(doseq [[m] mismatched-ts]
|
||||
(touch-transaction m)))))
|
||||
(log/info "Finished fixing transactions that are in the ledger but are wrong")
|
||||
(let [mismatched-is (mismatched-invoices)]
|
||||
(if (seq mismatched-is)
|
||||
(do
|
||||
(log/warn (count mismatched-is) " invoice exist but don't match ledger ")
|
||||
(doseq [[m] mismatched-is]
|
||||
(touch-invoice m)))))
|
||||
(log/info "Finished fixing invoices that are in the ledger but are wrong")
|
||||
(catch Exception e
|
||||
(log/error e)))))
|
||||
|
||||
(mount/defstate touch-broken-ledger-worker
|
||||
:start (scheduler/every reconciliation-frequency touch-broken-ledger)
|
||||
:stop (scheduler/stop touch-broken-ledger-worker))
|
||||
|
||||
Reference in New Issue
Block a user