(cloud) makes ledger running balances fast and smooth
This commit is contained in:
@@ -663,6 +663,12 @@
|
||||
(defn random-tempid []
|
||||
(str (UUID/randomUUID)))
|
||||
|
||||
(defn pull-id [db id]
|
||||
(ffirst (dc/q '[:find ?i
|
||||
:in $ ?i]
|
||||
db
|
||||
id)))
|
||||
|
||||
(defn pull-attr [db k id]
|
||||
(get (dc/pull db [k] id) k))
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -1,14 +1,6 @@
|
||||
(ns auto-ap.graphql.transactions
|
||||
(:require
|
||||
[auto-ap.datomic
|
||||
:refer [audit-transact
|
||||
audit-transact-batch
|
||||
conn
|
||||
pull-attr
|
||||
pull-many
|
||||
pull-ref
|
||||
remove-nils]]
|
||||
[iol-ion.tx :refer [upsert-entity]]
|
||||
[auto-ap.datomic :refer [conn pull-attr pull-many pull-ref remove-nils]]
|
||||
[auto-ap.datomic.accounts :as a]
|
||||
[auto-ap.datomic.checks :as d-checks]
|
||||
[auto-ap.datomic.invoices :as d-invoices]
|
||||
@@ -19,10 +11,10 @@
|
||||
:refer [->graphql
|
||||
<-graphql
|
||||
assert-admin
|
||||
attach-tracing-resolvers
|
||||
assert-can-see-client
|
||||
assert-not-locked
|
||||
assert-power-user
|
||||
attach-tracing-resolvers
|
||||
enum->keyword
|
||||
ident->enum-f
|
||||
snake->kebab]]
|
||||
@@ -35,7 +27,8 @@
|
||||
[clojure.set :as set]
|
||||
[clojure.string :as str]
|
||||
[clojure.tools.logging :as log]
|
||||
[datomic.client.api :as dc]))
|
||||
[datomic.client.api :as dc]
|
||||
[iol-ion.tx :refer [random-tempid upsert-entity]]))
|
||||
|
||||
(def approval-status->graphql (ident->enum-f :transaction/approval-status))
|
||||
|
||||
@@ -327,7 +320,7 @@
|
||||
|
||||
(defn transaction-account->entity [{:keys [id account_id amount location]}]
|
||||
#:transaction-account {:amount amount
|
||||
:db/id id
|
||||
:db/id (or id (random-tempid))
|
||||
:account account_id
|
||||
:location location})
|
||||
|
||||
|
||||
@@ -1,12 +1,20 @@
|
||||
(ns auto-ap.ledger
|
||||
(:require
|
||||
[auto-ap.datomic :refer [conn remove-nils pull-ref audit-transact]]
|
||||
[auto-ap.utils :refer [dollars-0? dollars=]]
|
||||
[auto-ap.datomic
|
||||
:refer [audit-transact
|
||||
audit-transact-batch
|
||||
conn
|
||||
pull-id
|
||||
pull-ref
|
||||
remove-nils]]
|
||||
[auto-ap.utils :refer [by dollars-0? dollars=]]
|
||||
[clj-time.coerce :as c]
|
||||
[clj-time.core :as t]
|
||||
[clojure.tools.logging :as log]
|
||||
[com.brunobonacci.mulog :as mu]
|
||||
[com.unbounce.dogstatsd.core :as statsd]
|
||||
[datomic.client.api :as dc]))
|
||||
[datomic.client.api :as dc]
|
||||
[iol-ion.tx :refer [upsert-ledger]]))
|
||||
|
||||
(defn datums->impacted-entity [db [e changes]]
|
||||
(let [entity (dc/pull db '[{:invoice/_expense-accounts [:db/id] :transaction/_accounts [:db/id]}] e)
|
||||
@@ -47,16 +55,16 @@
|
||||
:journal-entry/vendor (:db/id (:invoice/vendor entity))
|
||||
:journal-entry/amount (Math/abs (:invoice/total entity))
|
||||
|
||||
:journal-entry/line-items (into [(cond-> {:journal-entry-line/account :account/accounts-payable
|
||||
:journal-entry-line/dirty true
|
||||
:journal-entry/line-items (into [(cond-> {:db/id (str (:db/id entity) "-" 0)
|
||||
:journal-entry-line/account :account/accounts-payable
|
||||
:journal-entry-line/location "A"
|
||||
}
|
||||
credit-invoice? (assoc :journal-entry-line/debit (Math/abs (:invoice/total entity)))
|
||||
(not credit-invoice?) (assoc :journal-entry-line/credit (Math/abs (:invoice/total entity))))]
|
||||
(map (fn [ea]
|
||||
(map-indexed (fn [i ea]
|
||||
(cond->
|
||||
{:journal-entry-line/account (:db/id (:invoice-expense-account/account ea))
|
||||
:journal-entry-line/dirty true
|
||||
{:db/id (str (:db/id entity) "-" (inc i))
|
||||
:journal-entry-line/account (:db/id (:invoice-expense-account/account ea))
|
||||
:journal-entry-line/location (or (:invoice-expense-account/location ea) "HQ")
|
||||
}
|
||||
credit-invoice? (assoc :journal-entry-line/credit (Math/abs (:invoice-expense-account/amount ea)))
|
||||
@@ -93,18 +101,19 @@
|
||||
:journal-entry/cleared-against (:transaction/cleared-against entity)
|
||||
|
||||
:journal-entry/line-items (into [(remove-nils {:journal-entry-line/account (:db/id (:transaction/bank-account entity))
|
||||
:journal-entry-line/dirty true
|
||||
:db/id (str (:db/id entity) "-" 0)
|
||||
:journal-entry-line/location "A"
|
||||
:journal-entry-line/credit (when credit-from-bank?
|
||||
(Math/abs (:transaction/amount entity)))
|
||||
:journal-entry-line/debit (when debit-from-bank?
|
||||
(Math/abs (:transaction/amount entity)))})
|
||||
]
|
||||
(map
|
||||
(fn [a]
|
||||
(remove-nils{:journal-entry-line/account (:db/id (:transaction-account/account a))
|
||||
(map-indexed
|
||||
(fn [i a]
|
||||
(remove-nils{
|
||||
:db/id (str (:db/id entity) "-" (inc i))
|
||||
:journal-entry-line/account (:db/id (:transaction-account/account a))
|
||||
:journal-entry-line/location (:transaction-account/location a)
|
||||
:journal-entry-line/dirty true
|
||||
:journal-entry-line/debit (when credit-from-bank?
|
||||
(Math/abs (:transaction-account/amount a)))
|
||||
:journal-entry-line/credit (when debit-from-bank?
|
||||
@@ -186,20 +195,19 @@
|
||||
|
||||
|
||||
(defn touch-transaction [e]
|
||||
(dc/transact conn {:tx-data [[:db/retractEntity [:journal-entry/original-entity e]]]})
|
||||
(when-let [change (entity-change->ledger (dc/db conn)
|
||||
[:transaction e])]
|
||||
(dc/transact conn {:tx-data [{:db/id "datomic.tx"
|
||||
:db/doc "touching transaction to update ledger"}
|
||||
change]})))
|
||||
`(upsert-ledger ~change)]})))
|
||||
|
||||
(defn touch-invoice [e]
|
||||
(dc/transact conn [[:db/retractEntity [:journal-entry/original-entity e]]])
|
||||
(when-let [change (entity-change->ledger (dc/db conn)
|
||||
[:invoice e])]
|
||||
(dc/transact conn [{:db/id "datomic.tx"
|
||||
:db/doc "touching invoice to update ledger"}
|
||||
change])))
|
||||
`(upsert-ledger ~change)])))
|
||||
|
||||
(defn lazy-tx-range
|
||||
([start end xf] (lazy-tx-range start end xf 0))
|
||||
([start end xf o]
|
||||
@@ -432,11 +440,9 @@
|
||||
(set))
|
||||
ledger-txs (->> affected-entities
|
||||
(map #(entity-change->ledger (:db-after tx) %))
|
||||
(filter seq))
|
||||
;; TODO mark deleted journal-entry-line accounts as dirty, needing refresh
|
||||
retractions (map (fn [[_ e]] [:db/retractEntity [:journal-entry/original-entity e]]) affected-entities)]
|
||||
(when (seq retractions)
|
||||
(audit-transact retractions id))
|
||||
(filter seq)
|
||||
(map (fn [l]
|
||||
`(upsert-ledger ~l))))]
|
||||
(when (seq ledger-txs)
|
||||
(audit-transact ledger-txs id))
|
||||
tx))
|
||||
@@ -459,3 +465,208 @@
|
||||
|
||||
{}
|
||||
(partition-all 50 txes))))
|
||||
|
||||
(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})))
|
||||
|
||||
(defn reset-client+account+location+date
|
||||
([] (reset-client+account+location+date (map first (dc/q '[:find ?c :where [?c :client/code]] (dc/db conn)))))
|
||||
([clients]
|
||||
(doseq [client clients
|
||||
:let [_ (mu/log ::reseting-index-for :client client)]
|
||||
batch
|
||||
(->> (dc/qseq '[:find (pull ?je [:journal-entry/date :journal-entry/client {:journal-entry/line-items [:journal-entry-line/account :journal-entry-line/location :db/id]}])
|
||||
:in $ ?c
|
||||
:where [?je :journal-entry/client ?c]]
|
||||
(dc/db conn)
|
||||
client
|
||||
|
||||
)
|
||||
(map first)
|
||||
(mapcat (fn [je]
|
||||
(map (fn [jel]
|
||||
{:db/id (:db/id jel)
|
||||
:journal-entry-line/client+account+location+date
|
||||
[(-> je :journal-entry/client :db/id)
|
||||
(-> jel :journal-entry-line/account :db/id)
|
||||
|
||||
(-> jel :journal-entry-line/location)
|
||||
|
||||
(-> je :journal-entry/date)]})
|
||||
(:journal-entry/line-items je))))
|
||||
(partition-all 500)
|
||||
)]
|
||||
(mu/log ::batch-completed)
|
||||
(dc/transact conn {:tx-data batch}))))
|
||||
|
||||
(defn find-mismatch-index []
|
||||
(reduce + 0
|
||||
(for [c (map first (dc/q '[:find ?c :where [?c :client/code]] (dc/db conn)))
|
||||
:let [_ (println "searching for" c)
|
||||
a (->> (dc/index-pull (dc/db conn)
|
||||
{:index :avet
|
||||
:selector [:db/id :journal-entry-line/location :journal-entry-line/account :journal-entry-line/client+account+location+date {:journal-entry/_line-items [:journal-entry/date :journal-entry/client]}]
|
||||
:start [:journal-entry-line/client+account+location+date [c]]})
|
||||
(take-while (fn [result]
|
||||
(= c (first (:journal-entry-line/client+account+location+date result)))
|
||||
))
|
||||
(filter (fn [{index :journal-entry-line/client+account+location+date :as result}]
|
||||
(not= index
|
||||
[(-> result :journal-entry/_line-items :journal-entry/client :db/id)
|
||||
(-> result :journal-entry-line/account :db/id)
|
||||
(-> result :journal-entry-line/location)
|
||||
(-> result :journal-entry/_line-items :journal-entry/date)]))))]]
|
||||
(do (println (count a))
|
||||
(count a)))))
|
||||
|
||||
|
||||
|
||||
(defn accounts-needing-rebuild [ db client]
|
||||
(let [client (pull-id db client)]
|
||||
(->> (dc/qseq '[:find ?c ?a ?l (min ?d)
|
||||
:in $ ?c
|
||||
:where
|
||||
[?jel :journal-entry-line/dirty true]
|
||||
[?jel :journal-entry-line/account ?a]
|
||||
[?jel :journal-entry-line/location ?l]
|
||||
[?je :journal-entry/line-items ?jel]
|
||||
[?je :journal-entry/client ?c]
|
||||
[?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 ]
|
||||
(or
|
||||
(->> (dc/index-pull db
|
||||
{:index :avet
|
||||
:selector [:db/id :journal-entry-line/running-balance :journal-entry-line/client+account+location+date]
|
||||
:start [:journal-entry-line/client+account+location+date
|
||||
[(:client account-needing-rebuild)
|
||||
(:account account-needing-rebuild)
|
||||
(:location account-needing-rebuild)
|
||||
(:starting-at account-needing-rebuild)]]
|
||||
|
||||
:reverse true
|
||||
:limit 500})
|
||||
(take-while (fn [result]
|
||||
(= [(:client account-needing-rebuild)
|
||||
(:account account-needing-rebuild)
|
||||
(:location account-needing-rebuild)]
|
||||
(take 3 (:journal-entry-line/client+account+location+date result)))))
|
||||
(drop-while (fn [{[_ _ _ date] :journal-entry-line/client+account+location+date}]
|
||||
(>= (compare date (:starting-at account-needing-rebuild)) 0)))
|
||||
first
|
||||
:journal-entry-line/running-balance
|
||||
)
|
||||
0.0))
|
||||
|
||||
(defn get-dirty-entries [account-needing-rebuild db ]
|
||||
(->> (dc/index-pull db
|
||||
{:index :avet
|
||||
:selector [:db/id :journal-entry-line/debit :journal-entry-line/credit :journal-entry-line/client+account+location+date]
|
||||
:start [:journal-entry-line/client+account+location+date
|
||||
[(:client account-needing-rebuild)
|
||||
(:account account-needing-rebuild)
|
||||
(:location account-needing-rebuild)
|
||||
(:starting-at account-needing-rebuild)]]
|
||||
})
|
||||
(take-while (fn [result]
|
||||
(= [(:client account-needing-rebuild)
|
||||
(:account account-needing-rebuild)
|
||||
(:location account-needing-rebuild)]
|
||||
(take 3 (:journal-entry-line/client+account+location+date result)))))
|
||||
(map (fn [result]
|
||||
[(:db/id result) (:journal-entry-line/debit result 0.0) (:journal-entry-line/credit result 0.0) ]))))
|
||||
|
||||
(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
|
||||
([] (refresh-running-balance-cache (shuffle (map first
|
||||
(dc/q '[:find (pull ?c [:client/code :db/id])
|
||||
:where [?c :client/code]]
|
||||
(dc/db conn))))))
|
||||
([clients]
|
||||
(doseq [c clients]
|
||||
(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))
|
||||
|
||||
@@ -1,143 +0,0 @@
|
||||
(ns iol-ion.tx
|
||||
(:require [datomic.client.api :as dc])
|
||||
(:import [java.util UUID]))
|
||||
|
||||
(defn random-tempid []
|
||||
(str (UUID/randomUUID)))
|
||||
|
||||
(defn remove-nils [m]
|
||||
(let [result (reduce-kv
|
||||
(fn [m k v]
|
||||
(if (not (nil? v))
|
||||
(assoc m k v)
|
||||
m
|
||||
))
|
||||
{}
|
||||
m)]
|
||||
(if (seq result)
|
||||
result
|
||||
nil)))
|
||||
|
||||
(defn by
|
||||
([f xs]
|
||||
(by f identity xs))
|
||||
([f fv xs]
|
||||
(reduce
|
||||
#(assoc %1 (f %2) (fv %2))
|
||||
{}
|
||||
xs)))
|
||||
|
||||
(defn pull-many [db read ids ]
|
||||
(->> (dc/q '[:find (pull ?e r)
|
||||
:in $ [?e ...] r]
|
||||
db
|
||||
ids
|
||||
read)
|
||||
(map first)))
|
||||
|
||||
(declare upsert-entity)
|
||||
|
||||
(defn reset-rels [db e a vs]
|
||||
(assert (every? :db/id vs) (format "In order to reset attribute %s, every value must have :db/id" a))
|
||||
(let [ids (when-not (string? e)
|
||||
(->> (dc/q '[:find ?z
|
||||
:in $ ?e ?a
|
||||
:where [?e ?a ?z]]
|
||||
db e a)
|
||||
(map first)))
|
||||
new-id-set (set (map :db/id vs))
|
||||
retract-ids (filter (complement new-id-set) ids)
|
||||
{is-component? :db/isComponent} (dc/pull db [:db/isComponent] a)
|
||||
new-rels (filter (complement (set ids)) (map :db/id vs))]
|
||||
(-> []
|
||||
(into (map (fn [i] (if is-component?
|
||||
[:db/retractEntity i]
|
||||
[:db/retract e a i ])) retract-ids))
|
||||
(into (map (fn [i] [:db/add e a i]) new-rels))
|
||||
(into (mapcat (fn [i] (upsert-entity db i)) vs)))))
|
||||
|
||||
(defn reset-scalars [db e a vs]
|
||||
|
||||
(let [extant (when-not (string? e)
|
||||
(->> (dc/q '[:find ?z
|
||||
:in $ ?e ?a
|
||||
:where [?e ?a ?z]]
|
||||
db e a)
|
||||
(map first)))
|
||||
retracts (filter (complement (set vs)) extant)
|
||||
new (filter (complement (set extant)) vs)]
|
||||
(-> []
|
||||
(into (map (fn [i] [:db/retract e a i ]) retracts))
|
||||
(into (map (fn [i] [:db/add e a i]) new)))))
|
||||
|
||||
|
||||
;; TODO unit test this
|
||||
(defn upsert-entity [db entity]
|
||||
(assert (:db/id entity) "Cannot upsert without :db/id")
|
||||
(let [e (:db/id entity)
|
||||
is-new? (string? e)
|
||||
extant-entity (when-not is-new?
|
||||
(dc/pull db (keys entity) (:db/id entity)))
|
||||
ident->value-type (by :db/ident (comp :db/ident
|
||||
:db/valueType)
|
||||
(pull-many
|
||||
db
|
||||
[:db/valueType :db/ident]
|
||||
(keys entity)))
|
||||
ops (->> entity
|
||||
(reduce
|
||||
(fn [ops [a v]]
|
||||
(cond
|
||||
(= :db/id a)
|
||||
ops
|
||||
|
||||
(or (= v (a extant-entity))
|
||||
(= v (:db/ident (a extant-entity) :nope))
|
||||
(= v (:db/id (a extant-entity)) :nope))
|
||||
ops
|
||||
|
||||
(and (nil? v)
|
||||
(not (nil? (a extant-entity))))
|
||||
(conj ops [:db/retract e a (cond-> (a extant-entity)
|
||||
(:db/id (a extant-entity)) :db/id)])
|
||||
|
||||
(nil? v)
|
||||
ops
|
||||
|
||||
;; reset relationships if it's refs, and not a lookup (i.e., seq of maps, or empty seq)
|
||||
(and (sequential? v) (= :db.type/ref (ident->value-type a)) (every? map? v))
|
||||
(into ops (reset-rels db e a v))
|
||||
|
||||
(and (sequential? v) (not= :db.type/ref (ident->value-type a)))
|
||||
(into ops (reset-scalars db e a v))
|
||||
|
||||
(and (map? v)
|
||||
(= :db.type/ref (ident->value-type a)))
|
||||
(let [id (or (:db/id v) (random-tempid))]
|
||||
(-> ops
|
||||
(conj [:db/add e a id])
|
||||
(into (upsert-entity db (assoc v :db/id id)))))
|
||||
|
||||
:else
|
||||
(conj ops [:db/add e a v])
|
||||
))
|
||||
[]))]
|
||||
ops))
|
||||
|
||||
|
||||
|
||||
(defn propose-invoice [db invoice]
|
||||
(let [existing? (boolean (seq (dc/q '[:find ?i
|
||||
:in $ ?invoice-number ?client ?vendor
|
||||
:where
|
||||
[?i :invoice/invoice-number ?invoice-number]
|
||||
[?i :invoice/client ?client]
|
||||
[?i :invoice/vendor ?vendor]
|
||||
(not [?i :invoice/status :invoice-status/voided])]
|
||||
db
|
||||
(:invoice/invoice-number invoice)
|
||||
(:invoice/client invoice)
|
||||
(:invoice/vendor invoice))))]
|
||||
(if existing?
|
||||
[]
|
||||
[(remove-nils invoice)])))
|
||||
Reference in New Issue
Block a user