Migrates back to datomic on-prem
This commit is contained in:
@@ -2,7 +2,7 @@
|
||||
(:require [clj-time.core :as time]
|
||||
[clj-time.coerce :as coerce]
|
||||
[clj-time.format :as f]
|
||||
[datomic.client.api :as dc]))
|
||||
[datomic.api :as dc]))
|
||||
|
||||
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
|
||||
(defn dollars-0? [amt]
|
||||
|
||||
@@ -1,406 +1,12 @@
|
||||
(ns iol-ion.tx
|
||||
(:require [datomic.client.api :as dc])
|
||||
(:require [datomic.api :as dc]
|
||||
[iol-ion.utils])
|
||||
(:import [java.util UUID]))
|
||||
|
||||
(defn random-tempid []
|
||||
(str (UUID/randomUUID)))
|
||||
|
||||
(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 (or (:db/id entity)
|
||||
(:db/ident entity))
|
||||
(str "Cannot upsert without :db/id or :db/ident, " entity))
|
||||
(let [e (or (:db/id entity) (:db/ident entity))
|
||||
is-new? (string? e)
|
||||
extant-entity (when-not is-new?
|
||||
(dc/pull db (keys entity) (or (:db/id entity) (:db/ident entity))))
|
||||
ident->value-type (by :db/ident (comp :db/ident
|
||||
:db/valueType)
|
||||
(pull-many
|
||||
db
|
||||
[:db/valueType :db/ident]
|
||||
(keys entity)))
|
||||
|
||||
ident->cardinality (by :db/ident (comp :db/ident
|
||||
:db/cardinality)
|
||||
(pull-many
|
||||
db
|
||||
[:db/cardinality :db/ident]
|
||||
(keys entity)))
|
||||
ops (->> entity
|
||||
(reduce
|
||||
(fn [ops [a v]]
|
||||
(cond
|
||||
(= :db/id a)
|
||||
ops
|
||||
|
||||
(= :db/ident 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))))
|
||||
(if (= :db.cardinality/many (ident->cardinality a))
|
||||
(into ops (map (fn [v]
|
||||
[:db/retract e a (cond-> v
|
||||
(:db/id v) :db/id)])
|
||||
(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/tuple (ident->value-type a)))
|
||||
(conj ops [:db/add e a v])
|
||||
|
||||
(and (sequential? v) (= :db.type/ref (ident->value-type a)) (every? map? v))
|
||||
(into ops (reset-rels db e a v))
|
||||
|
||||
|
||||
(= :db.cardinality/many (ident->cardinality a))
|
||||
(into ops (reset-scalars 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 min-by [sorter]
|
||||
(->> sorter
|
||||
sort
|
||||
last
|
||||
last))
|
||||
|
||||
(defn get-line-items-after [db journal-entry]
|
||||
(for [jel (:journal-entry/line-items journal-entry)
|
||||
:let [next-jel (->> (dc/index-pull db {:index :avet
|
||||
:selector [:db/id :journal-entry-line/client+account+location+date]
|
||||
:start [:journal-entry-line/client+account+location+date
|
||||
(:journal-entry-line/client+account+location+date jel)
|
||||
(:db/id jel)]
|
||||
:limit 3
|
||||
})
|
||||
(filter (fn line-must-match-client-account-location [result]
|
||||
(and
|
||||
(= (take 3 (:journal-entry-line/client+account+location+date result))
|
||||
(take 3 (:journal-entry-line/client+account+location+date jel)))
|
||||
(not= (:db/id jel)
|
||||
(:db/id result)))
|
||||
))
|
||||
first
|
||||
:db/id)]
|
||||
:when next-jel]
|
||||
next-jel))
|
||||
|
||||
(def extant-read '[:db/id :journal-entry/date :journal-entry/client {:journal-entry/line-items [:journal-entry-line/account :journal-entry-line/location :db/id :journal-entry-line/client+account+location+date]}])
|
||||
|
||||
|
||||
(defn calc-client+account+location+date [je jel]
|
||||
[(or
|
||||
(:db/id (:journal-entry/client je))
|
||||
(:journal-entry/client je))
|
||||
(or (:db/id (:journal-entry-line/account jel))
|
||||
(:journal-entry-line/account jel))
|
||||
(-> jel :journal-entry-line/location)
|
||||
(-> je :journal-entry/date)])
|
||||
|
||||
(defn upsert-ledger [db ledger-entry]
|
||||
(assert (:journal-entry/date ledger-entry) "Must at least provide date when updating ledger")
|
||||
(assert (:journal-entry/client ledger-entry) "Must at least provide client when updating ledger")
|
||||
;; TODO these are not always true
|
||||
;; (assert (every? :journal-entry-line/account (:journal-entry/line-items ledger-entry)) "must at least provide account when updating ledger")
|
||||
;; (assert (every? :journal-entry-line/location (:journal-entry/line-items ledger-entry)) "Must at least provide location when updating ledger")
|
||||
(let [extant-entry (or (when-let [original-entity (:journal-entry/original-entity ledger-entry)]
|
||||
(dc/pull db extant-read [:journal-entry/original-entity original-entity]))
|
||||
(when-let [external-id (:journal-entry/external-id ledger-entry)]
|
||||
(dc/pull db extant-read [:journal-entry/external-id external-id])))
|
||||
extant-entry-exists? (:db/id extant-entry)]
|
||||
|
||||
(cond->
|
||||
(upsert-entity db (into (-> ledger-entry
|
||||
(assoc :db/id (or
|
||||
(:db/id ledger-entry)
|
||||
(:db/id extant-entry)
|
||||
(random-tempid)))
|
||||
(update :journal-entry/line-items
|
||||
(fn [lis]
|
||||
(mapv #(-> %
|
||||
(assoc :journal-entry-line/dirty true)
|
||||
(assoc :journal-entry-line/client+account+location+date
|
||||
(calc-client+account+location+date ledger-entry %)))
|
||||
lis))))
|
||||
))
|
||||
extant-entry-exists? (into (map (fn [li]
|
||||
{:journal-entry-line/dirty true
|
||||
:db/id li})
|
||||
(get-line-items-after db extant-entry))))))
|
||||
|
||||
(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 invoice->journal-entry
|
||||
([db invoice-id]
|
||||
(invoice->journal-entry db invoice-id invoice-id))
|
||||
;; the 3-arity version allows you to pass a potential tempid in instead of the invoice-id,
|
||||
;; which would be a temporary value after the transaction
|
||||
([db invoice-id raw-invoice-id]
|
||||
(let [entity (dc/pull db
|
||||
'[:invoice/total
|
||||
:invoice/exclude-from-ledger
|
||||
:invoice/outstanding-balance
|
||||
:invoice/date
|
||||
{:invoice/vendor [:db/id :vendor/name]
|
||||
:invoice/client [:db/id :client/code]
|
||||
:invoice/payment [:db/id {:payment/status [:db/ident]}]
|
||||
:invoice/status [:db/ident]
|
||||
:invoice/import-status [:db/ident]
|
||||
:invoice/expense-accounts [:invoice-expense-account/account
|
||||
:invoice-expense-account/amount
|
||||
:invoice-expense-account/location]}]
|
||||
invoice-id)
|
||||
credit-invoice? (< (:invoice/total entity 0.0) 0.0)]
|
||||
(when-not (or
|
||||
(not (:invoice/total entity))
|
||||
(= true (:invoice/exclude-from-ledger entity))
|
||||
(= :import-status/pending (:db/ident (:invoice/import-status entity)))
|
||||
(= :invoice-status/voided (:db/ident (:invoice/status entity)))
|
||||
(< -0.001 (:invoice/total entity) 0.001))
|
||||
|
||||
(remove-nils
|
||||
{:journal-entry/source "invoice"
|
||||
:journal-entry/client (:db/id (:invoice/client entity))
|
||||
:journal-entry/date (:invoice/date entity)
|
||||
:journal-entry/original-entity raw-invoice-id
|
||||
:journal-entry/vendor (:db/id (:invoice/vendor entity))
|
||||
:journal-entry/amount (Math/abs (:invoice/total entity))
|
||||
|
||||
:journal-entry/line-items (into [(cond-> {:db/id (str raw-invoice-id "-" 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-indexed (fn [i ea]
|
||||
(cond->
|
||||
{:db/id (str raw-invoice-id "-" (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)))
|
||||
(not credit-invoice?) (assoc :journal-entry-line/debit (Math/abs (:invoice-expense-account/amount ea)))))
|
||||
(:invoice/expense-accounts entity)))
|
||||
:journal-entry/cleared (and (< (:invoice/outstanding-balance entity) 0.01)
|
||||
(every? #(= :payment-status/cleared (:payment/status %)) (:invoice/payments entity))
|
||||
)})))))
|
||||
|
||||
(defn upsert-invoice [db invoice]
|
||||
(let [
|
||||
upserted-entity (upsert-entity db invoice)
|
||||
with-invoice (try (dc/with db {:tx-data upserted-entity})
|
||||
(catch ClassCastException e
|
||||
(println "Dev local does not support with in tx functions. :(")
|
||||
(dc/with (dc/with-db @(resolve 'auto-ap.datomic/conn)) {:tx-data upserted-entity})
|
||||
))
|
||||
invoice-id (or (-> with-invoice :tempids (get (:db/id invoice)))
|
||||
(:db/id invoice))
|
||||
journal-entry (invoice->journal-entry (:db-after with-invoice)
|
||||
invoice-id
|
||||
(:db/id invoice))]
|
||||
|
||||
(into upserted-entity
|
||||
(if journal-entry
|
||||
(upsert-ledger db journal-entry)
|
||||
[[:db/retractEntity [:journal-entry/original-entity (:db/id invoice)]]]))))
|
||||
|
||||
(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?
|
||||
[]
|
||||
(upsert-invoice db invoice))))
|
||||
|
||||
|
||||
(defn transaction->journal-entry
|
||||
([db transaction-id]
|
||||
(transaction->journal-entry db transaction-id transaction-id))
|
||||
;; the 3-arity version allows you to pass a potential tempid in instead of the invoice-id,
|
||||
;; which would be a temporary value after the transaction
|
||||
([db transaction-id raw-transaction-id]
|
||||
(let [entity (dc/pull db [:transaction/client
|
||||
:transaction/date
|
||||
:transaction/description-original
|
||||
:db/id
|
||||
:transaction/vendor
|
||||
:transaction/amount
|
||||
:transaction/cleared-against
|
||||
{:transaction/accounts [:transaction-account/account
|
||||
:transaction-account/location
|
||||
:transaction-account/amount]
|
||||
:transaction/approval-status [:db/ident]
|
||||
:transaction/bank-account [:db/id {:bank-account/type [:db/ident]}]}]
|
||||
transaction-id)
|
||||
decreasing? (< (or (:transaction/amount entity) 0.0) 0.0)
|
||||
credit-from-bank? decreasing?
|
||||
debit-from-bank? (not decreasing?)]
|
||||
(when (and (not (= :transaction-approval-status/excluded (:db/ident (:transaction/approval-status entity))))
|
||||
(not (= :transaction-approval-status/suppressed (:db/ident (:transaction/approval-status entity))))
|
||||
(:transaction/amount entity)
|
||||
(not (< -0.001 (:transaction/amount entity) 0.001)))
|
||||
(remove-nils
|
||||
{:journal-entry/source "transaction"
|
||||
:journal-entry/client (:db/id (:transaction/client entity))
|
||||
:journal-entry/date (:transaction/date entity)
|
||||
:journal-entry/original-entity raw-transaction-id
|
||||
:journal-entry/alternate-description (:transaction/description-original entity)
|
||||
:journal-entry/vendor (:db/id (:transaction/vendor entity))
|
||||
:journal-entry/amount (Math/abs (:transaction/amount entity))
|
||||
: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))
|
||||
:db/id (str raw-transaction-id "-" 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-indexed
|
||||
(fn [i a]
|
||||
(remove-nils{
|
||||
:db/id (str raw-transaction-id "-" (inc i))
|
||||
:journal-entry-line/account (:db/id (:transaction-account/account a))
|
||||
:journal-entry-line/location (:transaction-account/location a)
|
||||
:journal-entry-line/debit (when credit-from-bank?
|
||||
(Math/abs (:transaction-account/amount a)))
|
||||
:journal-entry-line/credit (when debit-from-bank?
|
||||
(Math/abs (:transaction-account/amount a)))}))
|
||||
(if (seq (:transaction/accounts entity))
|
||||
(:transaction/accounts entity)
|
||||
[{:transaction-account/amount (:transaction/amount entity)}])))
|
||||
|
||||
:journal-entry/cleared true})))))
|
||||
|
||||
(defn upsert-transaction [db transaction]
|
||||
;; because some transactions will reference temp ids, you have to dissoc them, like :transaction/payment
|
||||
(let [upserted-entity (upsert-entity db (dissoc transaction :transaction/payment :import-batch/_entry))
|
||||
with-transaction (try (dc/with db {:tx-data upserted-entity})
|
||||
(catch ClassCastException e
|
||||
(println "Dev local does not support with in tx functions. :(")
|
||||
(dc/with (dc/with-db @(resolve 'auto-ap.datomic/conn)) {:tx-data upserted-entity})
|
||||
))
|
||||
transaction-id (or (-> with-transaction :tempids (get (:db/id transaction)))
|
||||
(:db/id transaction))
|
||||
journal-entry (transaction->journal-entry (:db-after with-transaction)
|
||||
transaction-id
|
||||
(:db/id transaction))]
|
||||
(into (upsert-entity db transaction)
|
||||
(if journal-entry
|
||||
(upsert-ledger db journal-entry)
|
||||
[[:db/retractEntity [:journal-entry/original-entity (:db/id transaction)]]]))))
|
||||
|
||||
|
||||
(defn pay [db e amount]
|
||||
(let [current-outstanding-balance (-> (dc/pull db [:invoice/outstanding-balance] e) :invoice/outstanding-balance)
|
||||
new-outstanding-balance (- current-outstanding-balance amount)]
|
||||
(upsert-invoice db {:db/id e
|
||||
:invoice/outstanding-balance new-outstanding-balance
|
||||
:invoice/status (if (> new-outstanding-balance 0)
|
||||
:invoice-status/unpaid
|
||||
:invoice-status/paid)})))
|
||||
(def random-tempid iol-ion.utils/random-tempid)
|
||||
(def by iol-ion.utils/by)
|
||||
(def pull-many iol-ion.utils/pull-many)
|
||||
(def remove-nils iol-ion.utils/remove-nils)
|
||||
|
||||
|
||||
;; TODO expected-deposit ledger entry
|
||||
@@ -424,5 +30,7 @@
|
||||
:location "A"
|
||||
:account :account/ccp}]}))
|
||||
|
||||
(defn plus [db e a amount]
|
||||
[[:db/add e a (-> (dc/pull db [a] e) a (+ amount))]])
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
11
iol_ion/src/iol_ion/tx/pay.clj
Normal file
11
iol_ion/src/iol_ion/tx/pay.clj
Normal file
@@ -0,0 +1,11 @@
|
||||
(ns iol-ion.tx.pay
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(defn pay [db e amount]
|
||||
(let [current-outstanding-balance (-> (dc/pull db [:invoice/outstanding-balance] e) :invoice/outstanding-balance)
|
||||
new-outstanding-balance (- current-outstanding-balance amount)]
|
||||
[[:upsert-invoice {:db/id e
|
||||
:invoice/outstanding-balance new-outstanding-balance
|
||||
:invoice/status (if (> new-outstanding-balance 0)
|
||||
:invoice-status/unpaid
|
||||
:invoice-status/paid)}]]))
|
||||
5
iol_ion/src/iol_ion/tx/plus.clj
Normal file
5
iol_ion/src/iol_ion/tx/plus.clj
Normal file
@@ -0,0 +1,5 @@
|
||||
(ns iol-ion.tx.plus
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(defn plus [db e a amount]
|
||||
[[:db/add e a (-> (dc/pull db [a] e) a (+ amount))]])
|
||||
18
iol_ion/src/iol_ion/tx/propose_invoice.clj
Normal file
18
iol_ion/src/iol_ion/tx/propose_invoice.clj
Normal file
@@ -0,0 +1,18 @@
|
||||
(ns iol-ion.tx.propose-invoice
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(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?
|
||||
[]
|
||||
[[:upsert-invoice invoice]])))
|
||||
21
iol_ion/src/iol_ion/tx/reset_rels.clj
Normal file
21
iol_ion/src/iol_ion/tx/reset_rels.clj
Normal file
@@ -0,0 +1,21 @@
|
||||
(ns iol-ion.tx.reset-rels
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(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 (map (fn [i] [:upsert-entity i]) vs)))))
|
||||
16
iol_ion/src/iol_ion/tx/reset_scalars.clj
Normal file
16
iol_ion/src/iol_ion/tx/reset_scalars.clj
Normal file
@@ -0,0 +1,16 @@
|
||||
(ns iol-ion.tx.reset-scalars
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(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)))))
|
||||
103
iol_ion/src/iol_ion/tx/upsert_entity.clj
Normal file
103
iol_ion/src/iol_ion/tx/upsert_entity.clj
Normal file
@@ -0,0 +1,103 @@
|
||||
(ns iol-ion.tx.upsert-entity
|
||||
(:require [datomic.api :as dc])
|
||||
(:import [java.util UUID]))
|
||||
|
||||
|
||||
(defn -random-tempid []
|
||||
(str (UUID/randomUUID)))
|
||||
|
||||
(defn -by
|
||||
[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)))
|
||||
|
||||
|
||||
(defn upsert-entity [db entity]
|
||||
(when-not (or (:db/id entity)
|
||||
(:db/ident entity))
|
||||
(datomic.api/cancel {:cognitect.anomalies/category :cognitect.anomalies/incorrect
|
||||
:cognitect.anomalies/message
|
||||
(str "Cannot upsert without :db/id or :db/ident, " entity)}))
|
||||
[]
|
||||
(let [e (or (:db/id entity) (:db/ident entity))
|
||||
is-new? (string? e)
|
||||
extant-entity (when-not is-new?
|
||||
(dc/pull db (keys entity) (or (:db/id entity) (:db/ident entity))))
|
||||
ident->value-type (-by :db/ident (comp :db/ident
|
||||
:db/valueType)
|
||||
(-pull-many
|
||||
db
|
||||
[{:db/valueType [:db/ident]} :db/ident]
|
||||
(keys entity)))
|
||||
|
||||
ident->cardinality (-by :db/ident (comp :db/ident
|
||||
:db/cardinality)
|
||||
(-pull-many
|
||||
db
|
||||
[{:db/cardinality [:db/ident]} :db/ident]
|
||||
(keys entity)))
|
||||
ops (->> entity
|
||||
(reduce
|
||||
(fn [ops [a v]]
|
||||
(cond
|
||||
(= :db/id a)
|
||||
ops
|
||||
|
||||
(= :db/ident 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))))
|
||||
(if (= :db.cardinality/many (ident->cardinality a))
|
||||
(into ops (map (fn [v]
|
||||
[:db/retract e a (cond-> v
|
||||
(:db/id v) :db/id)])
|
||||
(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/tuple (ident->value-type a)))
|
||||
(conj ops [:db/add e a v])
|
||||
|
||||
(and (sequential? v) (= :db.type/ref (ident->value-type a)) (every? map? v))
|
||||
(into ops [[:reset-rels e a v]])
|
||||
|
||||
(= :db.cardinality/many (ident->cardinality a))
|
||||
(into ops [[:reset-scalars e a v]])
|
||||
|
||||
(and (sequential? v) (not= :db.type/ref (ident->value-type a)))
|
||||
(into ops [[:reset-scalars 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 (assoc v :db/id id)]])))
|
||||
|
||||
:else
|
||||
(conj ops [:db/add e a v])
|
||||
))
|
||||
[]))]
|
||||
ops))
|
||||
81
iol_ion/src/iol_ion/tx/upsert_invoice.clj
Normal file
81
iol_ion/src/iol_ion/tx/upsert_invoice.clj
Normal file
@@ -0,0 +1,81 @@
|
||||
(ns iol-ion.tx.upsert-invoice
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(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 invoice->journal-entry
|
||||
[db invoice-id raw-invoice-id]
|
||||
(let [entity (dc/pull db
|
||||
'[:invoice/total
|
||||
:invoice/exclude-from-ledger
|
||||
:invoice/outstanding-balance
|
||||
:invoice/date
|
||||
{:invoice/vendor [:db/id :vendor/name]
|
||||
:invoice/client [:db/id :client/code]
|
||||
:invoice/payment [:db/id {:payment/status [:db/ident]}]
|
||||
:invoice/status [:db/ident]
|
||||
:invoice/import-status [:db/ident]
|
||||
:invoice/expense-accounts [:invoice-expense-account/account
|
||||
:invoice-expense-account/amount
|
||||
:invoice-expense-account/location]}]
|
||||
invoice-id)
|
||||
credit-invoice? (< (:invoice/total entity 0.0) 0.0)]
|
||||
(when-not (or
|
||||
(not (:invoice/total entity))
|
||||
(= true (:invoice/exclude-from-ledger entity))
|
||||
(= :import-status/pending (:db/ident (:invoice/import-status entity)))
|
||||
(= :invoice-status/voided (:db/ident (:invoice/status entity)))
|
||||
(< -0.001 (:invoice/total entity) 0.001))
|
||||
|
||||
(-remove-nils
|
||||
{:journal-entry/source "invoice"
|
||||
:journal-entry/client (:db/id (:invoice/client entity))
|
||||
:journal-entry/date (:invoice/date entity)
|
||||
:journal-entry/original-entity raw-invoice-id
|
||||
:journal-entry/vendor (:db/id (:invoice/vendor entity))
|
||||
:journal-entry/amount (Math/abs (:invoice/total entity))
|
||||
|
||||
:journal-entry/line-items (into [(cond-> {:db/id (str raw-invoice-id "-" 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-indexed (fn [i ea]
|
||||
(cond->
|
||||
{:db/id (str raw-invoice-id "-" (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)))
|
||||
(not credit-invoice?) (assoc :journal-entry-line/debit (Math/abs (:invoice-expense-account/amount ea)))))
|
||||
(:invoice/expense-accounts entity)))
|
||||
:journal-entry/cleared (and (< (:invoice/outstanding-balance entity) 0.01)
|
||||
(every? #(= :payment-status/cleared (:payment/status %)) (:invoice/payments entity))
|
||||
)})))
|
||||
|
||||
)
|
||||
|
||||
(defn upsert-invoice [db invoice]
|
||||
(let [upserted-entity [[:upsert-entity invoice]]
|
||||
with-invoice (dc/with db upserted-entity)
|
||||
invoice-id (or (-> with-invoice :tempids (get (:db/id invoice)))
|
||||
(:db/id invoice))
|
||||
journal-entry (invoice->journal-entry (:db-after with-invoice)
|
||||
invoice-id
|
||||
(:db/id invoice))]
|
||||
(into upserted-entity
|
||||
(if journal-entry
|
||||
[[:upsert-ledger journal-entry]]
|
||||
[[:db/retractEntity [:journal-entry/original-entity (:db/id invoice)]]]))))
|
||||
71
iol_ion/src/iol_ion/tx/upsert_ledger.clj
Normal file
71
iol_ion/src/iol_ion/tx/upsert_ledger.clj
Normal file
@@ -0,0 +1,71 @@
|
||||
(ns iol-ion.tx.upsert-ledger
|
||||
(:import [java.util UUID])
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(defn -random-tempid []
|
||||
(str (UUID/randomUUID)))
|
||||
|
||||
(defn get-line-items-after [db journal-entry]
|
||||
(for [jel (:journal-entry/line-items journal-entry)
|
||||
:let [next-jel (->> (dc/index-pull db {:index :avet
|
||||
:selector [:db/id :journal-entry-line/client+account+location+date]
|
||||
:start [:journal-entry-line/client+account+location+date
|
||||
(:journal-entry-line/client+account+location+date jel)
|
||||
(:db/id jel)]
|
||||
:limit 3
|
||||
})
|
||||
(filter (fn line-must-match-client-account-location [result]
|
||||
(and
|
||||
(= (take 3 (:journal-entry-line/client+account+location+date result))
|
||||
(take 3 (:journal-entry-line/client+account+location+date jel)))
|
||||
(not= (:db/id jel)
|
||||
(:db/id result)))
|
||||
))
|
||||
first
|
||||
:db/id)]
|
||||
:when next-jel]
|
||||
next-jel))
|
||||
|
||||
(def extant-read '[:db/id :journal-entry/date :journal-entry/client {:journal-entry/line-items [:journal-entry-line/account :journal-entry-line/location :db/id :journal-entry-line/client+account+location+date]}])
|
||||
|
||||
|
||||
(defn calc-client+account+location+date [je jel]
|
||||
[(or
|
||||
(:db/id (:journal-entry/client je))
|
||||
(:journal-entry/client je))
|
||||
(or (:db/id (:journal-entry-line/account jel))
|
||||
(:journal-entry-line/account jel))
|
||||
(-> jel :journal-entry-line/location)
|
||||
(-> je :journal-entry/date)])
|
||||
|
||||
(defn upsert-ledger [db ledger-entry]
|
||||
(assert (:journal-entry/date ledger-entry) "Must at least provide date when updating ledger")
|
||||
(assert (:journal-entry/client ledger-entry) "Must at least provide client when updating ledger")
|
||||
;; TODO these are not always true
|
||||
;; (assert (every? :journal-entry-line/account (:journal-entry/line-items ledger-entry)) "must at least provide account when updating ledger")
|
||||
;; (assert (every? :journal-entry-line/location (:journal-entry/line-items ledger-entry)) "Must at least provide location when updating ledger")
|
||||
(let [extant-entry (or (when-let [original-entity (:journal-entry/original-entity ledger-entry)]
|
||||
(dc/pull db extant-read [:journal-entry/original-entity original-entity]))
|
||||
(when-let [external-id (:journal-entry/external-id ledger-entry)]
|
||||
(dc/pull db extant-read [:journal-entry/external-id external-id])))
|
||||
extant-entry-exists? (:db/id extant-entry)]
|
||||
|
||||
(cond->
|
||||
[[:upsert-entity (into (-> ledger-entry
|
||||
(assoc :db/id (or
|
||||
(:db/id ledger-entry)
|
||||
(:db/id extant-entry)
|
||||
(-random-tempid)))
|
||||
(update :journal-entry/line-items
|
||||
(fn [lis]
|
||||
(mapv #(-> %
|
||||
(assoc :journal-entry-line/dirty true)
|
||||
(assoc :journal-entry-line/client+account+location+date
|
||||
(calc-client+account+location+date ledger-entry %)))
|
||||
lis))))
|
||||
)]]
|
||||
extant-entry-exists? (into (map (fn [li]
|
||||
{:journal-entry-line/dirty true
|
||||
:db/id li})
|
||||
(get-line-items-after db extant-entry))))))
|
||||
|
||||
86
iol_ion/src/iol_ion/tx/upsert_transaction.clj
Normal file
86
iol_ion/src/iol_ion/tx/upsert_transaction.clj
Normal file
@@ -0,0 +1,86 @@
|
||||
(ns iol-ion.tx.upsert-transaction
|
||||
(:require [datomic.api :as dc]))
|
||||
|
||||
(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 transaction->journal-entry
|
||||
[db transaction-id raw-transaction-id]
|
||||
(let [entity (dc/pull db [:transaction/client
|
||||
:transaction/date
|
||||
:transaction/description-original
|
||||
:db/id
|
||||
:transaction/vendor
|
||||
:transaction/amount
|
||||
:transaction/cleared-against
|
||||
{:transaction/accounts [:transaction-account/account
|
||||
:transaction-account/location
|
||||
:transaction-account/amount]
|
||||
:transaction/approval-status [:db/ident]
|
||||
:transaction/bank-account [:db/id {:bank-account/type [:db/ident]}]}]
|
||||
transaction-id)
|
||||
decreasing? (< (or (:transaction/amount entity) 0.0) 0.0)
|
||||
credit-from-bank? decreasing?
|
||||
debit-from-bank? (not decreasing?)]
|
||||
(when (and (not (= :transaction-approval-status/excluded (:db/ident (:transaction/approval-status entity))))
|
||||
(not (= :transaction-approval-status/suppressed (:db/ident (:transaction/approval-status entity))))
|
||||
(:transaction/amount entity)
|
||||
(not (< -0.001 (:transaction/amount entity) 0.001)))
|
||||
(-remove-nils
|
||||
{:journal-entry/source "transaction"
|
||||
:journal-entry/client (:db/id (:transaction/client entity))
|
||||
:journal-entry/date (:transaction/date entity)
|
||||
:journal-entry/original-entity raw-transaction-id
|
||||
:journal-entry/alternate-description (:transaction/description-original entity)
|
||||
:journal-entry/vendor (:db/id (:transaction/vendor entity))
|
||||
:journal-entry/amount (Math/abs (:transaction/amount entity))
|
||||
: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))
|
||||
:db/id (str raw-transaction-id "-" 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-indexed
|
||||
(fn [i a]
|
||||
(-remove-nils{
|
||||
:db/id (str raw-transaction-id "-" (inc i))
|
||||
:journal-entry-line/account (:db/id (:transaction-account/account a))
|
||||
:journal-entry-line/location (:transaction-account/location a)
|
||||
:journal-entry-line/debit (when credit-from-bank?
|
||||
(Math/abs (:transaction-account/amount a)))
|
||||
:journal-entry-line/credit (when debit-from-bank?
|
||||
(Math/abs (:transaction-account/amount a)))}))
|
||||
(if (seq (:transaction/accounts entity))
|
||||
(:transaction/accounts entity)
|
||||
[{:transaction-account/amount (:transaction/amount entity)}])))
|
||||
|
||||
:journal-entry/cleared true}))))
|
||||
|
||||
(defn upsert-transaction [db transaction]
|
||||
;; because some transactions will reference temp ids, you have to dissoc them, like :transaction/payment
|
||||
(let [upserted-entity [[:upsert-entity (dissoc transaction :transaction/payment :import-batch/_entry)]]
|
||||
with-transaction (dc/with db upserted-entity)
|
||||
transaction-id (or (-> with-transaction :tempids (get (:db/id transaction)))
|
||||
(:db/id transaction))
|
||||
journal-entry (transaction->journal-entry (:db-after with-transaction)
|
||||
transaction-id
|
||||
(:db/id transaction))]
|
||||
(into [[:upsert-entity transaction]]
|
||||
(if journal-entry
|
||||
[[:upsert-ledger journal-entry]]
|
||||
[[:db/retractEntity [:journal-entry/original-entity (:db/id transaction)]]]))))
|
||||
|
||||
36
iol_ion/src/iol_ion/utils.clj
Normal file
36
iol_ion/src/iol_ion/utils.clj
Normal file
@@ -0,0 +1,36 @@
|
||||
(ns iol-ion.utils
|
||||
(:require [datomic.api :as dc])
|
||||
(:import [java.util UUID]))
|
||||
|
||||
(defn random-tempid []
|
||||
(str (UUID/randomUUID)))
|
||||
|
||||
(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)))
|
||||
|
||||
(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)))
|
||||
Reference in New Issue
Block a user