(cloud) makes ledger running balances fast and smooth
This commit is contained in:
@@ -1,26 +1,33 @@
|
||||
(ns auto-ap.graphql.ledger
|
||||
(:require
|
||||
[auto-ap.datomic
|
||||
:refer [audit-transact-batch conn pull-attr pull-many remove-nils]]
|
||||
:refer [audit-transact-batch conn pull-many remove-nils]]
|
||||
[auto-ap.datomic.accounts :as a]
|
||||
[auto-ap.datomic.clients :as d-clients]
|
||||
[auto-ap.datomic.ledger :as l]
|
||||
[auto-ap.time :as atime]
|
||||
[auto-ap.ledger.reports :as l-reports]
|
||||
[auto-ap.graphql.utils
|
||||
:refer [->graphql <-graphql assert-admin assert-can-see-client result->page attach-tracing-resolvers]]
|
||||
:refer [->graphql
|
||||
<-graphql
|
||||
assert-admin
|
||||
assert-can-see-client
|
||||
attach-tracing-resolvers
|
||||
result->page]]
|
||||
[auto-ap.ledger :refer [build-account-lookup]]
|
||||
[auto-ap.ledger.reports :as l-reports]
|
||||
[auto-ap.parse.util :as parse]
|
||||
[auto-ap.pdf.ledger :refer [print-balance-sheet print-pnl print-journal-detail-report]]
|
||||
[auto-ap.utils :refer [by dollars= heartbeat]]
|
||||
[auto-ap.pdf.ledger
|
||||
:refer [print-balance-sheet print-journal-detail-report print-pnl]]
|
||||
[auto-ap.time :as atime]
|
||||
[auto-ap.utils :refer [by dollars=]]
|
||||
[clj-time.coerce :as coerce]
|
||||
[clj-time.core :as t]
|
||||
[clojure.tools.logging :as log]
|
||||
[clojure.data.csv :as csv]
|
||||
[datomic.client.api :as dc]
|
||||
[mount.core :as mount]
|
||||
[clojure.tools.logging :as log]
|
||||
[com.brunobonacci.mulog :as mu]
|
||||
[yang.scheduler :as scheduler])
|
||||
(:import [org.apache.commons.codec.binary Base64]))
|
||||
[datomic.client.api :as dc]
|
||||
[iol-ion.tx :refer [upsert-ledger]])
|
||||
(:import
|
||||
(org.apache.commons.codec.binary Base64)))
|
||||
|
||||
(defn get-ledger-page [context args _]
|
||||
(let [args (assoc args :id (:id context))
|
||||
@@ -88,73 +95,35 @@
|
||||
(filter (fn [[d]]
|
||||
(if start-date
|
||||
(and
|
||||
(>= (compare d start-date) 0)
|
||||
(<= (compare d end-date) 0))
|
||||
(>= (compare d start-date) 0)
|
||||
(<= (compare d end-date) 0))
|
||||
(<= (compare d end-date) 0))))
|
||||
(reduce
|
||||
(fn [acc [_ _ account location debit credit]]
|
||||
(-> acc
|
||||
(update-in [[location account] :debit] (fnil + 0.0) debit)
|
||||
(update-in [[location account] :credit] (fnil + 0.0) credit)
|
||||
(update-in [[location account] :count] (fnil + 0) 1))
|
||||
)
|
||||
{})
|
||||
(fn [acc [_ _ account location debit credit]]
|
||||
(-> acc
|
||||
(update-in [[location account] :debit] (fnil + 0.0) debit)
|
||||
(update-in [[location account] :credit] (fnil + 0.0) credit)
|
||||
(update-in [[location account] :count] (fnil + 0) 1))
|
||||
)
|
||||
{})
|
||||
(reduce-kv
|
||||
(fn [acc [location account-id] {:keys [debit credit count]}]
|
||||
(let [account (lookup-account account-id)
|
||||
account-type (:account_type account)]
|
||||
|
||||
(conj acc (merge {:id (str account-id "-" location)
|
||||
:location (or location "")
|
||||
:count count
|
||||
:debits debit
|
||||
:credits credit
|
||||
:amount (if account-type (if (#{:account-type/asset
|
||||
:account-type/dividend
|
||||
:account-type/expense} account-type)
|
||||
(- debit credit)
|
||||
(- credit debit))
|
||||
0.0)}
|
||||
account)))
|
||||
)
|
||||
|
||||
[]))))
|
||||
|
||||
(defn build-account-lookup [client-id]
|
||||
(let [accounts (by :db/id (map first (dc/q {:query {:find ['(pull ?e [:db/id :account/name
|
||||
:account/numeric-code
|
||||
{:account/type [:db/ident]
|
||||
:account/client-overrides [:account-client-override/client :account-client-override/name]}
|
||||
])]
|
||||
:in ['$]
|
||||
:where ['[?e :account/name]]}
|
||||
:args [(dc/db conn )]})))
|
||||
|
||||
bank-accounts (by :db/id (map first (dc/q {:query {:find ['(pull ?e [:db/id :bank-account/name :bank-account/numeric-code {:bank-account/type [:db/ident]}])]
|
||||
:in ['$]
|
||||
:where ['[?e :bank-account/name]]}
|
||||
:args [(dc/db conn)]})))
|
||||
overrides-by-client (->> accounts
|
||||
vals
|
||||
(mapcat (fn [a]
|
||||
(map (fn [o]
|
||||
[[(:db/id a) (:db/id (:account-client-override/client o))]
|
||||
(:account-client-override/name o)])
|
||||
(:account/client-overrides a))
|
||||
) )
|
||||
(into {} ))]
|
||||
(fn [a]
|
||||
{:name (or (:bank-account/name (bank-accounts a))
|
||||
(overrides-by-client [a client-id])
|
||||
(:account/name (accounts a)))
|
||||
:account_type (or (:db/ident (:account/type (accounts a)))
|
||||
({:bank-account-type/check :account-type/asset
|
||||
:bank-account-type/cash :account-type/asset
|
||||
:bank-account-type/credit :account-type/liability}
|
||||
(:db/ident (:bank-account/type (bank-accounts a)))))
|
||||
:numeric_code (or (:account/numeric-code (accounts a))
|
||||
(:bank-account/numeric-code (bank-accounts a)))
|
||||
:client_id client-id})))
|
||||
(fn [acc [location account-id] {:keys [debit credit count]}]
|
||||
(let [account (lookup-account account-id)
|
||||
account-type (:account_type account)]
|
||||
|
||||
(conj acc (merge {:id (str account-id "-" location)
|
||||
:location (or location "")
|
||||
:count count
|
||||
:debits debit
|
||||
:credits credit
|
||||
:amount (if account-type (if (#{:account-type/asset
|
||||
:account-type/dividend
|
||||
:account-type/expense} account-type)
|
||||
(- debit credit)
|
||||
(- credit debit))
|
||||
0.0)}
|
||||
account))))
|
||||
[]))))
|
||||
|
||||
(defn full-ledger-for-client [client-id]
|
||||
(->> (dc/q
|
||||
@@ -371,69 +340,70 @@
|
||||
(assoc entry
|
||||
:status :success
|
||||
:tx
|
||||
(remove-nils
|
||||
{:journal-entry/source (:source entry)
|
||||
:journal-entry/client [:client/code (:client_code entry)]
|
||||
:journal-entry/date (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry)))
|
||||
:journal-entry/external-id (:external_id entry)
|
||||
:journal-entry/vendor (:db/id (all-vendors (:vendor_name entry)))
|
||||
:journal-entry/amount (:amount entry)
|
||||
:journal-entry/note (:note entry)
|
||||
:journal-entry/cleared-against (:cleared_against entry)
|
||||
`(upsert-ledger
|
||||
~(remove-nils
|
||||
{:journal-entry/source (:source entry)
|
||||
:journal-entry/client [:client/code (:client_code entry)]
|
||||
:journal-entry/date (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry)))
|
||||
:journal-entry/external-id (:external_id entry)
|
||||
:journal-entry/vendor (:db/id (all-vendors (:vendor_name entry)))
|
||||
:journal-entry/amount (:amount entry)
|
||||
:journal-entry/note (:note entry)
|
||||
:journal-entry/cleared-against (:cleared_against entry)
|
||||
|
||||
:journal-entry/line-items
|
||||
(mapv (fn [ea]
|
||||
(let [debit (or (:debit ea) 0.0)
|
||||
credit (or (:credit ea) 0.0)]
|
||||
(when (and (not (get
|
||||
(get all-client-locations (:client_code entry))
|
||||
(:location ea)))
|
||||
(not= "A" (:location ea)))
|
||||
(throw (ex-info (str "Location '" (:location ea) "' not found.")
|
||||
{:status :error})))
|
||||
(when (and (<= debit 0.0)
|
||||
(<= credit 0.0))
|
||||
(throw (ex-info (str "Line item amount " (or debit credit) " must be greater than 0.")
|
||||
{:status :error})))
|
||||
(when (and (not (all-accounts (:account_identifier ea)))
|
||||
(not (get
|
||||
(get all-client-bank-accounts (:client_code entry))
|
||||
(:account_identifier ea))))
|
||||
(throw (ex-info (str "Account '" (:account_identifier ea) "' not found.")
|
||||
{:status :error})))
|
||||
(let [matching-account (when (re-matches #"^[0-9]+$" (:account_identifier ea))
|
||||
(a/get-account-by-numeric-code-and-sets (Integer/parseInt (:account_identifier ea)) ["default"]))]
|
||||
(when (and matching-account
|
||||
(:account/location matching-account)
|
||||
(not= (:account/location matching-account)
|
||||
(:location ea)))
|
||||
(throw (ex-info (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' requires location '"
|
||||
(:account/location matching-account)
|
||||
"' but got '"
|
||||
(:location ea)
|
||||
"'")
|
||||
{:status :error})))
|
||||
(when (and matching-account
|
||||
(not (:account/location matching-account))
|
||||
(= "A" (:location ea)))
|
||||
(throw (ex-info (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' cannot use location '"
|
||||
(:location ea)
|
||||
"'")
|
||||
{:status :error})))
|
||||
(remove-nils (cond-> {:journal-entry-line/location (:location ea)
|
||||
:journal-entry-line/debit (when (> debit 0)
|
||||
debit)
|
||||
:journal-entry-line/credit (when (> credit 0)
|
||||
credit)}
|
||||
matching-account (assoc :journal-entry-line/account (:db/id matching-account))
|
||||
(not matching-account) (assoc :journal-entry-line/account [:bank-account/code (:account_identifier ea)]))))))
|
||||
(:line_items entry))
|
||||
|
||||
:journal-entry/cleared true})))))
|
||||
:journal-entry/line-items
|
||||
(mapv (fn [ea]
|
||||
(let [debit (or (:debit ea) 0.0)
|
||||
credit (or (:credit ea) 0.0)]
|
||||
(when (and (not (get
|
||||
(get all-client-locations (:client_code entry))
|
||||
(:location ea)))
|
||||
(not= "A" (:location ea)))
|
||||
(throw (ex-info (str "Location '" (:location ea) "' not found.")
|
||||
{:status :error})))
|
||||
(when (and (<= debit 0.0)
|
||||
(<= credit 0.0))
|
||||
(throw (ex-info (str "Line item amount " (or debit credit) " must be greater than 0.")
|
||||
{:status :error})))
|
||||
(when (and (not (all-accounts (:account_identifier ea)))
|
||||
(not (get
|
||||
(get all-client-bank-accounts (:client_code entry))
|
||||
(:account_identifier ea))))
|
||||
(throw (ex-info (str "Account '" (:account_identifier ea) "' not found.")
|
||||
{:status :error})))
|
||||
(let [matching-account (when (re-matches #"^[0-9]+$" (:account_identifier ea))
|
||||
(a/get-account-by-numeric-code-and-sets (Integer/parseInt (:account_identifier ea)) ["default"]))]
|
||||
(when (and matching-account
|
||||
(:account/location matching-account)
|
||||
(not= (:account/location matching-account)
|
||||
(:location ea)))
|
||||
(throw (ex-info (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' requires location '"
|
||||
(:account/location matching-account)
|
||||
"' but got '"
|
||||
(:location ea)
|
||||
"'")
|
||||
{:status :error})))
|
||||
(when (and matching-account
|
||||
(not (:account/location matching-account))
|
||||
(= "A" (:location ea)))
|
||||
(throw (ex-info (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' cannot use location '"
|
||||
(:location ea)
|
||||
"'")
|
||||
{:status :error})))
|
||||
(remove-nils (cond-> {:journal-entry-line/location (:location ea)
|
||||
:journal-entry-line/debit (when (> debit 0)
|
||||
debit)
|
||||
:journal-entry-line/credit (when (> credit 0)
|
||||
credit)}
|
||||
matching-account (assoc :journal-entry-line/account (:db/id matching-account))
|
||||
(not matching-account) (assoc :journal-entry-line/account [:bank-account/code (:account_identifier ea)]))))))
|
||||
(:line_items entry))
|
||||
|
||||
:journal-entry/cleared true}))))))
|
||||
(:entries args))))
|
||||
errors (filter #(= (:status %) :error) transaction)
|
||||
ignored (filter #(= (:status %) :ignored) transaction)
|
||||
@@ -473,122 +443,6 @@
|
||||
:errors (map (fn [x] {:external_id (:external_id x)
|
||||
:error (:error x)}) errors)}))
|
||||
|
||||
(defn accounts-needing-rebuild [ db client]
|
||||
(->> (dc/qseq '[:find ?c ?a ?l (min ?d)
|
||||
:in $ ?c
|
||||
:where [?je :journal-entry/client ?c]
|
||||
[?je :journal-entry/line-items ?jel]
|
||||
(or (not [?jel :journal-entry-line/running-balance])
|
||||
[?jel :journal-entry-line/dirty true])
|
||||
[?jel :journal-entry-line/account ?a]
|
||||
[?jel :journal-entry-line/location ?l]
|
||||
[?je :journal-entry/date ?d]]
|
||||
db
|
||||
client)
|
||||
(map (fn [[client account location starting-at ]]
|
||||
{:client client
|
||||
:account account
|
||||
:starting-at starting-at
|
||||
:location location}))))
|
||||
|
||||
(defn find-running-balance-start [account-needing-rebuild db ]
|
||||
(let [starting-from (or (->> (dc/q '[:find ?d ?je ?jel ?rbs
|
||||
:in $ ?c ?starting-at ?a ?l
|
||||
:where
|
||||
[?je :journal-entry/client ?c]
|
||||
[?je :journal-entry/date ?d]
|
||||
[(< ?d ?starting-at)]
|
||||
[?je :journal-entry/line-items ?jel]
|
||||
[?jel :journal-entry-line/account ?a]
|
||||
[?jel :journal-entry-line/location ?l]
|
||||
[?jel :journal-entry-line/running-balance ?rbs]
|
||||
]
|
||||
db
|
||||
(:client account-needing-rebuild)
|
||||
(:starting-at account-needing-rebuild)
|
||||
(:account account-needing-rebuild)
|
||||
(:location account-needing-rebuild))
|
||||
(sort)
|
||||
(last)
|
||||
(last))
|
||||
0.0)]
|
||||
(mu/log ::starting-rebuild-at
|
||||
:at starting-from)
|
||||
starting-from))
|
||||
|
||||
(defn get-dirty-entries [account-needing-rebuild db ]
|
||||
(->> (dc/q
|
||||
'[:find ?d ?jel ?debit ?credit
|
||||
:in $ ?c ?starting-at ?a ?l
|
||||
:where
|
||||
[?e :journal-entry/client ?c]
|
||||
[?e :journal-entry/date ?d]
|
||||
[(>= ?d ?starting-at)]
|
||||
[?e :journal-entry/line-items ?jel]
|
||||
[?jel :journal-entry-line/account ?a]
|
||||
[?jel :journal-entry-line/location ?l]
|
||||
[(get-else $ ?jel :journal-entry-line/debit 0.0) ?debit ]
|
||||
[(get-else $ ?jel :journal-entry-line/credit 0.0) ?credit]]
|
||||
db
|
||||
(:client account-needing-rebuild)
|
||||
(:starting-at account-needing-rebuild)
|
||||
(:account account-needing-rebuild)
|
||||
(:location account-needing-rebuild))
|
||||
sort
|
||||
(map #(drop 1 %))))
|
||||
|
||||
(defn compute-running-balance [account-needing-refresh]
|
||||
(mu/log ::compute
|
||||
:dirty-count (count (:dirty-entries account-needing-refresh)))
|
||||
(second
|
||||
(reduce
|
||||
(fn [[running-balance rows] [id debit credit] ]
|
||||
(let [new-running-balance (+ running-balance
|
||||
(if (#{:account-type/asset
|
||||
:account-type/dividend
|
||||
:account-type/expense} (:account-type account-needing-refresh))
|
||||
(- debit credit)
|
||||
(- credit debit)))]
|
||||
[new-running-balance
|
||||
(conj rows
|
||||
{:db/id id
|
||||
:journal-entry-line/running-balance new-running-balance
|
||||
:journal-entry-line/dirty false})]))
|
||||
|
||||
[(:build-from account-needing-refresh) []]
|
||||
(:dirty-entries account-needing-refresh))))
|
||||
|
||||
|
||||
(defn refresh-running-balance-cache []
|
||||
(doseq [c (shuffle (map first
|
||||
(dc/q '[:find (pull ?c [:client/code :db/id])
|
||||
:where [?c :client/code]]
|
||||
(dc/db conn))))]
|
||||
(mu/trace ::building-running-balance
|
||||
[:client c]
|
||||
(mu/with-context {:client c}
|
||||
(let [db (dc/db conn)
|
||||
accounts-needing-rebuild (accounts-needing-rebuild db (:db/id c))]
|
||||
(when (seq accounts-needing-rebuild)
|
||||
(mu/log ::found-accounts-needing-rebuild
|
||||
:accounts accounts-needing-rebuild)
|
||||
(audit-transact-batch
|
||||
(->> accounts-needing-rebuild
|
||||
(mapcat (fn [account-needing-rebuild]
|
||||
(mu/with-context {:account account-needing-rebuild}
|
||||
(-> account-needing-rebuild
|
||||
(assoc :build-from (find-running-balance-start account-needing-rebuild db))
|
||||
(assoc :dirty-entries (get-dirty-entries account-needing-rebuild db))
|
||||
(assoc :account-type (:account_type ((build-account-lookup (:client account-needing-rebuild)) (:account account-needing-rebuild))))
|
||||
(compute-running-balance))))))
|
||||
{:user/name "running-balance-cache"})))))))
|
||||
|
||||
|
||||
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
|
||||
(mount/defstate running-balance-cache-worker
|
||||
:start (scheduler/every (* 15 60 (+ 500 (rand-int 500))) (heartbeat refresh-running-balance-cache "running-balance-cache"))
|
||||
:stop (scheduler/stop running-balance-cache-worker))
|
||||
|
||||
|
||||
(defn get-journal-detail-report [context input _]
|
||||
(let [category-totals (atom {})
|
||||
@@ -652,8 +506,8 @@
|
||||
(into base-categories
|
||||
(for [client-id (:client_ids input)
|
||||
:let [_ (assert-can-see-client (:id context) client-id)
|
||||
account-lookup (build-account-lookup client-id)
|
||||
c (dc/pull (dc/db conn) '[:client/locations] client-id)]
|
||||
account-lookup (build-account-lookup client-id)
|
||||
c (dc/pull (dc/db conn) '[:client/locations] client-id)]
|
||||
location (:client/locations c)
|
||||
line [{:client_id client-id
|
||||
:location location
|
||||
|
||||
Reference in New Issue
Block a user