diff --git a/src/clj/auto_ap/ssr/ledger/balance_sheet.clj b/src/clj/auto_ap/ssr/ledger/balance_sheet.clj new file mode 100644 index 00000000..88e5f275 --- /dev/null +++ b/src/clj/auto_ap/ssr/ledger/balance_sheet.clj @@ -0,0 +1,1359 @@ +(ns auto-ap.ssr.ledger.balance-sheet + (:require [auto-ap.client-routes :as client-routes] + [auto-ap.datomic + :refer [add-sorter-fields apply-pagination apply-sort-4 + 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.ledger :refer [full-ledger-for-client + roll-up-until]] + [auto-ap.graphql.utils :refer [<-graphql assert-admin + assert-can-see-client + exception->notification + extract-client-ids notify-if-locked]] + [auto-ap.ledger :refer [build-account-lookup]] + [auto-ap.ledger.reports :as l-reports] + [auto-ap.logging :as alog] + [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.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 + entity-id html-response main-transformer money strip + wrap-merge-prior-hx 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] + [hiccup.util :as hu] + [hiccup2.core :as hiccup] + [iol-ion.utils :refer [by random-tempid]] + [malli.core :as mc] + [slingshot.slingshot :refer [throw+]])) + + +(defn exact-match-id* [request] + (if (nat-int? (:exact-match-id (:query-params request))) + [:div {:x-data (hx/json {:exact_match (:exact-match-id (:query-params request))}) :id "exact-match-id-tag"} + (com/hidden {:name "exact-match-id" + "x-model" "exact_match"}) + (com/pill {:color :primary} + [:span.inline-flex.space-x-2.items-center + [:div "exact match"] + [:div.w-3.h-3 + (com/link {"@click" "exact_match=null; $nextTick(() => $dispatch('change'))"} + svg/x)]])] + [:div {:id "exact-match-id-tag"}])) + +(defn bank-account-filter* [request] + [:div {:hx-trigger "clientSelected from:body" + :hx-get (bidi.bidi/path-for ssr-routes/only-routes ::route/bank-account-filter) + :hx-target "this" + :hx-swap "outerHTML"} + (when (:client request) + (let [bank-account-belongs-to-client? (get (set (map :db/id (:client/bank-accounts (:client request)))) + (:db/id (:bank-account (:query-params request))))] + (com/field {:label "Bank Account"} + (com/radio-card {:size :small + :name "bank-account" + :value (or (when bank-account-belongs-to-client? + (:db/id (:bank-account (:query-params request)))) + "") + :options + (into [{:value "" + :content "All"}] + (for [ba (:client/bank-accounts (:client request))] + {:value (:db/id ba) + :content (:bank-account/name ba)}))}))))]) + +(defn bank-account-filter [request] + (html-response (bank-account-filter* request))) + +(defn filters [request] + [:form#ledger-filters {"hx-trigger" "change delay:500ms, keyup changed from:.hot-filter delay:1000ms" + "hx-get" (bidi/path-for ssr-routes/only-routes + ::route/table) + "hx-target" "#entity-table" + "hx-indicator" "#entity-table"} + + (com/hidden {:name "status" + :value (some-> (:status (:query-params request)) name)}) + [:fieldset.space-y-6 + (com/field {:label "Vendor"} + (com/typeahead {:name "vendor" + :id "vendor" + :url (bidi/path-for ssr-routes/only-routes :vendor-search) + :value (:vendor (:query-params request)) + :value-fn :db/id + :content-fn :vendor/name})) + (com/field {:label "Account"} + (com/typeahead {:name "account" + :id "account" + :url (bidi/path-for ssr-routes/only-routes :account-search) + :value (:account (:query-params request)) + :value-fn :db/id + :content-fn #(:account/name (d-accounts/clientize (dc/pull (dc/db conn) d-accounts/default-read (:db/id %)) + (:db/id (:client request))))})) + + (bank-account-filter* request) + + (date-range-field* request) + (com/field {:label "Invoice #"} + (com/text-input {:name "invoice-number" + :id "invoice-number" + :class "hot-filter" + :value (:invoice-number (:query-params request)) + :placeholder "e.g., ABC-456" + :size :small})) + +(com/field {:label "Account Code"} + [:div.flex.space-x-4.items-baseline + (com/int-input {:name "numeric-code-gte" + :id "numeric-code-gte" + :hx-preserve "true" + :class "hot-filter w-20" + :value (:numeric-code-gte (:query-params request)) + :placeholder "40000" + :size :small}) + [:div.align-baseline + "to"] + (com/int-input {:name "numeric-code-lte" + :hx-preserve "true" + :id "numeric-code-lte" + :class "hot-filter w-20" + :value (:numeric-code-lte (:query-params request)) + :placeholder "50000" + :size :small})]) + + (com/field {:label "Amount"} + [:div.flex.space-x-4.items-baseline + (com/money-input {:name "amount-gte" + :id "amount-gte" + :hx-preserve "true" + :class "hot-filter w-20" + :value (:amount-gte (:query-params request)) + :placeholder "0.01" + :size :small}) + [:div.align-baseline + "to"] + (com/money-input {:name "amount-lte" + :hx-preserve "true" + :id "amount-lte" + :class "hot-filter w-20" + :value (:amount-lte (:query-params request)) + :placeholder "9999.34" + :size :small})]) + (exact-match-id* request)]]) + + +(defn fetch-ids [db {:keys [query-params route-params] :as request}] + (let [valid-clients (extract-client-ids (:clients request) + (:client-id request) + (when (:client-code request) + [:client/code (:client-code request)])) + args query-params + query + (if (:exact-match-id args) + {:query {:find '[?e] + :in '[$ ?e [?c ...]] + :where '[[?e :journal-entry/client ?c]]} + :args [db + (:exact-match-id args) + valid-clients]} + (cond-> {:query {:find [] + :in ['$ '[?clients ?start ?end]] + :where '[[(iol-ion.query/scan-ledger $ ?clients ?start ?end) [[?e _ ?sort-default] ...]]]} + :args [db + [valid-clients + (some-> (:start-date query-params) coerce/to-date) + (some-> (:end-date query-params) coerce/to-date)]]} + + (:only-external args) + (merge-query {:query {:where ['(not [?e :journal-entry/original-entity ])]}}) + + (seq (:external-id-like args)) + (merge-query {:query {:in ['?external-id-like] + :where ['[?e :journal-entry/external-id ?external-id] + '[(.contains ^String ?external-id ?external-id-like)]]} + :args [(:external-id-like args)]}) + + (seq (:source args)) + (merge-query {:query {:in ['?source] + :where ['[?e :journal-entry/source ?source]]} + :args [(:source args)]}) + (:external? route-params) + (merge-query {:query { :where ['[?e :journal-entry/external-id]]} }) + + (:vendor args) + (merge-query {:query {:in ['?vendor-id] + :where ['[?e :journal-entry/vendor ?vendor-id]]} + :args [(:db/id (:vendor args))]}) + + (:invoice-number args) + (merge-query {:query {:in ['?invoice-number] + :where ['[?e :journal-entry/original-entity ?oe] + '[?oe :invoice/invoice-number ?invoice-number]]} + :args [(:invoice-number args)]}) + + (or (:numeric-code-lte args) + (:numeric-code-gte args) + (:account args) + (:db/id (:bank-account args)) + (not-empty (:location args))) + (merge-query {:query {:where ['[?e :journal-entry/line-items ?li]]}}) + + (or (:numeric-code-gte args) + (:numeric-code-lte args)) + (merge-query {:query {:in '[?from-numeric-code ?to-numeric-code] + :where ['[?li :journal-entry-line/account ?a] + '(or-join [?a ?c] + [?a :account/numeric-code ?c] + [?a :bank-account/numeric-code ?c]) + '[(>= ?c ?from-numeric-code)] + '[(<= ?c ?to-numeric-code)]]} + :args [(or (:numeric-code-gte args) 0) (or (:numeric-code-lte args) 99999)]}) + + (seq (:account args)) + (merge-query {:query {:in ['?a3] + :where ['[?li :journal-entry-line/account ?a3] ]} + :args [(:db/id (:account args))]}) + + + (:amount-gte args) + (merge-query {:query {:in ['?amount-gte] + :where ['[?e :journal-entry/amount ?a] + '[(>= ?a ?amount-gte)]]} + :args [(:amount-gte args)]}) + + (:amount-lte args) + (merge-query {:query {:in ['?amount-lte] + :where ['[?e :journal-entry/amount ?a] + '[(<= ?a ?amount-lte)]]} + :args [(:amount-lte args)]}) + + (:db/id (:bank-account args)) + (merge-query {:query {:in ['?a] + :where ['[?li :journal-entry-line/account ?a]]} + :args [(:db/id (:bank-account args))]}) + + (:account-id args) + (merge-query {:query {:in ['?a2] + :where ['[?e :journal-entry/line-items ?li2] + '[?li2 :journal-entry-line/account ?a2]]} + :args [(:account-id args)]}) + + (not-empty (:location args)) + (merge-query {:query {:in ['?location] + :where ['[?li :journal-entry-line/location ?location]]} + :args [(:location args)]}) + + (not-empty (:locations args)) + (merge-query {:query {:in ['[?location ...]] + :where ['[?li :journal-entry-line/location ?location]]} + :args [(:locations args)]}) + + (:sort args) (add-sorter-fields {"client" ['[?e :journal-entry/client ?c] + '[?c :client/name ?sort-client]] + "date" ['[?e :journal-entry/date ?sort-date]] + "vendor" ['[?e :journal-entry/vendor ?v] + '[?v :vendor/name ?sort-vendor]] + "amount" ['[?e :journal-entry/amount ?sort-amount]] + "external-id" ['[?e :journal-entry/external-id ?sort-external-id]] + "source" ['[?e :journal-entry/source ?sort-source]]} + args) + + true + (merge-query {:query {:find ['?sort-default '?e]}})))] + + (->> (observable-query query) + (apply-sort-4 (assoc query-params :default-asc? true)) + (apply-pagination query-params)))) + +(def default-read + '[:journal-entry/amount + :journal-entry/alternate-description + :journal-entry/source + :journal-entry/external-id + :db/id + [:journal-entry/date :xform clj-time.coerce/from-date] + {:journal-entry/vendor [:vendor/name :db/id] + :journal-entry/original-entity [:invoice/invoice-number + :invoice/source-url + :transaction/description-original :db/id] + :journal-entry/client [:client/name :client/code :db/id] + :journal-entry/line-items [:journal-entry-line/debit + :journal-entry-line/location + :journal-entry-line/running-balance + :journal-entry-line/credit + {:journal-entry-line/account [:account/name :db/id :account/numeric-code + :bank-account/name :bank-account/numeric-code + {[:account/type :xform iol-ion.query/ident] [:db/ident :db/id]} + {:account/client-overrides [:account-client-override/name + {:account-client-override/client [:db/id]}]} + {[:bank-account/type :xform iol-ion.query/ident] + [:db/ident :db/id]}]}]}]) + +(defn hydrate-results [ids db _] + (let [results (->> (pull-many db default-read ids) + (group-by :db/id)) + refunds (->> ids + (map results) + (map first))] + refunds)) + +(defn sum-outstanding [ids] + + (->> + (dc/q {:find ['?id '?o] + :in ['$ '[?id ...]] + :where ['[?id :invoice/outstanding-balance ?o]]} + (dc/db conn) + ids) + (map last) + (reduce + + + 0.0))) + +(defn sum-total-amount [ids] + + (->> + (dc/q {:find ['?id '?o] + :in ['$ '[?id ...]] + :where ['[?id :invoice/total ?o]] + } + (dc/db conn) + ids) + (map last) + (reduce + + + 0.0))) + +(defn fetch-page [request] + (let [db (dc/db conn) + {ids-to-retrieve :ids matching-count :count + all-ids :all-ids} (fetch-ids db request)] + + [(->> (hydrate-results ids-to-retrieve db request)) + matching-count + (sum-outstanding all-ids) + (sum-total-amount all-ids)])) + +(def query-schema (mc/schema + [:maybe [:map + [:client {:optional true :default []} [:maybe [:vector {:coerce? true} + entity-id]]] + + [:date {:optional true} + [:maybe clj-date-schema]]]])) + +(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)) + + + +;; TODO test as a real user +(def grid-page + (helper/build {:id "entity-table" + :nav com/main-aside-nav + :check-boxes? true + :check-box-warning? (fn [e] + (some? (:invoice/scheduled-payment e))) + :page-specific-nav filters + :fetch-page fetch-page + :oob-render + (fn [request] + [(assoc-in (date-range-field* request) [1 :hx-swap-oob] true) + (assoc-in (exact-match-id* request) [1 :hx-swap-oob] true)]) + :query-schema query-schema + :parse-query-params (fn [p] + (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}) + (com/button {:hx-get (str (bidi/path-for ssr-routes/only-routes ::route/bulk-delete)) + "x-bind:hx-vals" "JSON.stringify({selected: $data.selected, 'all-selected': $data.all_selected})" + "hx-include" "#ledger-filters" + :color :red} + "Void selected")) ])) + :row-buttons (fn [request entity] + [(when (and (= :invoice-status/unpaid (:invoice/status entity)) + (can? (:identity request) {:subject :invoice :activity :delete})) + (com/icon-button {:hx-delete (bidi/path-for ssr-routes/only-routes + ::route/delete + :db/id (:db/id entity)) + :hx-confirm "Are you sure you want to void this invoice?"} + svg/trash)) + (when (and (can? (:identity request) {:subject :invoice :activity :edit}) + (#{:invoice-status/unpaid :invoice-status/paid} (:invoice/status entity))) + (com/icon-button {:hx-put (bidi/path-for ssr-routes/only-routes + ::route/edit-wizard + :db/id (:db/id entity))} + svg/pencil)) + (when (and (can? (:identity request) {:subject :invoice :activity :edit}) + (#{:invoice-status/voided} (:invoice/status entity))) + (com/icon-button {:hx-put (bidi/path-for ssr-routes/only-routes + ::route/unvoid + :db/id (:db/id entity))} + svg/undo))]) + + :breadcrumbs [[:a {:href (bidi/path-for ssr-routes/only-routes ::route/page)} + "Ledger"]] + :title (fn [r] + (str + (some-> r :route-params :status name str/capitalize (str " ")) + "Register")) + :entity-name "register" + :route ::route/table + :break-table (fn [request entity] + (cond + (= (-> request :query-params :sort first :name) "Vendor") + (-> entity :journal-entry/vendor :vendor/name) + + (= (-> request :query-params :sort first :name) "Source") + (-> entity :journal-entry/source) + + :else nil)) + :headers [{:key "client" + :name "Client" + :sort-key "client" + :hide? (fn [args] + (and (= (count (:clients args)) 1) + (= 1 (count (:client/locations (:client args)))))) + :render (fn [x] [:div.flex.items-center.gap-2 (-> x :journal-entry/client :client/name) ])} + + {:key "vendor" + :name "Vendor" + :sort-key "vendor" + :render (fn [e] (or (-> e :journal-entry/vendor :vendor/name) + [:span.italic.text-gray-400 (-> e :journal-entry/alternate-description)]))} + {:key "source" + :name "Source" + :sort-key "source" + :hide? (fn [args] + (not (:external? (:route-params args)))) + :render :journal-entry/source} + {:key "external-id" + :name "External Id" + :sort-key "external-id" + :class "max-w-[12rem]" + :hide? (fn [args] + (not (:external? (:route-params args)))) + :render (fn [x] [:p.truncate ( :journal-entry/external-id x)])} + {:key "date" + :sort-key "date" + :name "Date" + :show-starting "lg" + :render (fn [{:journal-entry/keys [date]}] + (some-> date (atime/unparse-local atime/normal-date)))} + + {:key "debit" + :name "Debit" + :sort-key "debit" + :class "text-right" + :render :journal-entry-line/debit} + {:key "credit" + :name "Credit" + :sort-key "credit" + :class "text-right" + :render :journal-entry-line/credit} + {:key "links" + :name "Links" + :show-starting "lg" + :class "w-8" + :render (fn [i] + (link-dropdown + (cond-> [] + (-> i :journal-entry/original-entity :invoice/invoice-number) + (conj + {:link (hu/url (bidi/path-for ssr-routes/only-routes + ::invoice-route/all-page) + {:exact-match-id (:db/id (:journal-entry/original-entity i))}) + :color :primary + :content (format "Invoice '%s'" (-> i :journal-entry/original-entity :invoice/invoice-number))}) + (-> i :journal-entry/original-entity :invoice/source-url) + {:link (-> i :journal-entry/original-entity :invoice/source-url) + :color :secondary + :content (str "File")} + + (-> i :journal-entry/original-entity :transaction/description-original) + (conj + {:link (hu/url (bidi/path-for client-routes/routes + :transactions) + {:exact-match-id (:db/id (:journal-entry/original-entity i))}) + :color :primary + :content (format "Transaction '%s'" (-> i :journal-entry/original-entity :transaction/description-original))}))))}]})) + +(def row* (partial helper/row* grid-page)) + +(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 (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 + (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"})))) + )))} + + [: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))})})) + + + +(defn cell [{:keys [width click-event other-style]} c] + (let [cell-contents (cond + + (= :dollar (:format c)) + (format "$%,.2f" (:value c)) + + + (= :percent (:format c)) + (format "%%%.1f" (:value c)) + + :else + (str (:value c))) + cell-contents (if (:filters c) + [:a #_{:on-click (dispatch-event [click-event (:filters c)])} + cell-contents] + cell-contents)] + [:td.px-4.py-2 + (cond-> {:style (cond-> {:width (str width "em")} + other-style (merge other-style))} + + (:border c) (update :style + (fn [s] + (->> (:border c) + (map + (fn [b] + [(keyword (str "border-" (name b))) "1px solid black"]) + ) + (into s)))) + (:colspan c) (assoc :col-span (:colspan c)) + (:align c) (assoc :align (:align c)) + (= :dollar (:format c)) (assoc :align :right) + (= :percent (:format c)) (assoc :align :right) + (:bold c) (assoc-in [:style :font-weight] "bold") + (:color c) (assoc-in [:style :color] (str "rgb(" + (str/join "," + (:color c)) + ")")) + true (assoc-in [:style :background-color] (str "rgb(" + (str/join "," + (or (:bg-color c) [255 255 255])) + ")"))) + + cell-contents])) + +(defn cell-count [table] + (let [counts (map count (:rows table))] + (if (seq counts) + (apply max counts) + 0))) + +(defn table [{:keys [table widths click-event]}] + (let [cell-count (cell-count table)] + [:div {:style {:height "70vh" + :overflow-y "auto"}} + (-> [:table {:class "w-full text-sm text-left text-gray-500 dark:text-gray-400"} + [:thead {:class "text-xs text-gray-800 uppercase bg-gray-50 dark:bg-gray-700 dark:text-gray-400"} + (map + (fn [header-row header] + (into + [:tr {:class " border-b dark:border-gray-600 hover:bg-gray-100 dark:hover:bg-gray-700"}] + (map + (fn [w header i] + (cell {:width w :click-event click-event + :other-style {:position "sticky" + :top (* header-row (+ 22 18))}} header)) + widths + header + (range)))) + (range) + (:header table))]] + + (conj + (-> [:tbody {:style {}}] + (into + (for [[i row] (map vector (range) (:rows table))] + + [:tr {:class " border-b dark:border-gray-600 hover:bg-gray-100 dark:hover:bg-gray-700"} + (for [[i c] (map vector (range) (take cell-count + (reduce + (fn [[acc cnt] cur] + (if (>= (+ cnt (:colspan cur 1)) cell-count) + (reduced (conj acc cur)) + [(conj acc cur) (+ cnt (:colspan cur 1))])) + [[] 0] + (concat row (repeat nil)))))] + + (cell {:click-event click-event} c))])) + (conj [:tr (for [i (range cell-count)] + + ( cell {:click-event click-event} {:value " "}))]))) + )])) + +(defn concat-tables [tables] + (let [[first & rest] tables] + {:header (:header first) + :rows (concat (:rows first) + [[]] + (mapcat + (fn [table] + (-> (:header table) + (into (:rows table)) + (conj []))) + rest))})) + + +(defn run-balance-sheet [{:keys [query-params] :as request}] + (let [client-ids (:client (:query-params request)) + + _ (when (not (seq client-ids)) + (throw (ex-info "Please select a client." {:validation-error "Please select a client."}))) + _ (doseq [client-id client-ids] + (assert-can-see-client (:identity request) client-id)) + end-date (coerce/to-date (:date (:query-params request))) + comparable-date (coerce/to-date (:comparison-date (:query-params request))) + all-ledger-entries (->> client-ids + (map (fn [client-id] + [client-id (full-ledger-for-client client-id)])) + (into {})) + lookup-account (->> client-ids + (map (fn [client-id] + [client-id (build-account-lookup client-id)])) + (into {})) + data (cond-> {:balance-sheet-accounts (mapcat + #(roll-up-until (lookup-account %) (all-ledger-entries %) end-date) + client-ids)} + #_#_(:include_comparison args) (assoc :comparable-balance-sheet-accounts (mapcat + #(roll-up-until (lookup-account %) (all-ledger-entries %) comparable-date) + client-ids)) + true <-graphql) + args (assoc query-params + :periods (filter identity (cond-> [(:date query-params)] + (:include-comparison query-params) (conj (:comparison-date query-params))))) + clients (pull-many (dc/db conn) [:client/code :client/name :db/id] client-ids) + + _ (alog/peek ::clients clients) + data (concat (->> (:balance-sheet-accounts data) + (map (fn [b] + (assoc b + :period (:date args))))) + (->> (:comparable-balance-sheet-accounts data) + (map (fn [b] + (assoc b + :period (:comparison-date args)))))) + pnl-data (l-reports/->PNLData args data (by :db/id :client/code clients)) + client-count (count (set (map :client-id (:data pnl-data)))) + + report (l-reports/summarize-balance-sheet pnl-data) ] + (alog/info ::balance-sheet :params args) + + + (html-response + [:div.text-2xl.font-bold.text-gray-600 (format "HELLO %d" client-count) + [:div.max-w-screen-2xl + (table {:widths (cond-> (into [30 ] (repeat 13 client-count)) + (:include-comparison args) (into (repeat 13 (* 2 client-count)))) + :click-event ::investigate-clicked + :table report} )]]))) + +(defn form [request] + (fc/start-form + (:form-params request) + (:form-errors request) + [:div + [:form {:hx-get (bidi.bidi/path-for ssr-routes/only-routes ::route/run-balance-sheet) + :hx-target "#report"} + [:div.flex.gap-2 + (fc/with-field :client + (com/multi-typeahead {:name (fc/field-name) + :class "w-64" + :id "client" + :url (bidi/path-for ssr-routes/only-routes :company-search) + :value (fc/field-value) + :value-fn :db/id + :content-fn :client/name})) + (fc/with-field :date + (com/inline-field {:label "Date"} (com/date-input {:placeholder "12/21/2020" + :name (fc/field-name) + :value (fc/field-value)}))) + (com/button {:color :primary} + "Run")]] + [:div#report]])) + +(defn balance-sheet [request] + (base-page + request + (com/page {:nav (:nav grid-page) + + :client-selection (:client-selection request) + :clients (:clients request) + :client (:client request) + :identity (:identity request) + :request request} + (apply com/breadcrumbs {} (:breadcrumbs grid-page)) + (when (:above-grid grid-page) + ((:above-grid grid-page) request)) + (form request)) + (if (string? (:title grid-page)) + (:title grid-page) + ((:title grid-page) request)))) + +(def key->handler + (apply-middleware-to-all-handlers + (-> + {::route/balance-sheet balance-sheet + ::route/run-balance-sheet run-balance-sheet}) + (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-must {:activity :import :subject :ledger}) + (wrap-client-redirect-unauthenticated))))) \ No newline at end of file