merged
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -316,7 +316,6 @@
|
||||
:valid-trimmed-client-ids trimmed-clients
|
||||
:first-client-id (first valid-clients)
|
||||
:clients-trimmed? (not= (count trimmed-clients) (count valid-clients)))))))
|
||||
|
||||
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
|
||||
(defonce app
|
||||
(-> route-handler
|
||||
|
||||
@@ -35,19 +35,23 @@
|
||||
|
||||
|
||||
(defn gzip-handler []
|
||||
(doto (GzipHandler.)
|
||||
(.setIncludedMimeTypes (into-array ["text/css"
|
||||
"text/plain"
|
||||
"text/javascript"
|
||||
"text/csv"
|
||||
"text/html"
|
||||
"text/html;charset=utf-8"
|
||||
"application/javascript"
|
||||
"application/csv"
|
||||
"application/edn"
|
||||
"application/json"
|
||||
"image/svg+xml"]))
|
||||
(.setMinGzipSize 1024)))
|
||||
(let [gz (GzipHandler.)]
|
||||
(doto gz
|
||||
(.setIncludedMethods (into-array ["GET" "POST" "PUT" "DELETE" "PATCH"]))
|
||||
(.setIncludedMimeTypes (into-array ["text/css"
|
||||
"text/*"
|
||||
"text/plain"
|
||||
"text/javascript"
|
||||
"text/csv"
|
||||
"text/html"
|
||||
"text/html;charset=utf-8"
|
||||
"application/javascript"
|
||||
"application/csv"
|
||||
"application/edn"
|
||||
"application/json"
|
||||
"image/svg+xml"]))
|
||||
(.setMinGzipSize 1024))
|
||||
gz))
|
||||
|
||||
(defn configure-jetty [server]
|
||||
(let [stats-handler (StatisticsHandler.)
|
||||
|
||||
@@ -44,7 +44,8 @@
|
||||
[hiccup2.core :as hiccup]
|
||||
[iol-ion.utils :refer [by random-tempid]]
|
||||
[malli.core :as mc]
|
||||
[slingshot.slingshot :refer [throw+]]))
|
||||
[slingshot.slingshot :refer [throw+]]
|
||||
[clojure.string :as str]))
|
||||
|
||||
|
||||
|
||||
@@ -136,93 +137,111 @@
|
||||
(fc/with-field :table
|
||||
(when (seq (fc/field-value))
|
||||
|
||||
[:form {:hx-post (bidi.bidi/path-for ssr-routes/only-routes ::route/external-import-import)
|
||||
}
|
||||
(com/data-grid-card {:id "ledger-import-data"
|
||||
:route nil
|
||||
:title "Data to import"
|
||||
:paginate? false
|
||||
:headers [(com/data-grid-header {} "Id")
|
||||
(com/data-grid-header {} "Client")
|
||||
(com/data-grid-header {} "Source")
|
||||
(com/data-grid-header {} "Vendor Id")
|
||||
(com/data-grid-header {} "Date")
|
||||
(com/data-grid-header {} "Account Code")
|
||||
(com/data-grid-header {} "Location")
|
||||
(com/data-grid-header {} "Debit")
|
||||
(com/data-grid-header {} "Credit")
|
||||
(com/data-grid-header {} "")]
|
||||
:rows
|
||||
(fc/cursor-map
|
||||
(fn [r]
|
||||
(com/data-grid-row {} (com/data-grid-cell {}
|
||||
(fc/with-field :external-id
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)}))))
|
||||
(com/data-grid-cell {}
|
||||
(fc/with-field :client-code
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {}
|
||||
(fc/with-field :source
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input
|
||||
{:value (fc/field-value)
|
||||
:name (fc/field-name)}))))
|
||||
(com/data-grid-cell {} (fc/with-field :vendor-name
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)}))))
|
||||
(com/data-grid-cell {} (fc/with-field :date
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/date-input {:value (some-> (fc/field-value) (atime/unparse-local
|
||||
atime/normal-date))
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {}
|
||||
(fc/with-field :account-code
|
||||
(com/validated-field {:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-16"}))))
|
||||
(com/data-grid-cell {} (fc/with-field :location
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:size 2}))))
|
||||
(com/data-grid-cell {} (fc/with-field :debit
|
||||
(com/validated-field {:errors (fc/field-errors)}
|
||||
(com/money-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {} (fc/with-field :credit
|
||||
(com/validated-field {:errors (fc/field-errors)}
|
||||
(com/money-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {:class "align-top"}
|
||||
[:div.p-2
|
||||
(cond (seq (fc/field-errors))
|
||||
[:div
|
||||
{ :x-tooltip (hx/json (pr-str (fc/field-errors)))}
|
||||
[:div.w-8.h-8.bg-red-50.rounded-full.p-2.text-red-300.flex.items-start
|
||||
{ :x-ref "source"}
|
||||
svg/alert] ]
|
||||
:else
|
||||
nil)
|
||||
]))))}
|
||||
|
||||
[:div.flex.m-4.flex-row-reverse
|
||||
(com/button {:color :primary} "Import")])])))])
|
||||
[:div {:x-data (hx/json { "showTable" false})}
|
||||
[:form {:hx-post (bidi.bidi/path-for ssr-routes/only-routes ::route/external-import-import)
|
||||
:autocomplete "off" }
|
||||
(when (:just-parsed? request)
|
||||
[:div (hx/htmx-transition-appear {:class "bg-green-50 text-green-700 rounded p-4 m-2 max-w-screen-2xl"})
|
||||
(format "Your data has been parsed. %,d rows found." (count (fc/field-value)))])
|
||||
[:div.flex.gap-4.items-center
|
||||
(com/checkbox {"@click" "showTable=!showTable"}
|
||||
"Show table")
|
||||
(com/button {:color :primary} "Import")]
|
||||
[:div { :x-show "showTable"}
|
||||
(com/data-grid-card {:id "ledger-import-data"
|
||||
:route nil
|
||||
:title "Data to import"
|
||||
:paginate? false
|
||||
:headers [(com/data-grid-header {} "Id")
|
||||
(com/data-grid-header {} "Client")
|
||||
(com/data-grid-header {} "Source")
|
||||
(com/data-grid-header {} "Vendor Id")
|
||||
(com/data-grid-header {} "Date")
|
||||
(com/data-grid-header {} "Account Code")
|
||||
(com/data-grid-header {} "Location")
|
||||
(com/data-grid-header {} "Debit")
|
||||
(com/data-grid-header {} "Credit")
|
||||
(com/data-grid-header {} "")]
|
||||
:rows
|
||||
(fc/cursor-map
|
||||
(fn [r]
|
||||
(com/data-grid-row {} (com/data-grid-cell {}
|
||||
(fc/with-field :external-id
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)}))))
|
||||
(com/data-grid-cell {}
|
||||
(fc/with-field :client-code
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {}
|
||||
(fc/with-field :source
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input
|
||||
{:value (fc/field-value)
|
||||
:name (fc/field-name)}))))
|
||||
(com/data-grid-cell {} (fc/with-field :vendor-name
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)}))))
|
||||
(com/data-grid-cell {} (fc/with-field :date
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (some-> (fc/field-value) (atime/unparse-local
|
||||
atime/normal-date))
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {}
|
||||
(fc/with-field :account-code
|
||||
(com/validated-field {:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-16"}))))
|
||||
(com/data-grid-cell {} (fc/with-field :location
|
||||
(com/validated-field
|
||||
{:errors (fc/field-errors)}
|
||||
(com/text-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:size 2}))))
|
||||
(com/data-grid-cell {} (fc/with-field :debit
|
||||
(com/validated-field {:errors (fc/field-errors)}
|
||||
(com/money-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {} (fc/with-field :credit
|
||||
(com/validated-field {:errors (fc/field-errors)}
|
||||
(com/money-input {:value (fc/field-value)
|
||||
:name (fc/field-name)
|
||||
:class "w-24"}))))
|
||||
(com/data-grid-cell {:class "align-top"}
|
||||
[:div.p-2
|
||||
(let [errors (seq (fc/field-errors))]
|
||||
(cond errors
|
||||
[:div
|
||||
{}
|
||||
[:div.w-8.h-8.rounded-full.p-2.flex.items-start {:class
|
||||
(if (seq (filter
|
||||
(fn [[_ status]]
|
||||
|
||||
(= :error status))
|
||||
errors))
|
||||
"bg-red-50 text-red-300"
|
||||
"bg-yellow-100 text-yellow-600")}
|
||||
svg/alert]
|
||||
[:ul
|
||||
(for [[m] errors]
|
||||
[:li m])]]
|
||||
:else
|
||||
nil))]))))}
|
||||
|
||||
[:div.flex.m-4.flex-row-reverse
|
||||
(com/button {:color :primary} "Import")])]]])))])
|
||||
|
||||
(defn external-import-text-form* [request]
|
||||
(fc/start-form
|
||||
@@ -242,10 +261,16 @@
|
||||
(defn external-import-form* [request]
|
||||
[:div#forms {:hx-target "this"
|
||||
:hx-swap "outerHTML"}
|
||||
(when (seq (:form-errors request))
|
||||
(com/form-errors {:errors ["Errors prevented the entries from being imported."]}))
|
||||
(when (and (not (:just-parsed? request))
|
||||
(seq (->> (:form-errors request)
|
||||
:table
|
||||
vals
|
||||
(mapcat identity)
|
||||
(map last)
|
||||
(filter #{:error}))))
|
||||
(com/form-errors {:errors ["Errors prevented the entries from being imported."]}))
|
||||
(external-import-text-form* request)
|
||||
|
||||
|
||||
(external-import-table-form* request)])
|
||||
|
||||
(defn external-import-page [request]
|
||||
@@ -291,20 +316,21 @@
|
||||
(:title grid-spec)
|
||||
((:title grid-spec) request)))
|
||||
)
|
||||
(defn assoc-error [f]
|
||||
(fn [entry]
|
||||
(try
|
||||
(f entry)
|
||||
(catch Exception e
|
||||
(assoc entry :error (.getMessage e)
|
||||
:status (or (:status (ex-data e))
|
||||
:error))))))
|
||||
|
||||
|
||||
(defn trim-header [t]
|
||||
(if (->> t
|
||||
first
|
||||
(map clojure.string/lower-case )
|
||||
(filter #{"id" "client" "source" "vendor" "date" "account" "location" "debit"})
|
||||
seq)
|
||||
(drop 1 t)
|
||||
t))
|
||||
|
||||
(defn tsv->import-data [data]
|
||||
(if (string? data)
|
||||
(with-open [r (io/reader (char-array data))]
|
||||
(into [] (csv/read-csv r :separator \tab)))
|
||||
(into [] (trim-header (csv/read-csv r :separator \tab))))
|
||||
data))
|
||||
|
||||
(def account-schema (mc/schema [:orn
|
||||
@@ -312,10 +338,12 @@
|
||||
[:bank-account
|
||||
[:string]]]))
|
||||
|
||||
|
||||
|
||||
(def parse-form-schema (mc/schema
|
||||
[:map
|
||||
[:map
|
||||
[:table {:min 1 :error/message "Clipboard should contain rows to import"
|
||||
:decode/string tsv->import-data}
|
||||
:decode/string tsv->import-data }
|
||||
[:vector {:coerce? true}
|
||||
[:map { :decode/arbitrary (fn [t]
|
||||
(if (vector? t)
|
||||
@@ -338,8 +366,8 @@
|
||||
[:location [:string { :min 1
|
||||
:max 2
|
||||
:decode/string strip}]]
|
||||
[:debit money]
|
||||
[:credit money]
|
||||
[:debit [:maybe money]]
|
||||
[:credit [:maybe money]]
|
||||
]]
|
||||
#_[:string {:decode/string tsv->import-data
|
||||
:error/message "Clipboard should contain rows to import"}]] ]))
|
||||
@@ -350,36 +378,187 @@
|
||||
|
||||
(defn external-import-parse [request]
|
||||
(html-response
|
||||
( external-import-form* request)))
|
||||
( external-import-form* (assoc request :just-parsed? true))))
|
||||
|
||||
(defn line->id [{:keys [source external-id client-code]}]
|
||||
(str client-code "-" source "-" external-id))
|
||||
|
||||
(defn table->entries [table]
|
||||
|
||||
(defn add-errors [entry all-vendors all-accounts client-locked-lookup all-client-bank-accounts all-client-locations]
|
||||
(let [vendor (all-vendors (:vendor-name entry))
|
||||
locked-until (client-locked-lookup (:client-code entry))
|
||||
all-row-error (fn all-row-error
|
||||
([error-message status]
|
||||
(update entry :errors conj [error-message status])
|
||||
#_(map (fn [i]
|
||||
[[:table i] error-message status])
|
||||
(:indices entry)))
|
||||
([error-message]
|
||||
(all-row-error error-message :error)))
|
||||
row-error (fn row-error
|
||||
([ea error-message]
|
||||
(row-error ea error-message :error))
|
||||
([ea error-message status]
|
||||
(update ea :errors conj [error-message status])
|
||||
#_[[:table (:index ea)] error-message status]))
|
||||
entry (cond
|
||||
(not locked-until)
|
||||
(all-row-error (str "Client '" (:client-code entry) "' not found."))
|
||||
|
||||
(not vendor)
|
||||
(all-row-error (str "Vendor '" (:vendor-name entry) "' not found."))
|
||||
|
||||
(and locked-until
|
||||
(and (not (t/after? (:date entry)
|
||||
(coerce/to-date-time locked-until)))
|
||||
(not (t/equal? (:date entry)
|
||||
(coerce/to-date-time locked-until)))))
|
||||
(all-row-error (str "Client's data is locked until " locked-until))
|
||||
(not (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line-items entry)))
|
||||
(reduce (fnil + 0.0 0.0) 0.0 (map :credit (:line-items entry)))))
|
||||
(all-row-error (str "Debits '"
|
||||
(reduce (fnil + 0.0 0.0) 0 (map :debit (:line-items entry)))
|
||||
"' and credits '"
|
||||
(reduce (fnil + 0.0 0.0) 0 (map :credit (:line-items entry)))
|
||||
"' do not add up."))
|
||||
(dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line-items entry)))
|
||||
0.0)
|
||||
(all-row-error (str "Cannot have ledger entries that total $0.00") :warn)
|
||||
|
||||
:else
|
||||
entry)]
|
||||
(update
|
||||
entry
|
||||
:line-items
|
||||
(fn [line-items]
|
||||
(map (fn li [ea]
|
||||
(let [debit (or (:debit ea) 0.0)
|
||||
credit (or (:credit ea) 0.0)
|
||||
matching-account (when (:account-code ea)
|
||||
(a/get-account-by-numeric-code-and-sets (:account-code ea) ["default"]))]
|
||||
(cond
|
||||
(and (not (get
|
||||
(get all-client-locations (:client-code entry))
|
||||
(:location ea)))
|
||||
(not= "A" (:location ea)))
|
||||
(row-error ea (str "Location '" (:location ea) "' not found."))
|
||||
(and (<= debit 0.0)
|
||||
(<= credit 0.0))
|
||||
(row-error ea (str "Line item amount " (or debit credit) " must be greater than 0.") :warn)
|
||||
(and
|
||||
(= :account-code (first (mc/parse account-schema (:account-code ea))))
|
||||
(not (all-accounts (str (:account-code ea)))))
|
||||
(row-error ea (str "Account '" (:account-code ea) "' not found."))
|
||||
|
||||
(and
|
||||
(= :bank-account (first (mc/parse account-schema (:account-code ea))))
|
||||
(not (get
|
||||
(get all-client-bank-accounts (:client-code entry))
|
||||
(:account-code ea))))
|
||||
(row-error ea (str "Bank Account '" (:account-code ea) "' not found."))
|
||||
|
||||
|
||||
(and matching-account
|
||||
(:account/location matching-account)
|
||||
(not= (:account/location matching-account)
|
||||
(:location ea)))
|
||||
(row-error ea (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' requires location '"
|
||||
(:account/location matching-account)
|
||||
"' but got '"
|
||||
(:location ea)
|
||||
"'"))
|
||||
(and matching-account
|
||||
(not (:account/location matching-account))
|
||||
(= "A" (:location ea)))
|
||||
(row-error ea (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' cannot use location '"
|
||||
(:location ea)
|
||||
"'"))
|
||||
:else
|
||||
ea)))
|
||||
line-items)))))
|
||||
|
||||
(defn table->entries [table all-vendors all-accounts client-locked-lookup all-client-bank-accounts all-client-locations]
|
||||
(let [lines-with-indexes (for [[i l] (map vector (range) table)]
|
||||
(assoc l :index i)) ]
|
||||
(into []
|
||||
(for [
|
||||
[_ lines] (group-by line->id lines-with-indexes)
|
||||
:let [{:keys [source client-code date vendor-name note cleared-against] :as line} (first lines)]]
|
||||
{:source source
|
||||
:indices (map :index lines)
|
||||
:external-id (line->id line)
|
||||
:client-code client-code
|
||||
:date date
|
||||
:note note
|
||||
:cleared-against cleared-against
|
||||
:vendor-name vendor-name
|
||||
:amount (reduce + 0
|
||||
(->> lines
|
||||
(map :debit)))
|
||||
:line-items (map (fn [{:keys [debit credit account-code location index]}]
|
||||
{:account-code account-code
|
||||
:index index
|
||||
:location location
|
||||
:debit debit
|
||||
:credit credit})
|
||||
lines)}))))
|
||||
(add-errors {:source source
|
||||
:indices (map :index lines)
|
||||
:external-id (line->id line)
|
||||
:client-code client-code
|
||||
:date date
|
||||
:note note
|
||||
:cleared-against cleared-against
|
||||
:vendor-name vendor-name
|
||||
:amount (reduce + 0
|
||||
(->> lines
|
||||
(map #(or (:debit %) 0.0))))
|
||||
:line-items (map (fn [{:keys [debit credit account-code location index]}]
|
||||
{:account-code account-code
|
||||
:index index
|
||||
:location location
|
||||
:debit debit
|
||||
:credit credit})
|
||||
lines)}
|
||||
all-vendors
|
||||
all-accounts
|
||||
client-locked-lookup
|
||||
all-client-bank-accounts
|
||||
all-client-locations)))))
|
||||
|
||||
(defn entry-errors [entry]
|
||||
(concat (:errors entry)
|
||||
(mapcat :errors (:line-items entry))))
|
||||
|
||||
(defn flatten-errors [entries]
|
||||
(for [entry entries
|
||||
:let [entry-errors (for [[error-message status] (:errors entry)
|
||||
index (:indices entry)]
|
||||
[[:table index] error-message status])
|
||||
line-item-errors (for [line-item (:line-items entry)
|
||||
[error-message status] (:errors line-item)]
|
||||
[[:table (:index line-item)] error-message status])]
|
||||
error (concat entry-errors line-item-errors)]
|
||||
error))
|
||||
|
||||
(defn entry-error-types [entry]
|
||||
(set (map (fn [[_ type]]
|
||||
type) (entry-errors entry))))
|
||||
|
||||
(defn entry->tx [entry all-vendors]
|
||||
[:upsert-ledger
|
||||
(remove-nils
|
||||
{:journal-entry/source (:source entry)
|
||||
:journal-entry/client [:client/code (:client-code entry)]
|
||||
:journal-entry/date (coerce/to-date (: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)
|
||||
matching-account (when (:account-code ea)
|
||||
(a/get-account-by-numeric-code-and-sets (:account-code ea) ["default"]))]
|
||||
(remove-nils (cond-> {:db/id (random-tempid)
|
||||
: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-code ea)])))))
|
||||
(:line-items entry))
|
||||
|
||||
:journal-entry/cleared true})])
|
||||
|
||||
(defn import-ledger [request]
|
||||
(assert-admin (:identity request))
|
||||
@@ -414,7 +593,7 @@
|
||||
(fn [acc [code ba-code]]
|
||||
(update acc code (fnil conj #{}) ba-code))
|
||||
{})))
|
||||
|
||||
|
||||
all-client-locations (mu/trace ::get-all-client-locations
|
||||
[]
|
||||
(->> (dc/q '[:find ?code ?location
|
||||
@@ -426,7 +605,7 @@
|
||||
(fn [acc [code ba-code]]
|
||||
(update acc code (fnil conj #{"HQ" "A"}) ba-code))
|
||||
{})))
|
||||
|
||||
|
||||
new-hidden-vendors (reduce
|
||||
(fn [new-vendors {:keys [vendor-name]}]
|
||||
(if (or (all-vendors vendor-name)
|
||||
@@ -450,242 +629,50 @@
|
||||
(pull-many (dc/db conn) [:db/id :vendor/name])
|
||||
(by :vendor/name))
|
||||
all-accounts (mu/trace ::get-all-accounts []
|
||||
(transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts)))
|
||||
entries (table->entries (:table (:form-params request)))
|
||||
errors (->> entries
|
||||
(mapcat
|
||||
(fn [entry]
|
||||
(let [vendor (all-vendors (:vendor-name entry))
|
||||
locked-until (client-locked-lookup (:client-code entry))
|
||||
all-row-error (fn [error-message]
|
||||
(map (fn [i]
|
||||
[[:table i] error-message])
|
||||
(:indices entry)))
|
||||
row-error (fn [ea error-message]
|
||||
[ [:table (:index ea)] error-message])
|
||||
|
||||
errors (cond
|
||||
(not locked-until)
|
||||
(all-row-error (str "Client '" (:client-code entry) "' not found."))
|
||||
|
||||
(not vendor)
|
||||
(all-row-error (str "Vendor '" (:vendor-name entry) "' not found."))
|
||||
|
||||
(and locked-until
|
||||
(and (not (t/after? (:date entry)
|
||||
(coerce/to-date-time locked-until)))
|
||||
(not (t/equal? (:date entry)
|
||||
(coerce/to-date-time locked-until)))))
|
||||
(all-row-error (str "Client's data is locked until " locked-until))
|
||||
|
||||
(not (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line-items entry)))
|
||||
(reduce (fnil + 0.0 0.0) 0.0 (map :credit (:line-items entry)))))
|
||||
(all-row-error (str "Debits '"
|
||||
(reduce (fnil + 0.0 0.0) 0 (map :debit (:line-items entry)))
|
||||
"' and credits '"
|
||||
(reduce (fnil + 0.0 0.0) 0 (map :credit (:line-items entry)))
|
||||
"' do not add up."))
|
||||
(dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line-items entry)))
|
||||
0.0)
|
||||
(all-row-error (str "Cannot have ledger entries that total $0.00"))
|
||||
|
||||
:else
|
||||
(map
|
||||
(fn [ea]
|
||||
(let [debit (or (:debit ea) 0.0)
|
||||
credit (or (:credit ea) 0.0)
|
||||
matching-account (when (:account-code ea)
|
||||
(a/get-account-by-numeric-code-and-sets (:account-code ea) ["default"]))]
|
||||
(cond
|
||||
(and (not (get
|
||||
(get all-client-locations (:client-code entry))
|
||||
(:location ea)))
|
||||
(not= "A" (:location ea)))
|
||||
(row-error ea (str "Location '" (:location ea) "' not found."))
|
||||
|
||||
(and (<= debit 0.0)
|
||||
(<= credit 0.0))
|
||||
(row-error ea (str "Line item amount " (or debit credit) " must be greater than 0."))
|
||||
|
||||
(and
|
||||
(= :account-code (first (mc/parse account-schema (:account-code ea))))
|
||||
(not (all-accounts (str (:account-code ea)))))
|
||||
(row-error ea (str "Account '" (:account-code ea) "' not found."))
|
||||
|
||||
(and
|
||||
(= :bank-account (first (mc/parse account-schema (:account-code ea))))
|
||||
(not (get
|
||||
(get all-client-bank-accounts (:client-code entry))
|
||||
(:account-code ea))))
|
||||
(row-error ea (str "Bank Account '" (:account-code ea) "' not found."))
|
||||
|
||||
|
||||
(and matching-account
|
||||
(:account/location matching-account)
|
||||
(not= (:account/location matching-account)
|
||||
(:location ea)))
|
||||
(row-error ea (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' requires location '"
|
||||
(:account/location matching-account)
|
||||
"' but got '"
|
||||
(:location ea)
|
||||
"'"))
|
||||
(and matching-account
|
||||
(not (:account/location matching-account))
|
||||
(= "A" (:location ea)))
|
||||
(row-error ea (str "Account '"
|
||||
(:account/numeric-code matching-account)
|
||||
"' cannot use location '"
|
||||
(:location ea)
|
||||
"'"))
|
||||
:else
|
||||
nil)))
|
||||
(:line-items entry))) ]
|
||||
errors
|
||||
)))
|
||||
(filter identity)
|
||||
(reduce (fn [acc [path m]]
|
||||
(assoc-in acc path m))
|
||||
{}))
|
||||
_ (when (seq errors)
|
||||
(transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts)))
|
||||
entries (table->entries (:table (:form-params request)) all-vendors all-accounts client-locked-lookup all-client-bank-accounts all-client-locations)
|
||||
errors (flatten-errors entries)
|
||||
ignored-entries (filter (fn [e] (= #{:warn} (entry-error-types e))) entries)
|
||||
good-entries (filter (fn [e] (and (not (:error (entry-error-types e))) (not (:warn (entry-error-types e))))) entries)
|
||||
bad-entries (filter (fn [e] (:error (entry-error-types e))) entries)
|
||||
form-errors (reduce (fn [acc [path m status]]
|
||||
(update-in acc path conj [ m status]))
|
||||
{}
|
||||
errors)
|
||||
_ (when (seq bad-entries)
|
||||
(alog/info ::ledger-import-errors :errors errors)
|
||||
(throw+ (ex-info "ledger import errors"
|
||||
{:type :field-validation
|
||||
:form-errors errors
|
||||
:form-params form-params}) ))
|
||||
{:type :field-validation
|
||||
:form-errors form-errors
|
||||
:form-params form-params})))
|
||||
|
||||
transaction (mu/trace ::build-transaction
|
||||
[:count (count (:table form-params))]
|
||||
(doall (map
|
||||
(assoc-error (fn [entry]
|
||||
(let [vendor (all-vendors (:vendor-name entry))]
|
||||
(when-not (client-locked-lookup (:client-code entry))
|
||||
(throw (ex-info (str "Client '" (:client-code entry ) "' not found.") {:status :error}) ))
|
||||
(when-not vendor
|
||||
(throw (ex-info (str "Vendor '" (:vendor-name entry) "' not found.") {:status :error})))
|
||||
(when-let [locked-until (client-locked-lookup (:client-code entry))]
|
||||
(when (and (not (t/after? (:date entry)
|
||||
(coerce/to-date-time locked-until)))
|
||||
(not (t/equal? (:date entry)
|
||||
(coerce/to-date-time locked-until))))
|
||||
(throw (ex-info (str "Client's data is locked until " locked-until) {:status :error}))))
|
||||
|
||||
(when-not (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line-items entry)))
|
||||
(reduce (fnil + 0.0 0.0) 0.0 (map :credit (:line-items entry))))
|
||||
(throw (ex-info (str "Debits '"
|
||||
(reduce (fnil + 0.0 0.0) 0 (map :debit (:line-items entry)))
|
||||
"' and credits '"
|
||||
(reduce (fnil + 0.0 0.0) 0 (map :credit (:line-items entry)))
|
||||
"' do not add up.")
|
||||
{:status :error})))
|
||||
(when (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line-items entry)))
|
||||
0.0)
|
||||
(throw (ex-info (str "Cannot have ledger entries that total $0.00")
|
||||
{:status :ignored})))
|
||||
(assoc entry
|
||||
:status :success
|
||||
:tx
|
||||
[:upsert-ledger
|
||||
(remove-nils
|
||||
{:journal-entry/source (:source entry)
|
||||
:journal-entry/client [:client/code (:client-code entry)]
|
||||
:journal-entry/date (coerce/to-date (: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
|
||||
(= :account-code (first (mc/parse account-schema (:account-code ea))))
|
||||
(not (all-accounts (str (:account-code ea)))))
|
||||
(throw (ex-info (str "Account '" (:account-code ea) "' not found.")
|
||||
{:status :error})))
|
||||
(when
|
||||
(and
|
||||
(= :bank-account (first (mc/parse account-schema (:account-code ea))))
|
||||
(not (get
|
||||
(get all-client-bank-accounts (:client-code entry))
|
||||
(:account-code ea))))
|
||||
(throw (ex-info (str "Bank Account '" (:account-code ea) "' not found.")
|
||||
{:status :error})))
|
||||
(let [matching-account (when (:account-code ea)
|
||||
(a/get-account-by-numeric-code-and-sets (:account-code 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-> {:db/id (random-tempid)
|
||||
: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-code ea)]))))))
|
||||
(:line-items entry))
|
||||
|
||||
:journal-entry/cleared true})]))))
|
||||
entries)))
|
||||
errors (filter #(= (:status %) :error) transaction)
|
||||
ignored (filter #(= (:status %) :ignored) transaction)
|
||||
success (filter #(= (:status %) :success) transaction)
|
||||
retraction (mapv (fn [x] [:db/retractEntity [:journal-entry/external-id (:external-id x)]])
|
||||
success)
|
||||
ignore-retraction (->> ignored
|
||||
(map :external-id )
|
||||
good-entries)
|
||||
ignore-retraction (->> ignored-entries
|
||||
(map :external-id)
|
||||
(dc/q '[:find ?je
|
||||
:in $ [?ei ...]
|
||||
:where [?je :journal-entry/external-id ?ei]]
|
||||
(dc/db conn)
|
||||
)
|
||||
(dc/db conn))
|
||||
(map first)
|
||||
(map (fn [je] [:db/retractEntity je])))]
|
||||
(alog/info ::manual-import
|
||||
:errors (count errors)
|
||||
:sample (take 3 errors))
|
||||
(mu/trace ::retraction-tx
|
||||
[:count (count retraction)]
|
||||
(audit-transact-batch retraction (:identity request)))
|
||||
[:count (count retraction)]
|
||||
(audit-transact-batch retraction (:identity request)))
|
||||
(mu/trace ::ignore-retraction-tx
|
||||
[:count (count ignore-retraction)]
|
||||
(when (seq ignore-retraction)
|
||||
(audit-transact-batch ignore-retraction (:identity request))))
|
||||
(let [invalidated
|
||||
[:count (count ignore-retraction)]
|
||||
(when (seq ignore-retraction)
|
||||
(audit-transact-batch ignore-retraction (:identity request))))
|
||||
(let [transaction (mu/trace ::build-transaction
|
||||
[:count (count (:table form-params))]
|
||||
(doall (map #(entry->tx % all-vendors) good-entries)))
|
||||
invalidated
|
||||
(mu/trace ::success-tx
|
||||
[:count (count success)]
|
||||
(for [[_ n] (:tempids (audit-transact-batch (map :tx success) (:identity request)))]
|
||||
[:count (count good-entries)]
|
||||
(for [[_ n] (:tempids (audit-transact-batch transaction (:identity request)))]
|
||||
n))]
|
||||
(future ;
|
||||
(mu/log ::indexing-solr :count (count invalidated))
|
||||
@@ -693,15 +680,17 @@
|
||||
[:count (count invalidated)]
|
||||
(doseq [n invalidated]
|
||||
(solr/touch n)))))
|
||||
|
||||
{:successful (count success)
|
||||
:ignored (count ignored) }))
|
||||
|
||||
{:successful (count good-entries)
|
||||
:ignored (count ignored-entries)
|
||||
:form-errors form-errors}))
|
||||
|
||||
(defn external-import-import [request]
|
||||
(html-response
|
||||
[:div
|
||||
(external-import-form* request)]
|
||||
:headers {"hx-trigger" (hx/json { "notification" (pr-str (import-ledger request))})}))
|
||||
(let [result (import-ledger request)]
|
||||
(html-response
|
||||
[:div
|
||||
(external-import-form* (assoc request :form-errors (:form-errors result)))]
|
||||
:headers {"hx-trigger" (hx/json { "notification" (format "%d successful, %d with warnings. Any ledger entries with warnings have been removed." (:successful result) (:ignored result))})})))
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user