742 lines
42 KiB
Clojure
742 lines
42 KiB
Clojure
(ns auto-ap.ssr.ledger
|
|
(:require
|
|
[auto-ap.datomic
|
|
:refer [audit-transact audit-transact-batch conn pull-many
|
|
remove-nils]]
|
|
[auto-ap.datomic.accounts :as a]
|
|
[auto-ap.graphql.utils :refer [assert-admin assert-can-see-client
|
|
exception->notification notify-if-locked]]
|
|
[auto-ap.logging :as alog]
|
|
[auto-ap.permissions :refer [wrap-must]]
|
|
[auto-ap.query-params :refer [wrap-copy-qp-pqp]]
|
|
[auto-ap.routes.ledger :as route]
|
|
[auto-ap.routes.utils
|
|
:refer [wrap-client-redirect-unauthenticated]]
|
|
[auto-ap.solr :as solr]
|
|
[auto-ap.ssr-routes :as ssr-routes]
|
|
[auto-ap.ssr.components :as com]
|
|
[auto-ap.ssr.form-cursor :as fc]
|
|
[auto-ap.ssr.grid-page-helper :as helper :refer [wrap-apply-sort]]
|
|
[auto-ap.ssr.hx :as hx]
|
|
[auto-ap.ssr.ledger.balance-sheet :as balance-sheet]
|
|
[auto-ap.ssr.ledger.cash-flows :as cash-flows]
|
|
[auto-ap.ssr.ledger.common :refer [bank-account-filter default-read
|
|
fetch-ids grid-page query-schema]]
|
|
[auto-ap.ssr.ledger.common :as ledger.common]
|
|
[auto-ap.ssr.ledger.investigate :as investigate]
|
|
[auto-ap.ssr.ledger.new :as new]
|
|
[auto-ap.ssr.ledger.profit-and-loss :as profit-and-loss]
|
|
[auto-ap.ssr.nested-form-params :refer [wrap-nested-form-params]]
|
|
[auto-ap.ssr.svg :as svg]
|
|
[auto-ap.ssr.ui :refer [base-page]]
|
|
[auto-ap.ssr.utils
|
|
:refer [apply-middleware-to-all-handlers clj-date-schema
|
|
html-response main-transformer money strip
|
|
wrap-form-4xx-2 wrap-implied-route-param
|
|
wrap-merge-prior-hx wrap-schema-decode
|
|
wrap-schema-enforce]]
|
|
[auto-ap.time :as atime]
|
|
[auto-ap.utils :refer [dollars=]]
|
|
[bidi.bidi :as bidi]
|
|
[clj-time.coerce :as coerce]
|
|
[clj-time.core :as t]
|
|
[clojure.data.csv :as csv]
|
|
[clojure.java.io :as io]
|
|
[clojure.string :as str]
|
|
[com.brunobonacci.mulog :as mu]
|
|
[datomic.api :as dc]
|
|
[hiccup2.core :as hiccup]
|
|
[iol-ion.utils :refer [by random-tempid]]
|
|
[malli.core :as mc]
|
|
[slingshot.slingshot :refer [throw+]]))
|
|
|
|
|
|
|
|
(comment
|
|
(mc/decode query-schema
|
|
{:start " "}
|
|
main-transformer))
|
|
|
|
(defn selected->ids [request params]
|
|
(let [all-selected (:all-selected params)
|
|
selected (:selected params)
|
|
ids (cond
|
|
all-selected
|
|
(:ids (fetch-ids (dc/db conn) (-> request
|
|
(assoc :query-params params)
|
|
(assoc-in [:query-params :start] 0)
|
|
(assoc-in [:query-params :per-page] 250))))
|
|
|
|
|
|
:else
|
|
selected)]
|
|
ids))
|
|
|
|
|
|
|
|
|
|
(defn delete [{invoice :entity :as request identity :identity}]
|
|
(exception->notification
|
|
#(when-not (= :invoice-status/unpaid (:invoice/status invoice))
|
|
(throw (ex-info "Cannot void an invoice if it is paid. First void the payment." {}))))
|
|
|
|
(when (->> invoice :invoice/payments
|
|
(filter (fn [p]
|
|
(not= :payment-status/voided
|
|
(:payment/status p))))
|
|
seq)
|
|
(throw (ex-info "This invoice has linked payments. Void the payments first." {:type :notification})))
|
|
|
|
(exception->notification
|
|
#(assert-can-see-client identity (:db/id (:invoice/client invoice))))
|
|
(notify-if-locked (:db/id (:invoice/client invoice))
|
|
(:invoice/date invoice))
|
|
(audit-transact [[:upsert-invoice {:db/id (:db/id invoice)
|
|
:invoice/total 0.0
|
|
:invoice/outstanding-balance 0.0
|
|
:invoice/status :invoice-status/voided
|
|
:invoice/expense-accounts (map (fn [ea] {:db/id (:db/id ea)
|
|
:invoice-expense-account/amount 0.0})
|
|
(:invoice/expense-accounts invoice))}]]
|
|
identity)
|
|
|
|
(html-response (ledger.common/row* (:identity request) (dc/pull (dc/db conn) default-read (:db/id invoice))
|
|
{:class "live-removed"})
|
|
:headers {"hx-retarget" (format "#entity-table tr[data-id=\"%d\"]" (:db/id invoice))}))
|
|
|
|
|
|
(defn wrap-ensure-bank-account-belongs [handler]
|
|
(fn [{:keys [query-params client] :as request}]
|
|
(let [bank-account-belongs? (get (set (map :db/id (:client/bank-accounts client)))
|
|
(:db/id (:bank-account query-params)))]
|
|
(handler (cond-> request
|
|
(not client)
|
|
(update :query-params dissoc :bank-account)
|
|
(not bank-account-belongs?)
|
|
(update :query-params dissoc :bank-account))))))
|
|
|
|
(defn wrap-external-from-route [handler]
|
|
(fn [{:keys [matched-current-page-route] :as request}]
|
|
(let [request (cond-> request
|
|
(= ::route/external-page matched-current-page-route) (assoc-in [:route-params :external?] true))]
|
|
(handler request))))
|
|
|
|
(defn external-import-table-form* [request]
|
|
[:div#table-form
|
|
(clojure.pprint/pprint (:form-errors request))
|
|
(fc/start-form
|
|
(:form-params request)
|
|
(:form-errors request)
|
|
(fc/with-field :table
|
|
(clojure.pprint/pprint (fc/field-errors))
|
|
(when (seq (fc/field-value))
|
|
|
|
[: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.inline-flex.gap-2
|
|
(->> (:form-errors request)
|
|
:table
|
|
( #(if (map? %) ( vals %) %))
|
|
(mapcat identity)
|
|
(group-by last)
|
|
(map (fn [[k v]]
|
|
(if (= :warn k)
|
|
(com/pill {:color :yellow}
|
|
(format "%d warnings" (count v)))
|
|
(com/pill {:color :red}
|
|
(format "%d errors" (count v)))))))] ])
|
|
[: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
|
|
{ "x-tooltip" "{content: ()=>$refs.tt.innerHTML , allowHTML: true}"}
|
|
[: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]
|
|
[:template {:x-ref "tt"}
|
|
[: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
|
|
(or (:form-params request) {}) (:form-errors request)
|
|
[:form#parse-form {:x-data (hx/json {"clipboard" nil})
|
|
:hx-post (bidi.bidi/path-for ssr-routes/only-routes ::route/external-import-parse)
|
|
:hx-swap "outerHTML"
|
|
:hx-trigger "pasted"}
|
|
(fc/with-field :table
|
|
[:div
|
|
(com/errors {:errors (fc/field-errors)})
|
|
(com/text-area {:x-model "clipboard" :name (fc/field-name) :value (fc/field-value) :class "hidden"})])
|
|
(com/button {"@click.prevent" "clipboard = (await getclpboard()); $nextTick(() => $dispatch('pasted'))"
|
|
"x-on:paste.document" "clipboard = (await getclpboard()); console.log(clipboard); $nextTick(() => $dispatch('pasted'))"}
|
|
"Load from clipboard")]))
|
|
|
|
(defn external-import-form* [request]
|
|
[:div#forms {:hx-target "this"
|
|
:hx-swap "outerHTML"}
|
|
(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]
|
|
(base-page
|
|
request
|
|
(com/page {:nav com/main-aside-nav
|
|
:client-selection (:client-selection request)
|
|
:clients (:clients request)
|
|
:client (:client request)
|
|
:identity (:identity request)
|
|
:request request}
|
|
(com/breadcrumbs {}
|
|
[:a {:href (bidi/path-for ssr-routes/only-routes ::route/all-page)}
|
|
"Ledger"]
|
|
[:a {:href (bidi/path-for ssr-routes/only-routes ::route/external-import-page)}
|
|
"Import"])
|
|
#_(when (:above-grid grid-spec)
|
|
( (:above-grid grid-spec) request))
|
|
|
|
[:script
|
|
(hiccup/raw
|
|
"async function getclpboard() {
|
|
var c = await navigator.clipboard.read()
|
|
console.log(c)
|
|
var r = await c[0].getType('text/plain')
|
|
console.log(r)
|
|
return await r.text()
|
|
}")]
|
|
|
|
(external-import-form* request)
|
|
[:div #_{:x-data (hx/json {:selected [] :all_selected false :type (:entity-name grid-spec)})
|
|
"x-on:copy" "if (selected.length > 0) {$clipboard(JSON.stringify({'type': type, 'selected': selected}))}"
|
|
"x-on:client-selected.document" "selected=[]; all_selected=false"
|
|
"x-bind:hx-vals" "JSON.stringify({selected: $data.selected, 'all-selected': $data.all_selected})"
|
|
:x-init "$watch('selected', s=> $dispatch('selectedChanged', {selected: s, all_selected: all_selected}) );
|
|
$watch('all_selected', a=>$dispatch('selectedChanged', {selected: selected, all_selected: a}))"}
|
|
|
|
#_(table* grid-spec
|
|
identity
|
|
request)])
|
|
"External Ledger Import"
|
|
#_(if (string? (:title grid-spec))
|
|
(:title grid-spec)
|
|
((:title grid-spec) request))))
|
|
|
|
|
|
|
|
(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 [] (filter (fn filter-row [r]
|
|
(seq (filter (comp not-empty #(str/replace % #"\s+" "")) r))))
|
|
(trim-header (csv/read-csv r :separator \tab))))
|
|
data))
|
|
|
|
(def account-schema (mc/schema [:orn
|
|
[:account-code nat-int?]
|
|
[:bank-account
|
|
[:string]]]))
|
|
|
|
|
|
|
|
(def parse-form-schema (mc/schema
|
|
[:map
|
|
[:table {:min 1 :error/message "Clipboard should contain rows to import"
|
|
:decode/string tsv->import-data}
|
|
[:vector {:coerce? true}
|
|
[:map { :decode/arbitrary (fn [t]
|
|
(if (vector? t)
|
|
(into {} (map vector [:external-id :client-code :source :vendor-name :date :account-code :location :debit :credit] t))
|
|
t))}
|
|
[:external-id [:string {:title "external id"
|
|
:min 1
|
|
:decode/string strip}]]
|
|
[:client-code [:string {:title "client code"
|
|
:min 1
|
|
:decode/string strip}]]
|
|
[:source [:string {:title "source"
|
|
:min 1
|
|
:decode/string strip}]]
|
|
[:vendor-name [:string {:min 1 :decode/string strip}]]
|
|
[:date [:and clj-date-schema
|
|
[:any {:title "date"}]]]
|
|
[:account-code account-schema]
|
|
|
|
[:location [:string { :min 1
|
|
:max 2
|
|
:decode/string strip}]]
|
|
[:debit [:maybe money]]
|
|
[:credit [:maybe money]]]]
|
|
|
|
#_[:string {:decode/string tsv->import-data
|
|
:error/message "Clipboard should contain rows to import"}]]]))
|
|
|
|
|
|
|
|
|
|
|
|
(defn external-import-parse [request]
|
|
(html-response
|
|
( external-import-form* (assoc request :just-parsed? true))))
|
|
|
|
(defn line->id [{:keys [source external-id client-code]}]
|
|
(str client-code "-" source "-" external-id))
|
|
|
|
|
|
(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)]]
|
|
(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))
|
|
(let [form-params (:form-params request)
|
|
used-vendor-names (set (map :vendor-name (:table form-params)))
|
|
all-vendors (mu/trace ::get-all-vendors
|
|
[]
|
|
(->> (dc/q '[:find ?e
|
|
:in $ [?name ...]
|
|
:where [?e :vendor/name ?name]]
|
|
(dc/db conn)
|
|
used-vendor-names)
|
|
(map first)
|
|
(pull-many (dc/db conn) [:db/id :vendor/name])
|
|
(by :vendor/name)))
|
|
client-locked-lookup (mu/trace ::get-all-clients []
|
|
(->> (dc/q '[:find ?code ?locked-until
|
|
:in $
|
|
:where [?c :client/code ?code]
|
|
[(get-else $ ?c :client/locked-until #inst "2000-01-01") ?locked-until]]
|
|
(dc/db conn))
|
|
(into {})))
|
|
all-client-bank-accounts (mu/trace ::get-all-client-bank-accounts
|
|
[]
|
|
(->> (dc/q '[:find ?code ?ba-code
|
|
:in $
|
|
:where [?c :client/code ?code]
|
|
[?c :client/bank-accounts ?ba]
|
|
[?ba :bank-account/code ?ba-code]]
|
|
(dc/db conn))
|
|
(reduce
|
|
(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
|
|
:in $
|
|
:where [?c :client/code ?code]
|
|
[?c :client/locations ?location]]
|
|
(dc/db conn))
|
|
(reduce
|
|
(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)
|
|
(new-vendors vendor-name))
|
|
new-vendors
|
|
(assoc new-vendors vendor-name
|
|
{:vendor/name vendor-name
|
|
:vendor/hidden true
|
|
:db/id vendor-name})))
|
|
{}
|
|
(:table form-params))
|
|
_ (mu/trace ::upsert-new-vendors
|
|
[]
|
|
(audit-transact-batch (vec (vals new-hidden-vendors)) (:identity request)))
|
|
all-vendors (->> (dc/q '[:find ?e
|
|
:in $ [?name ...]
|
|
:where [?e :vendor/name ?name]]
|
|
(dc/db conn)
|
|
used-vendor-names)
|
|
(map first)
|
|
(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)) 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 form-errors
|
|
:form-params form-params})))
|
|
|
|
retraction (mapv (fn [x] [:db/retractEntity [:journal-entry/external-id (:external-id x)]])
|
|
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))
|
|
(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)))
|
|
(mu/trace ::ignore-retraction-tx
|
|
[: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 good-entries)]
|
|
(for [[_ n] (:tempids (audit-transact-batch transaction (:identity request)))]
|
|
n))]
|
|
(future ;
|
|
(mu/log ::indexing-solr :count (count invalidated))
|
|
(mu/trace ::indexed-external-solr
|
|
[:count (count invalidated)]
|
|
(doseq [n invalidated]
|
|
(solr/touch n)))))
|
|
|
|
{:successful (count good-entries)
|
|
:ignored (count ignored-entries)
|
|
:form-errors form-errors}))
|
|
|
|
(defn external-import-import [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))})})))
|
|
|
|
|
|
(def key->handler
|
|
(merge
|
|
(apply-middleware-to-all-handlers
|
|
(->
|
|
{::route/all-page (-> (helper/page-route grid-page)
|
|
(wrap-implied-route-param :external? false))
|
|
::route/external-page (-> (helper/page-route grid-page)
|
|
(wrap-implied-route-param :external? true))
|
|
|
|
::route/table (helper/table-route grid-page)
|
|
::route/csv (helper/csv-route grid-page)
|
|
::route/external-import-page external-import-page
|
|
::route/bank-account-filter bank-account-filter
|
|
::route/external-import-parse (-> external-import-parse
|
|
(wrap-schema-enforce :form-schema parse-form-schema)
|
|
(wrap-form-4xx-2 external-import-parse)
|
|
(wrap-schema-decode :form-schema parse-form-schema))
|
|
::route/external-import-import (-> external-import-import
|
|
(wrap-schema-enforce :form-schema parse-form-schema)
|
|
(wrap-form-4xx-2 external-import-parse)
|
|
#_(wrap-schema-decode :form-schema parse-form-schema)
|
|
(wrap-nested-form-params))})
|
|
(fn [h]
|
|
(-> h
|
|
(wrap-copy-qp-pqp)
|
|
(wrap-apply-sort grid-page)
|
|
(wrap-ensure-bank-account-belongs)
|
|
(wrap-merge-prior-hx)
|
|
(wrap-external-from-route)
|
|
(wrap-schema-enforce :query-schema query-schema)
|
|
(wrap-schema-enforce :hx-schema query-schema)
|
|
(wrap-must {:activity :import :subject :ledger})
|
|
(wrap-client-redirect-unauthenticated))))
|
|
balance-sheet/key->handler
|
|
profit-and-loss/key->handler
|
|
cash-flows/key->handler
|
|
investigate/key->handler
|
|
new/key->handler)) |