Adds new ledger import page
This commit is contained in:
@@ -211,7 +211,7 @@
|
||||
(when (seq (dc/q '[:find ?x :in $ ?nc :where [?x :account/numeric-code ?nc]] (dc/db conn) (:account/numeric-code entity)))
|
||||
(field-validation-error (format "The code %d is already in use." (:account/numeric-code entity))
|
||||
[:account/numeric-code]
|
||||
:form form-params)))
|
||||
:form-params form-params)))
|
||||
_ (some->> form-params
|
||||
:account/client-overrides
|
||||
(group-by :account-client-override/client)
|
||||
@@ -226,7 +226,7 @@
|
||||
:client/name
|
||||
(-> client)))
|
||||
) %)))
|
||||
:form form-params)) ;; TODO shouldnt need to bubble this through. See if we can eliminate the passing of form and last-form.
|
||||
:form-params form-params)) ;; TODO shouldnt need to bubble this through. See if we can eliminate the passing of form and last-form.
|
||||
)
|
||||
{:keys [tempids]} (audit-transact [[:upsert-entity (cond-> entity
|
||||
(:account/numeric-code entity) (assoc :account/code (str (:account/numeric-code entity))))]]
|
||||
|
||||
@@ -160,7 +160,7 @@
|
||||
(dissoc form-params :name))]
|
||||
{:message (str "task " (str new-job) " started.")})
|
||||
(form-validation-error "This job is already running"
|
||||
:form form-params)))
|
||||
:form-params form-params)))
|
||||
|
||||
(defn subform* [{:keys [name]}]
|
||||
(into [:div {:class "fade-in-settle transition"}]
|
||||
|
||||
@@ -270,19 +270,19 @@
|
||||
:when (and account-location (not= account-location location))]
|
||||
(field-validation-error (str "must be " account-location)
|
||||
[:transaction-rule/accounts i :transaction-rule-account/location]
|
||||
:form form-params))
|
||||
:form-params form-params))
|
||||
|
||||
(let [total (reduce + 0.0 (map :transaction-rule-account/percentage (:transaction-rule/accounts form-params)))]
|
||||
(when-not (dollars= 1.0 total)
|
||||
(form-validation-error (format "Expense accounts total (%d%%) must add to 100%%" (int (* 100.0 total)))
|
||||
:form form-params)))
|
||||
:form-params form-params)))
|
||||
|
||||
(when (and (:transaction-rule/bank-account form-params)
|
||||
(not (bank-account-belongs-to-client? (:transaction-rule/bank-account form-params)
|
||||
(:transaction-rule/client form-params))))
|
||||
(field-validation-error "does not belong to client"
|
||||
[:transaction-rule/bank-account]
|
||||
:form form-params)))
|
||||
:form-params form-params)))
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -201,7 +201,7 @@
|
||||
(if (= (:source-vendor form-params)
|
||||
(:target-vendor form-params))
|
||||
(form-validation-error "Please select two different vendors"
|
||||
:form form-params))
|
||||
:form-params form-params))
|
||||
(let [transaction (->> (dc/q {:find '[?x ?a2]
|
||||
:in '[$ ?vendor-from]
|
||||
:where ['[?x ?a ?vendor-from]
|
||||
|
||||
@@ -32,6 +32,8 @@
|
||||
(def modal-footer dialog/modal-footer-)
|
||||
|
||||
(def text-input inputs/text-input-)
|
||||
(def text-area inputs/text-area-)
|
||||
|
||||
(def checkbox inputs/checkbox-)
|
||||
(def money-input inputs/money-input-)
|
||||
(def int-input inputs/int-input-)
|
||||
|
||||
@@ -309,7 +309,17 @@
|
||||
{:subject :ledger
|
||||
:activity :import})
|
||||
(menu-button- {:href (bidi/path-for client-routes/routes
|
||||
:external-import-ledger)} "External Ledger Import")))))]))
|
||||
:external-import-ledger)} "External Ledger Import"))
|
||||
|
||||
(when (is-admin? (:identity request))
|
||||
(menu-button- {:href (hu/url (bidi/path-for ssr-routes/only-routes
|
||||
::ledger-routes/external-import-page)
|
||||
{:date-range "month"})
|
||||
:active? (= ::ledger-routes/external-import-page (:matched-route request))
|
||||
:hx-boost "true"}
|
||||
[:div.flex.gap-2
|
||||
"External Import"
|
||||
(tags/pill- {:color :secondary} "WIP")])))))]))
|
||||
|
||||
|
||||
(defn company-aside-nav- [request]
|
||||
|
||||
@@ -68,13 +68,14 @@
|
||||
per-page
|
||||
flash-id
|
||||
headers
|
||||
rows] :as params}]
|
||||
[:div {:hx-get (bidi/path-for ssr-routes/only-routes
|
||||
route
|
||||
:request-method :get)
|
||||
:hx-trigger "clientSelected from:body, invalidated from:body"
|
||||
:hx-swap "outerHTML swap:300ms"
|
||||
:id id}
|
||||
rows] :as params} & children]
|
||||
[:div (cond-> { :id id}
|
||||
route (assoc
|
||||
:hx-get (bidi/path-for ssr-routes/only-routes
|
||||
route
|
||||
:request-method :get)
|
||||
:hx-trigger "clientSelected from:body, invalidated from:body"
|
||||
:hx-swap "outerHTML swap:300ms"))
|
||||
|
||||
(content-card-
|
||||
{}
|
||||
@@ -121,6 +122,7 @@
|
||||
:hx-target (str "#" id) ;
|
||||
:hx-swap "outerHTML show:#app:top"
|
||||
:hx-indicator (str "#" id)}}))
|
||||
children
|
||||
[:div {:class "htmx-indicator absolute -translate-x-1/2 -translate-y-1/2 top-2/4 left-1/2 overflow-hidden w-full h-full"}
|
||||
[:div {:class "flex items-center justify-center w-full h-full border border-gray-200 rounded-lg bg-gray-50 dark:bg-gray-800 dark:border-gray-700 bg-opacity-50" }
|
||||
[:div {:class "px-3 py-1 text-xs font-medium leading-none text-center text-blue-800 bg-blue-200 rounded-full animate-pulse dark:bg-blue-900 dark:text-blue-200"} "loading..."]]])])
|
||||
|
||||
@@ -148,6 +148,14 @@
|
||||
(hh/add-class %)))
|
||||
(update :class #(str % (use-size size))))])
|
||||
|
||||
(defn text-area- [{:keys [] :as params}]
|
||||
[:textarea
|
||||
(-> params
|
||||
(update :class #(-> ""
|
||||
(hh/add-class default-input-classes)
|
||||
(hh/add-class %)))) ]
|
||||
)
|
||||
|
||||
(defn money-input- [{:keys [size] :as params}]
|
||||
[:input
|
||||
(-> params
|
||||
|
||||
@@ -862,6 +862,7 @@
|
||||
::route/expense-account-balance (-> invoice-expense-account-balance
|
||||
(mm/wrap-wizard new-wizard)
|
||||
(mm/wrap-decode-multi-form-state))
|
||||
|
||||
::route/location-select (-> location-select
|
||||
(wrap-schema-enforce :query-schema [:map
|
||||
[:name :string]
|
||||
|
||||
@@ -2,43 +2,55 @@
|
||||
(:require [auto-ap.client-routes :as client-routes]
|
||||
[auto-ap.datomic
|
||||
:refer [add-sorter-fields apply-pagination apply-sort-3
|
||||
audit-transact conn merge-query observable-query
|
||||
pull-many]]
|
||||
audit-transact audit-transact-batch conn merge-query
|
||||
observable-query pull-many remove-nils]]
|
||||
[auto-ap.datomic.accounts :as d-accounts]
|
||||
[auto-ap.datomic.accounts :as a]
|
||||
[auto-ap.graphql.checks :as gq-checks]
|
||||
[auto-ap.graphql.utils :refer [assert-can-see-client
|
||||
assert-not-locked
|
||||
[auto-ap.graphql.utils :refer [assert-admin assert-can-see-client
|
||||
exception->notification
|
||||
extract-client-ids notify-if-locked]]
|
||||
[auto-ap.logging :as alog]
|
||||
[auto-ap.permissions :refer [can?]]
|
||||
[auto-ap.permissions :refer [can? wrap-must]]
|
||||
[auto-ap.query-params :refer [wrap-copy-qp-pqp]]
|
||||
[auto-ap.routes.invoice :as invoice-route]
|
||||
[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.components.link-dropdown :refer [link-dropdown]]
|
||||
[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.nested-form-params :refer [wrap-nested-form-params]]
|
||||
[auto-ap.ssr.pos.common :refer [date-range-field*]]
|
||||
[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
|
||||
dissoc-nil-transformer entity-id html-response
|
||||
main-transformer modal-response ref->enum-schema strip
|
||||
wrap-implied-route-param wrap-merge-prior-hx
|
||||
main-transformer modal-response money ref->enum-schema
|
||||
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-0?]]
|
||||
[auto-ap.utils :refer [dollars-0? 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]
|
||||
[hiccup.util :as hu]
|
||||
[hiccup2.core :as hiccup]
|
||||
[iol-ion.utils :refer [by random-tempid]]
|
||||
[malli.core :as mc]
|
||||
[malli.transform :as mt]))
|
||||
[malli.transform :as mt]
|
||||
[slingshot.slingshot :refer [throw+]]))
|
||||
|
||||
|
||||
|
||||
@@ -412,8 +424,7 @@
|
||||
(assoc-in (exact-match-id* request) [1 :hx-swap-oob] true)])
|
||||
:query-schema query-schema
|
||||
:parse-query-params (fn [p]
|
||||
(alog/peek ::PARSE
|
||||
(mc/decode query-schema p main-transformer)))
|
||||
(mc/decode query-schema p main-transformer))
|
||||
:action-buttons (fn [request]
|
||||
(let [[_ _ outstanding total] (:page-results request)]
|
||||
[ #_(when (can? (:identity request) {:subject :invoice :activity :bulk-delete})
|
||||
@@ -563,83 +574,8 @@
|
||||
{:class "live-removed"})
|
||||
:headers {"hx-retarget" (format "#entity-table tr[data-id=\"%d\"]" (:db/id invoice))}))
|
||||
|
||||
(defn bulk-delete-dialog [request]
|
||||
(let [all-selected (:all-selected (:query-params request))
|
||||
selected (:selected (:query-params request))
|
||||
ids (cond
|
||||
all-selected
|
||||
(:ids (fetch-ids (dc/db conn) (-> request
|
||||
(assoc-in [:query-params :start] 0)
|
||||
(assoc-in [:query-params :per-page] 250))))
|
||||
:else
|
||||
selected)]
|
||||
(modal-response
|
||||
(com/modal {}
|
||||
(com/modal-card-advanced
|
||||
{}
|
||||
|
||||
(com/modal-body {}
|
||||
[:div.flex.flex-col.mt-4.space-y-4.items-center
|
||||
[:div.w-24.h-24.bg-red-50.rounded-full.p-4.text-red-300
|
||||
|
||||
svg/alert]
|
||||
[:div "You are about to void " (count ids) " invoices. Are you sure you want to do this?"]])
|
||||
(com/modal-footer {} [:div.flex.justify-end (com/button {:color :primary
|
||||
:hx-vals (hx/json (mc/encode
|
||||
query-schema
|
||||
(dissoc (:query-params request) :sort)
|
||||
(mt/transformer
|
||||
main-transformer
|
||||
dissoc-nil-transformer
|
||||
mt/strip-extra-keys-transformer)))
|
||||
:hx-delete (hu/url (bidi/path-for ssr-routes/only-routes
|
||||
::route/bulk-delete-confirm))}
|
||||
"Void invoices")])))
|
||||
:headers (-> {}
|
||||
(assoc "hx-retarget" ".modal-stack")
|
||||
(assoc "hx-reswap" "beforeend")))))
|
||||
|
||||
(defn void-invoices-internal [all-ids id]
|
||||
(let [all-ids (->> all-ids
|
||||
(dc/q '[:find (pull ?i [:db/id :invoice/date {:invoice/expense-accounts [:db/id]}])
|
||||
:in $ [?i ...]
|
||||
:where (not [_ :invoice-payment/invoice ?i])
|
||||
[?i :invoice/client ?c]
|
||||
[(get-else $ ?c :client/locked-until #inst "2000-01-01") ?lu]
|
||||
[?i :invoice/date ?d]
|
||||
[(>= ?d ?lu)]]
|
||||
(dc/db conn)))
|
||||
voidable-cash-payments (->> (dc/q '[:find ?p
|
||||
:in $ [?i ...]
|
||||
:where [?ip :invoice-payment/invoice ?i]
|
||||
[?ip :invoice-payment/payment ?p]
|
||||
[?p :payment/type :payment-type/cash]
|
||||
[?i :invoice/client ?c]
|
||||
[(get-else $ ?c :client/locked-until #inst "2000-01-01") ?lu]
|
||||
[?i :invoice/date ?d]
|
||||
[(>= ?d ?lu)]]
|
||||
(dc/db conn)
|
||||
(map :db/id all-ids))
|
||||
(map first))]
|
||||
(alog/info ::void-payments :count (count voidable-cash-payments))
|
||||
(gq-checks/void-payments-internal voidable-cash-payments id)
|
||||
|
||||
(alog/info ::voiding-invoices :count (count all-ids))
|
||||
(audit-transact
|
||||
(->> all-ids
|
||||
(map
|
||||
(fn [[i]]
|
||||
[:upsert-invoice {:db/id (:db/id i)
|
||||
:invoice/total 0.0
|
||||
:invoice/outstanding-balance 0.0
|
||||
:invoice/status :invoice-status/voided
|
||||
:invoice/expense-accounts (mapv
|
||||
(fn [iea]
|
||||
{:db/id (:db/id iea)
|
||||
:invoice-expense-account/amount 0.0})
|
||||
(:invoice/expense-accounts i))}])))
|
||||
id)
|
||||
(count all-ids)))
|
||||
|
||||
|
||||
|
||||
@@ -662,6 +598,586 @@
|
||||
(= ::route/external-page matched-current-page-route) (assoc-in [:route-params :external?] true))]
|
||||
(handler request))))
|
||||
|
||||
(defn external-import-table-form* [request]
|
||||
[:div#table-form
|
||||
(fc/start-form
|
||||
(:form-params request)
|
||||
(:form-errors request)
|
||||
(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 {:x-data (hx/json {:popper nil
|
||||
:hover false})
|
||||
:x-init "popper = Popper.createPopper($refs.button, $refs.tooltip, {placement: 'bottom', strategy: 'fixed', modifiers: [{name: 'preventOverflow'}, {name: 'offset', options: {offset: [0, 10]}}]});"}
|
||||
(cond (seq (fc/field-errors))
|
||||
[:div.w-8.h-8.bg-red-50.rounded-full.p-2.text-red-300.flex.items-start
|
||||
{"@mouseover" "hover=true; $nextTick(() => popper.update()); console.log('hi')"
|
||||
"@mouseout" "hover=false"
|
||||
:x-ref "button"}
|
||||
svg/alert]
|
||||
:else
|
||||
nil)
|
||||
[:div (hx/alpine-appear {:x-ref "tooltip" :x-show "hover"
|
||||
:class "bg-gray-100 dark:bg-gray-600 rounded-lg shadow-2xl w-max z-50 p-4"})
|
||||
[:span (pr-str (fc/field-errors))]]]))))}
|
||||
|
||||
[: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 (seq (:form-errors request))
|
||||
(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 assoc-error [f]
|
||||
(fn [entry]
|
||||
(try
|
||||
(f entry)
|
||||
(catch Exception e
|
||||
(assoc entry :error (.getMessage e)
|
||||
:status (or (:status (ex-data e))
|
||||
:error))))))
|
||||
|
||||
|
||||
(defn tsv->import-data [data]
|
||||
(if (string? data)
|
||||
(with-open [r (io/reader (char-array data))]
|
||||
(into [] (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 money]
|
||||
[:credit 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* request)))
|
||||
|
||||
(defn line->id [{:keys [source external-id client-code]}]
|
||||
(str client-code "-" source "-" external-id))
|
||||
|
||||
(defn table->entries [table]
|
||||
(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)}))))
|
||||
|
||||
(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)))
|
||||
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)
|
||||
(throw+ (ex-info "ledger import errors"
|
||||
{:type :field-validation
|
||||
:form-errors 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 )
|
||||
(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 [invalidated
|
||||
(mu/trace ::success-tx
|
||||
[:count (count success)]
|
||||
(for [[_ n] (:tempids (audit-transact-batch (map :tx success) (: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 success)
|
||||
:ignored (count ignored) }))
|
||||
|
||||
(defn external-import-import [request]
|
||||
(html-response
|
||||
[:div
|
||||
(external-import-form* request)]
|
||||
:headers {"hx-trigger" (hx/json { "notification" (pr-str (import-ledger request))})}))
|
||||
|
||||
|
||||
(def key->handler
|
||||
(apply-middleware-to-all-handlers
|
||||
(->
|
||||
@@ -669,9 +1185,19 @@
|
||||
(wrap-implied-route-param :external? false))
|
||||
::route/external-page (-> (helper/page-route grid-page :parse-query-params? false)
|
||||
(wrap-implied-route-param :external? true))
|
||||
|
||||
|
||||
::route/table (helper/table-route grid-page :parse-query-params? false)
|
||||
::route/bank-account-filter bank-account-filter})
|
||||
::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)
|
||||
@@ -681,4 +1207,5 @@
|
||||
(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)))))
|
||||
@@ -125,9 +125,6 @@
|
||||
[:div.block "No results found."])]))
|
||||
|
||||
(defn dialog-contents [request]
|
||||
(mu/log ::params
|
||||
:params (:params request)
|
||||
:form (:form-params request))
|
||||
(if-let [q (get (:form-params request) "q")]
|
||||
(html-response (search-results* q (:identity request)))
|
||||
(modal-response
|
||||
|
||||
@@ -303,7 +303,6 @@
|
||||
(def alert
|
||||
[:svg {:xmlns "http://www.w3.org/2000/svg", :viewbox "0 0 24 24"}
|
||||
[:defs]
|
||||
[:title "alert-triangle"]
|
||||
[:path {:d "M22.553,22.581a.569.569,0,0,1-.553.894H2a.569.569,0,0,1-.553-.894L11.553,2.37c.246-.492.648-.492.894,0Z", :fill "none", :stroke "currentColor", :stroke-linecap "round", :stroke-linejoin "round"}]
|
||||
[:line {:x1 "12", :y1 "16.979", :x2 "12", :y2 "9.979", :fill "none", :stroke "currentColor", :stroke-linecap "round", :stroke-linejoin "round"}]
|
||||
[:path {:d "M11.991,18.979a.246.246,0,0,0-.241.255.255.255,0,0,0,.254.245h.005a.246.246,0,0,0,.241-.255A.255.255,0,0,0,12,18.979h-.005", :fill "none", :stroke "currentColor", :stroke-linecap "round", :stroke-linejoin "round"}]])
|
||||
|
||||
@@ -561,11 +561,16 @@
|
||||
:status 400))
|
||||
(catch [:type :field-validation] e
|
||||
(form-handler (assoc request
|
||||
:form-params (:form e)
|
||||
:form-params (or (:form e) ;; TODO is :form actually used?
|
||||
(:form-params e)
|
||||
(:form-params request)
|
||||
)
|
||||
:form-errors (:form-errors e))))
|
||||
(catch [:type :form-validation] e
|
||||
(form-handler (assoc request
|
||||
:form-params (:form e)
|
||||
:form-params (or (:form e) ;; TODO is :form actually used?
|
||||
(:form-params e)
|
||||
(:form-params request))
|
||||
:form-validation-errors (:form-validation-errors e)
|
||||
:form-errors {:errors (:form-validation-errors e)}))))))
|
||||
|
||||
|
||||
@@ -352,7 +352,7 @@
|
||||
(defn- auto-reset-handler [ctx event]
|
||||
(require 'figwheel.main.api)
|
||||
(binding [*ns* *ns*]
|
||||
(clojure.tools.namespace.repl/refresh)
|
||||
(clojure.tools.namespace.repl/refresh)
|
||||
ctx))
|
||||
|
||||
(defn auto-reset
|
||||
|
||||
@@ -2,5 +2,8 @@
|
||||
|
||||
(def routes {"" {:get ::all-page}
|
||||
"/external-new" ::external-page
|
||||
"/external-import-new" {"" ::external-import-page
|
||||
"/parse" ::external-import-parse
|
||||
"/import" ::external-import-import}
|
||||
"/table" ::table
|
||||
"/bank-account-filter" ::bank-account-filter})
|
||||
Reference in New Issue
Block a user