notid/integreat
1
0
Fork 0
Code Issues Pull Requests 2 Actions Packages Projects Releases Wiki Activity

merged

Browse Source
This commit is contained in:
Bryce
2024-10-22 22:52:40 -07:00
parent b31bffd5e8 e3fe08ce9f
commit 12baf70d5c
4 changed files with 362 additions and 370 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
resources/public/output.css
View File

File diff suppressed because one or more lines are too long

1
src/clj/auto_ap/handler.clj
View File

@@ -316,7 +316,6 @@
:valid-trimmed-client-ids trimmed-clients :valid-trimmed-client-ids trimmed-clients
:first-client-id (first valid-clients) :first-client-id (first valid-clients)
:clients-trimmed? (not= (count trimmed-clients) (count valid-clients))))))) :clients-trimmed? (not= (count trimmed-clients) (count valid-clients)))))))
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]} #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defonce app (defonce app
(-> route-handler (-> route-handler

30
src/clj/auto_ap/server.clj
View File

@@ -35,19 +35,23 @@
(defn gzip-handler [] (defn gzip-handler []
(doto (GzipHandler.) (let [gz (GzipHandler.)]
(.setIncludedMimeTypes (into-array ["text/css" (doto gz
"text/plain" (.setIncludedMethods (into-array ["GET" "POST" "PUT" "DELETE" "PATCH"]))
"text/javascript" (.setIncludedMimeTypes (into-array ["text/css"
"text/csv" "text/*"
"text/html" "text/plain"
"text/html;charset=utf-8" "text/javascript"
"application/javascript" "text/csv"
"application/csv" "text/html"
"application/edn" "text/html;charset=utf-8"
"application/json" "application/javascript"
"image/svg+xml"])) "application/csv"
(.setMinGzipSize 1024))) "application/edn"
"application/json"
"image/svg+xml"]))
(.setMinGzipSize 1024))
gz))
(defn configure-jetty [server] (defn configure-jetty [server]
(let [stats-handler (StatisticsHandler.) (let [stats-handler (StatisticsHandler.)

699
src/clj/auto_ap/ssr/ledger.clj
View File

@@ -44,7 +44,8 @@
[hiccup2.core :as hiccup] [hiccup2.core :as hiccup]
[iol-ion.utils :refer [by random-tempid]] [iol-ion.utils :refer [by random-tempid]]
[malli.core :as mc] [malli.core :as mc]
[slingshot.slingshot :refer [throw+]])) [slingshot.slingshot :refer [throw+]]
[clojure.string :as str]))
@@ -136,93 +137,111 @@
(fc/with-field :table (fc/with-field :table
(when (seq (fc/field-value)) (when (seq (fc/field-value))
[:form {:hx-post (bidi.bidi/path-for ssr-routes/only-routes ::route/external-import-import) [:div {:x-data (hx/json { "showTable" false})}
} [:form {:hx-post (bidi.bidi/path-for ssr-routes/only-routes ::route/external-import-import)
(com/data-grid-card {:id "ledger-import-data" :autocomplete "off" }
:route nil (when (:just-parsed? request)
:title "Data to import" [:div (hx/htmx-transition-appear {:class "bg-green-50 text-green-700 rounded p-4 m-2 max-w-screen-2xl"})
:paginate? false (format "Your data has been parsed. %,d rows found." (count (fc/field-value)))])
:headers [(com/data-grid-header {} "Id") [:div.flex.gap-4.items-center
(com/data-grid-header {} "Client") (com/checkbox {"@click" "showTable=!showTable"}
(com/data-grid-header {} "Source") "Show table")
(com/data-grid-header {} "Vendor Id") (com/button {:color :primary} "Import")]
(com/data-grid-header {} "Date") [:div { :x-show "showTable"}
(com/data-grid-header {} "Account Code") (com/data-grid-card {:id "ledger-import-data"
(com/data-grid-header {} "Location") :route nil
(com/data-grid-header {} "Debit") :title "Data to import"
(com/data-grid-header {} "Credit") :paginate? false
(com/data-grid-header {} "")] :headers [(com/data-grid-header {} "Id")
:rows (com/data-grid-header {} "Client")
(fc/cursor-map (com/data-grid-header {} "Source")
(fn [r] (com/data-grid-header {} "Vendor Id")
(com/data-grid-row {} (com/data-grid-cell {} (com/data-grid-header {} "Date")
(fc/with-field :external-id (com/data-grid-header {} "Account Code")
(com/validated-field (com/data-grid-header {} "Location")
{:errors (fc/field-errors)} (com/data-grid-header {} "Debit")
(com/text-input {:value (fc/field-value) (com/data-grid-header {} "Credit")
:name (fc/field-name)})))) (com/data-grid-header {} "")]
(com/data-grid-cell {} :rows
(fc/with-field :client-code (fc/cursor-map
(com/validated-field (fn [r]
{:errors (fc/field-errors)} (com/data-grid-row {} (com/data-grid-cell {}
(com/text-input {:value (fc/field-value) (fc/with-field :external-id
:name (fc/field-name) (com/validated-field
:class "w-24"})))) {:errors (fc/field-errors)}
(com/data-grid-cell {} (com/text-input {:value (fc/field-value)
(fc/with-field :source :name (fc/field-name)}))))
(com/validated-field (com/data-grid-cell {}
{:errors (fc/field-errors)} (fc/with-field :client-code
(com/text-input (com/validated-field
{:value (fc/field-value) {:errors (fc/field-errors)}
:name (fc/field-name)})))) (com/text-input {:value (fc/field-value)
(com/data-grid-cell {} (fc/with-field :vendor-name :name (fc/field-name)
(com/validated-field :class "w-24"}))))
{:errors (fc/field-errors)} (com/data-grid-cell {}
(com/text-input {:value (fc/field-value) (fc/with-field :source
:name (fc/field-name)})))) (com/validated-field
(com/data-grid-cell {} (fc/with-field :date {:errors (fc/field-errors)}
(com/validated-field (com/text-input
{:errors (fc/field-errors)} {:value (fc/field-value)
(com/date-input {:value (some-> (fc/field-value) (atime/unparse-local :name (fc/field-name)}))))
atime/normal-date)) (com/data-grid-cell {} (fc/with-field :vendor-name
:name (fc/field-name) (com/validated-field
:class "w-24"})))) {:errors (fc/field-errors)}
(com/data-grid-cell {} (com/text-input {:value (fc/field-value)
(fc/with-field :account-code :name (fc/field-name)}))))
(com/validated-field {:errors (fc/field-errors)} (com/data-grid-cell {} (fc/with-field :date
(com/text-input {:value (fc/field-value) (com/validated-field
:name (fc/field-name) {:errors (fc/field-errors)}
:class "w-16"})))) (com/text-input {:value (some-> (fc/field-value) (atime/unparse-local
(com/data-grid-cell {} (fc/with-field :location atime/normal-date))
(com/validated-field :name (fc/field-name)
{:errors (fc/field-errors)} :class "w-24"}))))
(com/text-input {:value (fc/field-value) (com/data-grid-cell {}
:name (fc/field-name) (fc/with-field :account-code
:size 2})))) (com/validated-field {:errors (fc/field-errors)}
(com/data-grid-cell {} (fc/with-field :debit (com/text-input {:value (fc/field-value)
(com/validated-field {:errors (fc/field-errors)} :name (fc/field-name)
(com/money-input {:value (fc/field-value) :class "w-16"}))))
:name (fc/field-name) (com/data-grid-cell {} (fc/with-field :location
:class "w-24"})))) (com/validated-field
(com/data-grid-cell {} (fc/with-field :credit {:errors (fc/field-errors)}
(com/validated-field {:errors (fc/field-errors)} (com/text-input {:value (fc/field-value)
(com/money-input {:value (fc/field-value) :name (fc/field-name)
:name (fc/field-name) :size 2}))))
:class "w-24"})))) (com/data-grid-cell {} (fc/with-field :debit
(com/data-grid-cell {:class "align-top"} (com/validated-field {:errors (fc/field-errors)}
[:div.p-2 (com/money-input {:value (fc/field-value)
(cond (seq (fc/field-errors)) :name (fc/field-name)
[:div :class "w-24"}))))
{ :x-tooltip (hx/json (pr-str (fc/field-errors)))} (com/data-grid-cell {} (fc/with-field :credit
[:div.w-8.h-8.bg-red-50.rounded-full.p-2.text-red-300.flex.items-start (com/validated-field {:errors (fc/field-errors)}
{ :x-ref "source"} (com/money-input {:value (fc/field-value)
svg/alert] ] :name (fc/field-name)
:else :class "w-24"}))))
nil) (com/data-grid-cell {:class "align-top"}
]))))} [:div.p-2
(let [errors (seq (fc/field-errors))]
[:div.flex.m-4.flex-row-reverse (cond errors
(com/button {:color :primary} "Import")])])))]) [: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] (defn external-import-text-form* [request]
(fc/start-form (fc/start-form
@@ -242,10 +261,16 @@
(defn external-import-form* [request] (defn external-import-form* [request]
[:div#forms {:hx-target "this" [:div#forms {:hx-target "this"
:hx-swap "outerHTML"} :hx-swap "outerHTML"}
(when (seq (:form-errors request)) (when (and (not (:just-parsed? request))
(com/form-errors {:errors ["Errors prevented the entries from being imported."]})) (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-text-form* request)
(external-import-table-form* request)]) (external-import-table-form* request)])
(defn external-import-page [request] (defn external-import-page [request]
@@ -291,20 +316,21 @@
(:title grid-spec) (:title grid-spec)
((:title grid-spec) request))) ((: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] (defn tsv->import-data [data]
(if (string? data) (if (string? data)
(with-open [r (io/reader (char-array 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)) data))
(def account-schema (mc/schema [:orn (def account-schema (mc/schema [:orn
@@ -312,10 +338,12 @@
[:bank-account [:bank-account
[:string]]])) [:string]]]))
(def parse-form-schema (mc/schema (def parse-form-schema (mc/schema
[:map [:map
[:table {:min 1 :error/message "Clipboard should contain rows to import" [:table {:min 1 :error/message "Clipboard should contain rows to import"
:decode/string tsv->import-data} :decode/string tsv->import-data }
[:vector {:coerce? true} [:vector {:coerce? true}
[:map { :decode/arbitrary (fn [t] [:map { :decode/arbitrary (fn [t]
(if (vector? t) (if (vector? t)
@@ -338,8 +366,8 @@
[:location [:string { :min 1 [:location [:string { :min 1
:max 2 :max 2
:decode/string strip}]] :decode/string strip}]]
[:debit money] [:debit [:maybe money]]
[:credit money] [:credit [:maybe money]]
]] ]]
#_[:string {:decode/string tsv->import-data #_[:string {:decode/string tsv->import-data
:error/message "Clipboard should contain rows to import"}]] ])) :error/message "Clipboard should contain rows to import"}]] ]))
@@ -350,36 +378,187 @@
(defn external-import-parse [request] (defn external-import-parse [request]
(html-response (html-response
( external-import-form* request))) ( external-import-form* (assoc request :just-parsed? true))))
(defn line->id [{:keys [source external-id client-code]}] (defn line->id [{:keys [source external-id client-code]}]
(str client-code "-" source "-" external-id)) (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)] (let [lines-with-indexes (for [[i l] (map vector (range) table)]
(assoc l :index i)) ] (assoc l :index i)) ]
(into [] (into []
(for [ (for [
[_ lines] (group-by line->id lines-with-indexes) [_ lines] (group-by line->id lines-with-indexes)
:let [{:keys [source client-code date vendor-name note cleared-against] :as line} (first lines)]] :let [{:keys [source client-code date vendor-name note cleared-against] :as line} (first lines)]]
{:source source (add-errors {:source source
:indices (map :index lines) :indices (map :index lines)
:external-id (line->id line) :external-id (line->id line)
:client-code client-code :client-code client-code
:date date :date date
:note note :note note
:cleared-against cleared-against :cleared-against cleared-against
:vendor-name vendor-name :vendor-name vendor-name
:amount (reduce + 0 :amount (reduce + 0
(->> lines (->> lines
(map :debit))) (map #(or (:debit %) 0.0))))
:line-items (map (fn [{:keys [debit credit account-code location index]}] :line-items (map (fn [{:keys [debit credit account-code location index]}]
{:account-code account-code {:account-code account-code
:index index :index index
:location location :location location
:debit debit :debit debit
:credit credit}) :credit credit})
lines)})))) 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] (defn import-ledger [request]
(assert-admin (:identity request)) (assert-admin (:identity request))
@@ -414,7 +593,7 @@
(fn [acc [code ba-code]] (fn [acc [code ba-code]]
(update acc code (fnil conj #{}) ba-code)) (update acc code (fnil conj #{}) ba-code))
{}))) {})))
all-client-locations (mu/trace ::get-all-client-locations all-client-locations (mu/trace ::get-all-client-locations
[] []
(->> (dc/q '[:find ?code ?location (->> (dc/q '[:find ?code ?location
@@ -426,7 +605,7 @@
(fn [acc [code ba-code]] (fn [acc [code ba-code]]
(update acc code (fnil conj #{"HQ" "A"}) ba-code)) (update acc code (fnil conj #{"HQ" "A"}) ba-code))
{}))) {})))
new-hidden-vendors (reduce new-hidden-vendors (reduce
(fn [new-vendors {:keys [vendor-name]}] (fn [new-vendors {:keys [vendor-name]}]
(if (or (all-vendors vendor-name) (if (or (all-vendors vendor-name)
@@ -450,242 +629,50 @@
(pull-many (dc/db conn) [:db/id :vendor/name]) (pull-many (dc/db conn) [:db/id :vendor/name])
(by :vendor/name)) (by :vendor/name))
all-accounts (mu/trace ::get-all-accounts [] all-accounts (mu/trace ::get-all-accounts []
(transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts))) (transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts)))
entries (table->entries (:table (:form-params request))) entries (table->entries (:table (:form-params request)) all-vendors all-accounts client-locked-lookup all-client-bank-accounts all-client-locations)
errors (->> entries errors (flatten-errors entries)
(mapcat ignored-entries (filter (fn [e] (= #{:warn} (entry-error-types e))) entries)
(fn [entry] good-entries (filter (fn [e] (and (not (:error (entry-error-types e))) (not (:warn (entry-error-types e))))) entries)
(let [vendor (all-vendors (:vendor-name entry)) bad-entries (filter (fn [e] (:error (entry-error-types e))) entries)
locked-until (client-locked-lookup (:client-code entry)) form-errors (reduce (fn [acc [path m status]]
all-row-error (fn [error-message] (update-in acc path conj [ m status]))
(map (fn [i] {}
[[:table i] error-message]) errors)
(:indices entry))) _ (when (seq bad-entries)
row-error (fn [ea error-message] (alog/info ::ledger-import-errors :errors errors)
[ [: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)
(throw+ (ex-info "ledger import errors" (throw+ (ex-info "ledger import errors"
{:type :field-validation {:type :field-validation
:form-errors errors :form-errors form-errors
:form-params form-params}) )) :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)]]) retraction (mapv (fn [x] [:db/retractEntity [:journal-entry/external-id (:external-id x)]])
success) good-entries)
ignore-retraction (->> ignored ignore-retraction (->> ignored-entries
(map :external-id ) (map :external-id)
(dc/q '[:find ?je (dc/q '[:find ?je
:in $ [?ei ...] :in $ [?ei ...]
:where [?je :journal-entry/external-id ?ei]] :where [?je :journal-entry/external-id ?ei]]
(dc/db conn) (dc/db conn))
)
(map first) (map first)
(map (fn [je] [:db/retractEntity je])))] (map (fn [je] [:db/retractEntity je])))]
(alog/info ::manual-import (alog/info ::manual-import
:errors (count errors) :errors (count errors)
:sample (take 3 errors)) :sample (take 3 errors))
(mu/trace ::retraction-tx (mu/trace ::retraction-tx
[:count (count retraction)] [:count (count retraction)]
(audit-transact-batch retraction (:identity request))) (audit-transact-batch retraction (:identity request)))
(mu/trace ::ignore-retraction-tx (mu/trace ::ignore-retraction-tx
[:count (count ignore-retraction)] [:count (count ignore-retraction)]
(when (seq ignore-retraction) (when (seq ignore-retraction)
(audit-transact-batch ignore-retraction (:identity request)))) (audit-transact-batch ignore-retraction (:identity request))))
(let [invalidated (let [transaction (mu/trace ::build-transaction
[:count (count (:table form-params))]
(doall (map #(entry->tx % all-vendors) good-entries)))
invalidated
(mu/trace ::success-tx (mu/trace ::success-tx
[:count (count success)] [:count (count good-entries)]
(for [[_ n] (:tempids (audit-transact-batch (map :tx success) (:identity request)))] (for [[_ n] (:tempids (audit-transact-batch transaction (:identity request)))]
n))] n))]
(future ; (future ;
(mu/log ::indexing-solr :count (count invalidated)) (mu/log ::indexing-solr :count (count invalidated))
@@ -693,15 +680,17 @@
[:count (count invalidated)] [:count (count invalidated)]
(doseq [n invalidated] (doseq [n invalidated]
(solr/touch n))))) (solr/touch n)))))
{:successful (count success) {:successful (count good-entries)
:ignored (count ignored) })) :ignored (count ignored-entries)
:form-errors form-errors}))
(defn external-import-import [request] (defn external-import-import [request]
(html-response (let [result (import-ledger request)]
[:div (html-response
(external-import-form* request)] [:div
:headers {"hx-trigger" (hx/json { "notification" (pr-str (import-ledger request))})})) (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))})})))