(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))