(ns auto-ap.ssr.ledger (:require [auto-ap.client-routes :as client-routes] [auto-ap.datomic :refer [add-sorter-fields apply-pagination apply-sort-3 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-admin assert-can-see-client exception->notification extract-client-ids notify-if-locked]] [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.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 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? 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] [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 "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 (seq (:numeric-code args)) (:account args) (:db/id (:bank-account args)) (not-empty (:location args))) (merge-query {:query {:where ['[?e :journal-entry/line-items ?li]]}}) (seq (:numeric-code 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 [(vec (for [{:keys [from to]} (:numeric-code args)] [(or from 0) (or to 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-3 (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/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 {:date-range [:date-range :start-date :end-date]} [:sort {:optional true} [:maybe [:any]]] [:per-page {:optional true :default 25} [:maybe :int]] [:start {:optional true :default 0} [:maybe :int]] [:amount-gte {:optional true} [:maybe :double]] [:amount-lte {:optional true} [:maybe :double]] [:vendor {:optional true :default nil} [:maybe [:entity-map {:pull [:db/id :vendor/name]}]]] [:bank-account {:optional true :default nil} [:maybe [:entity-map {:pull [:db/id :bank-account/name]}]]] [:account {:optional true :default nil} [:maybe [:entity-map {:pull [:db/id :account/name]}]]] [:check-number {:optional true} [:maybe [:string {:decode/string strip}]]] [:invoice-number {:optional true} [:maybe [:string {:decode/string strip}]]] [:status {:optional true} [:maybe (ref->enum-schema "invoice-status")]] [:exact-match-id {:optional true} [:maybe entity-id]] [:all-selected {:optional true :default nil} [:maybe :boolean]] [:selected {:optional true :default nil} [:maybe [:vector {:coerce? true} entity-id]]] [:start-date {:optional true} [:maybe clj-date-schema]] [:end-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)) (defn render-lines [key {:journal-entry/keys [line-items client]}] (let [lines (for [jel line-items :when (and (key jel) (not (dollars-0? (key jel))))] jel)] [:div.grid.grid-cols-2.gap-1.auto-cols-min.grid-flow-row.shrink (for [jel lines :let [account (d-accounts/clientize (:journal-entry-line/account jel) (:db/id client)) account-name (or (:account/name account) (:bank-account/name (:journal-entry-line/account jel)))]] (list (if account-name [:div.text-left (:journal-entry-line/location jel) ": " (or (:account/numeric-code account) (:bank-account/numeric-code account)) " - " account-name] [:div.text-left (com/pill {:color :yellow} "Unassigned")]) [:div.text-right (format "$%,.2f" (key jel))])) (when-not (= 1 (count lines)) [:div.col-span-2 (com/pill {:color :primary} "Total: " (->> lines (map #(or (key %) 0.0)) (reduce + 0.0) (format "$%,.2f")))])])) ;; 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 :invoice/client :client/name) (map #(com/pill {:color :primary} (-> % :invoice-expense-account/location)) (:invoice/expense-accounts x)) ])} {: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 (partial render-lines :journal-entry-line/debit)} {:key "credit" :name "Credit" :sort-key "credit" :class "text-right" :render (partial render-lines :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"})))) (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 (-> {::route/all-page (-> (helper/page-route grid-page :parse-query-params? false) (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/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)))))