Bryce
a2d8517668
Adversarial review of Phase 6 found the engine's coupling had relocated rather than dissolved: every wizard consumer had to hand-build a decode allowlist, re-implement the open-handler modal wrap, mint temp ids for added rows, and hand-roll the nav buttons + Enter guard. The engine had the information to prevent all four. Now it does: - handle-step-submit strips its own nav fields (wizard-id/current-step/direction) from form-params before calling a step's :decode -- no per-consumer allowlist, and they can no longer leak into the saved entity (the Phase-6 "500 on save" class of bug is structurally impossible). - open-wizard takes an :open-response config fn and owns the create!/render/wrap/thread flow, so modal wizards route through (partial wizard2/open-wizard config) directly. - wizard2/blank-row supplies a temp :db/id (+ :new?) so an added row passes schema validation and the step actually advances. - wizard2/nav-footer emits the direction buttons (Back/advance/Save), marks the primary, and wizard-form guards Enter to trigger the primary button. Consumer (transaction_rules.clj) gets correspondingly leaner: deleted rule-form-keys + the decode allowlist, rule-nav, and the hand-rolled open-rule-wizard; new/edit routes are now (partial wizard2/open-wizard config). A new wizard is now just a config map + the step :render fns. LOC 964 -> 932, and the deleted code was exactly the cross-consumer boilerplate, not modal-specific logic. Verification: rule spec 4/4; full suite 55/55; cljfmt clean. Skill gotchas updated from "three traps" to "use the engine's primitives" (the engine now absorbs them). Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
933 lines
54 KiB
Clojure
933 lines
54 KiB
Clojure
(ns auto-ap.ssr.admin.transaction-rules
|
|
(:require
|
|
[auto-ap.datomic
|
|
:refer [add-sorter-fields apply-pagination apply-sort-3
|
|
audit-transact conn merge-query pull-attr pull-many
|
|
query2 remove-nils]]
|
|
[auto-ap.datomic.accounts :as d-accounts]
|
|
[auto-ap.datomic.transactions :as d-transactions]
|
|
[auto-ap.graphql.utils :refer [extract-client-ids]]
|
|
[auto-ap.query-params :as query-params :refer [wrap-copy-qp-pqp]]
|
|
[auto-ap.routes.admin.transaction-rules :as route]
|
|
[auto-ap.routes.utils
|
|
:refer [wrap-admin wrap-client-redirect-unauthenticated]]
|
|
[auto-ap.rule-matching :as rm]
|
|
[auto-ap.solr :as solr]
|
|
[auto-ap.ssr-routes :as ssr-routes]
|
|
[auto-ap.ssr.company :refer [bank-account-typeahead*]]
|
|
[auto-ap.ssr.components :as com]
|
|
[auto-ap.ssr.components.wizard2 :as wizard2]
|
|
[auto-ap.ssr.grid-page-helper :as helper :refer [wrap-apply-sort]]
|
|
[auto-ap.ssr.hx :as hx]
|
|
[auto-ap.ssr.nested-form-params :as nfp]
|
|
[auto-ap.ssr.svg :as svg]
|
|
[auto-ap.ssr.utils
|
|
:refer [->db-id apply-middleware-to-all-handlers
|
|
default-grid-fields-schema entity-id
|
|
field-validation-error form-validation-error
|
|
html-response main-transformer many-entity modal-response money
|
|
path->name2 percentage ref->enum-schema ref->radio-options regex
|
|
temp-id wrap-entity wrap-form-4xx-2 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]
|
|
[clojure.set :as set]
|
|
[clojure.string :as str]
|
|
[datomic.api :as dc]
|
|
[malli.core :as mc]
|
|
[malli.error :as me]))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Field-name / error helpers for the (de-cursored) rule form. No step-params
|
|
;; prefix -- posted fields decode straight into form-schema. Mirrors edit.clj.
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
(def ^:dynamic *errors*
|
|
"Humanized form errors for the current rule render, keyed by form-schema paths.
|
|
Bound by render-edit-step from the engine ctx :errors."
|
|
{})
|
|
|
|
(defn- fname [& path] (apply path->name2 path))
|
|
(defn- ferr [& path] (get-in *errors* (vec path)))
|
|
(defn- err? [& path] (boolean (seq (apply ferr path))))
|
|
(defn- account-field-name [index field] (path->name2 :transaction-rule/accounts index field))
|
|
(defn- account-field-errors [index field] (ferr :transaction-rule/accounts index field))
|
|
|
|
(def query-schema (mc/schema
|
|
[:maybe
|
|
(into [:map {}
|
|
[:vendor {:optional true :default nil} [:maybe [:entity-map {:pull [:db/id :vendor/name]}]]]]
|
|
default-grid-fields-schema)]))
|
|
(defn filters [request]
|
|
[:form {"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"}
|
|
|
|
[:fieldset.space-y-6
|
|
(com/field {:label "Vendor"}
|
|
(com/typeahead {:name "vendor"
|
|
:placeholder "Search..."
|
|
:url (bidi/path-for ssr-routes/only-routes
|
|
:vendor-search)
|
|
:id (str "vendor-search")
|
|
:value (:vendor (:query-params request))
|
|
:value-fn :db/id
|
|
:content-fn :vendor/name}))
|
|
(com/field {:label "Note"}
|
|
(com/text-input {:name "note"
|
|
:id "note"
|
|
:class "hot-filter"
|
|
:value (:note (:query-params request))
|
|
:placeholder "HOME DEPOT lte 250.0"
|
|
:size :small}))
|
|
|
|
(com/field {:label "Description"}
|
|
(com/text-input {:name "description"
|
|
:id "description"
|
|
:class "hot-filter"
|
|
:value (:description (:query-params request))
|
|
:placeholder "LOWES"
|
|
:size :small}))
|
|
(com/field {:label "Client group"}
|
|
(com/text-input {:name "client-group"
|
|
:id "client-group"
|
|
:class "hot-filter"
|
|
:value (:client-group (:query-params request))
|
|
:placeholder "NTG"
|
|
:size :small}))]])
|
|
|
|
(def default-read '[:db/id
|
|
:transaction-rule/description
|
|
:transaction-rule/note
|
|
:transaction-rule/amount-lte
|
|
:transaction-rule/client-group
|
|
:transaction-rule/amount-gte
|
|
:transaction-rule/dom-lte
|
|
:transaction-rule/dom-gte
|
|
{:transaction-rule/client [:client/name :db/id :client/code :client/locations]}
|
|
{:transaction-rule/bank-account [:db/id :bank-account/name]}
|
|
{:transaction-rule/yodlee-merchant [:db/id :yodlee-merchant/name :yodlee-merchant/yodlee-id]}
|
|
{[:transaction-rule/transaction-approval-status :xform iol-ion.query/ident] [:db/id :db/ident]}
|
|
{:transaction-rule/vendor [:vendor/name :db/id :vendor/default-account]}
|
|
{:transaction-rule/accounts [:transaction-rule-account/percentage
|
|
:transaction-rule-account/location
|
|
{:transaction-rule-account/account [:account/name :db/id :account/numeric-code :account/location
|
|
{:account/client-overrides [:db/id
|
|
:account-client-override/name
|
|
{:account-client-override/client [:db/id :client/name]}]}]}
|
|
:db/id]}])
|
|
|
|
(defn fetch-ids [db request]
|
|
(let [query-params (:query-params request)
|
|
valid-clients (extract-client-ids (:clients request)
|
|
(:client request)
|
|
(:client-id query-params)
|
|
(when (:client-code query-params)
|
|
[:client/code (:client-code query-params)]))
|
|
query (cond-> {:query {:find []
|
|
:in ['$]
|
|
:where []}
|
|
:args [db]}
|
|
(:sort query-params) (add-sorter-fields {"client" ['[?e :transaction-rule/client ?c]
|
|
'[?c :client/name ?sort-client]]
|
|
|
|
"yodlee-merchant" ['[?e :transaction-rule/yodlee-merchant ?ym]
|
|
'[?ym :yodlee-merchant/name ?sort-yodlee-merchant]]
|
|
"bank-account" ['[?e :transaction-rule/bank-account ?ba]
|
|
'[?ba :bank-account/name ?sort-bank-account]]
|
|
"description" ['[?e :transaction-rule/description ?sort-description]]
|
|
"note" ['[?e :transaction-rule/note ?sort-note]]
|
|
"amount-lte" ['[?e :transaction-rule/amount-lte ?sort-amount-lte]]
|
|
"amount-gte" ['[?e :transaction-rule/amount-gte ?sort-amount-gte]]}
|
|
query-params)
|
|
|
|
(= 1 (count valid-clients))
|
|
(merge-query {:query {:in '[?x]
|
|
:where '[[?e :transaction-rule/client ?x]]}
|
|
:args [(first valid-clients)]})
|
|
|
|
(-> query-params :vendor :db/id)
|
|
(merge-query {:query {:in ['?vendor-id]
|
|
:where ['[?e :transaction-rule/vendor ?vendor-id]]}
|
|
:args [(-> query-params :vendor :db/id)]})
|
|
|
|
(not (str/blank? (:note query-params)))
|
|
(merge-query {:query {:in ['?note-pattern]
|
|
:where ['[?e :transaction-rule/note ?n]
|
|
'[(re-find ?note-pattern ?n)]]}
|
|
:args [(re-pattern (str "(?i)" (:note query-params)))]})
|
|
|
|
(not (str/blank? (:description query-params)))
|
|
(merge-query {:query {:in ['?description]
|
|
:where ['[?e :transaction-rule/description ?d]
|
|
'[(clojure.string/lower-case ?d) ?d2]
|
|
'[(clojure.string/includes? ?d2 ?description)]]}
|
|
:args [(clojure.string/lower-case (:description query-params))]})
|
|
|
|
(not (str/blank? (:client-group query-params)))
|
|
(merge-query {:query {:in ['?client-group]
|
|
:where ['[?e :transaction-rule/client-group ?client-group]]}
|
|
:args [(clojure.string/upper-case (:client-group query-params))]})
|
|
|
|
true
|
|
(merge-query {:query {:find ['?e]
|
|
:where ['[?e :transaction-rule/transaction-approval-status]]}}))]
|
|
|
|
(cond->> (query2 query)
|
|
true (apply-sort-3 query-params)
|
|
true (apply-pagination query-params))))
|
|
|
|
(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 fetch-page [request]
|
|
(let [db (dc/db conn)
|
|
{ids-to-retrieve :ids matching-count :count} (fetch-ids db request)]
|
|
|
|
[(->> (hydrate-results ids-to-retrieve db request))
|
|
matching-count]))
|
|
|
|
(def grid-page
|
|
(helper/build {:id "entity-table"
|
|
:nav com/admin-aside-nav
|
|
:page-specific-nav filters
|
|
:fetch-page fetch-page
|
|
:action-buttons (fn [request]
|
|
[(com/button {:hx-get (str (bidi/path-for ssr-routes/only-routes ::route/new-dialog))
|
|
:color :primary}
|
|
"New Transaction Rule")])
|
|
:row-buttons (fn [request entity]
|
|
[(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 delete?"}
|
|
svg/trash)
|
|
(com/icon-button {:hx-get (bidi/path-for ssr-routes/only-routes
|
|
::route/execute-dialog
|
|
:db/id (:db/id entity))}
|
|
svg/play)
|
|
(com/icon-button {:hx-get (bidi/path-for ssr-routes/only-routes
|
|
::route/edit-dialog
|
|
:db/id (:db/id entity))}
|
|
svg/pencil)])
|
|
:breadcrumbs [[:a {:href (bidi/path-for ssr-routes/only-routes :admin)}
|
|
"Admin"]
|
|
[:a {:href (bidi/path-for ssr-routes/only-routes ::route/page)}
|
|
"Transaction Rules"]]
|
|
:title "Rules"
|
|
:entity-name "Rule"
|
|
:query-schema query-schema
|
|
:route ::route/table
|
|
:headers [{:key "client"
|
|
:name "Client"
|
|
:sort-key "client"
|
|
:render #(or (-> % :transaction-rule/client :client/name)
|
|
(some->> % :transaction-rule/client-group (str "group ") (com/pill {:color :primary})))}
|
|
{:key "bank-account"
|
|
:name "Bank account"
|
|
:sort-key "bank-account"
|
|
:render #(-> % :transaction-rule/bank-account :bank-account/name)
|
|
:show-starting "lg"}
|
|
{:key "description"
|
|
:name "Description"
|
|
:sort-key "description"
|
|
:render :transaction-rule/description}
|
|
{:key "amount"
|
|
:name "Amount"
|
|
:sort-key "amount"
|
|
:render (fn [{:transaction-rule/keys [amount-gte amount-lte]}]
|
|
[:div.flex.gap-2 (when amount-gte
|
|
(com/pill {:color :red} (format "more than $%.2f" amount-gte)))
|
|
|
|
(when amount-lte
|
|
(com/pill {:color :primary} (format "less than $%.2f" amount-lte)))])
|
|
:show-starting "md"}
|
|
{:key "note"
|
|
:name "Note"
|
|
:sort-key "note"
|
|
:render :transaction-rule/note}]}))
|
|
|
|
(def row* (partial helper/row* grid-page))
|
|
(def table* (partial helper/table* grid-page))
|
|
|
|
(defn entity->note [{:transaction-rule/keys [amount-lte amount-gte description client dom-lte dom-gte]}]
|
|
(str/join " - " (filter (complement str/blank?)
|
|
[(when client (pull-attr (dc/db conn) :client/code client))
|
|
description
|
|
(when (or amount-lte amount-gte)
|
|
(str (when amount-gte
|
|
(str amount-gte "<"))
|
|
"amt"
|
|
(when amount-lte
|
|
(str "<" amount-lte))))
|
|
|
|
(when (or dom-lte dom-gte)
|
|
(str (when dom-gte
|
|
(str dom-gte "<"))
|
|
"dom"
|
|
(when dom-lte
|
|
(str "<" dom-lte))))])))
|
|
|
|
(defn bank-account-belongs-to-client? [bank-account-id client-id]
|
|
(get (->> (dc/pull (dc/db conn) [{:client/bank-accounts [:db/id]}] client-id)
|
|
:client/bank-accounts
|
|
(map :db/id)
|
|
(set))
|
|
bank-account-id))
|
|
|
|
(defn validate-transaction-rule [form-params]
|
|
(doseq [[{:transaction-rule-account/keys [account location]} i] (map vector (:transaction-rule/accounts form-params) (range))
|
|
:let [account-location (pull-attr (dc/db conn) :account/location account)]
|
|
:when (and account-location (not= account-location location))]
|
|
(field-validation-error (str "must be " account-location)
|
|
[:transaction-rule/accounts i :transaction-rule-account/location]
|
|
:form-params form-params))
|
|
|
|
(let [total (reduce + 0.0 (map :transaction-rule-account/percentage (:transaction-rule/accounts form-params)))]
|
|
(when-not (dollars= 1.0 total)
|
|
(form-validation-error (format "Expense accounts total (%d%%) must add to 100%%" (int (* 100.0 total)))
|
|
:form-params form-params)))
|
|
|
|
(when (and (:transaction-rule/bank-account form-params)
|
|
(not (bank-account-belongs-to-client? (:transaction-rule/bank-account form-params)
|
|
(:transaction-rule/client form-params))))
|
|
(field-validation-error "does not belong to client"
|
|
[:transaction-rule/bank-account]
|
|
:form-params form-params)))
|
|
|
|
(def transaction-read '[{:transaction/client [:client/name]
|
|
:transaction/bank-account [:bank-account/name]}
|
|
:transaction/description-original
|
|
:db/id
|
|
[:transaction/date :xform clj-time.coerce/from-date]])
|
|
|
|
(defn transactions-matching-rule [{{:transaction-rule/keys [description client bank-account amount-lte amount-gte dom-lte dom-gte client-group]}
|
|
:entity
|
|
clients :clients
|
|
only-uncoded? :only-uncoded?}]
|
|
(let [valid-clients (extract-client-ids clients
|
|
client)
|
|
bank-account (or (:db/id bank-account) bank-account)
|
|
|
|
query (cond-> {:query {:find ['(pull ?e read)]
|
|
:in ['$ 'read]
|
|
:where []}
|
|
:args [(dc/db conn) transaction-read]}
|
|
|
|
only-uncoded?
|
|
(merge-query {:query {:where ['[?e :transaction/approval-status :transaction-approval-status/unapproved]]}})
|
|
(not only-uncoded?)
|
|
(merge-query {:query {:where '[[(iol-ion.query/recent-date 60) ?start-date]
|
|
[?e :transaction/date ?d]
|
|
[(>= ?d ?start-date)]]}})
|
|
|
|
description
|
|
(merge-query {:query {:in ['?descr]
|
|
:where ['[(iol-ion.query/->pattern ?descr) ?description-regex]]}
|
|
:args [description]})
|
|
|
|
valid-clients
|
|
(merge-query {:query {:in ['[?xx ...]]
|
|
:where ['[?e :transaction/client ?xx]]}
|
|
:args [(set valid-clients)]})
|
|
|
|
bank-account
|
|
(merge-query {:query {:in ['?bank-account-id]
|
|
:where ['[?e :transaction/bank-account ?bank-account-id]]}
|
|
:args [bank-account]})
|
|
|
|
description
|
|
(merge-query {:query {:where ['[?e :transaction/description-original ?do]
|
|
'[(re-find ?description-regex ?do)]]}})
|
|
|
|
client-group
|
|
(merge-query {:query {:in ['?client-group]
|
|
:where ['[?e :transaction/client ?client-group-client]
|
|
'[?client-group-client :client/groups ?client-group]]}
|
|
:args [client-group]})
|
|
|
|
amount-gte
|
|
(merge-query {:query {:in ['?amount-gte]
|
|
:where ['[?e :transaction/amount ?ta]
|
|
'[(>= ?ta ?amount-gte)]]}
|
|
:args [amount-gte]})
|
|
|
|
amount-lte
|
|
(merge-query {:query {:in ['?amount-lte]
|
|
:where ['[?e :transaction/amount ?ta]
|
|
'[(<= ?ta ?amount-lte)]]}
|
|
:args [amount-lte]})
|
|
|
|
dom-lte
|
|
(merge-query {:query {:in ['?dom-lte]
|
|
:where ['[?e :transaction/date ?transaction-date]
|
|
'[(iol-ion.query/dom ?transaction-date) ?dom]
|
|
'[(<= ?dom ?dom-lte)]]}
|
|
:args [dom-lte]})
|
|
|
|
dom-gte
|
|
(merge-query {:query {:in ['?dom-gte]
|
|
:where ['[?e :transaction/date ?transaction-date]
|
|
'[(iol-ion.query/dom ?transaction-date) ?dom]
|
|
'[(>= ?dom ?dom-gte)]]}
|
|
:args [dom-gte]})
|
|
|
|
true
|
|
(merge-query {:query {:where ['[?e :transaction/id]]}}))
|
|
results (->>
|
|
(query2 query)
|
|
(map first))]
|
|
results))
|
|
|
|
(defn transaction-rule-test-table* [{:keys [entity clients checkboxes? only-uncoded?]}]
|
|
(let [results (transactions-matching-rule
|
|
{:entity entity
|
|
:clients clients
|
|
:only-uncoded? only-uncoded?})]
|
|
|
|
[:div#transaction-test-results
|
|
[:h2.my-4.text-lg.flex {:x-data (hx/json {:resultCount (count results)})} "Matching transactions"
|
|
[:div.ml-4.relative (com/badge {:class "text-[0.6rem]"} (let [cnt (count results)]
|
|
(if (>= cnt 99)
|
|
"99+"
|
|
cnt)))]
|
|
[:div.flex.justify-end.flex-1 [:div.gutter]]]
|
|
(com/data-grid
|
|
{:headers [(when checkboxes?
|
|
(com/data-grid-checkbox-header {:name "all"}))
|
|
(com/data-grid-header {} "Client")
|
|
(com/data-grid-header {} "Bank")
|
|
(com/data-grid-header {} "Date")
|
|
(com/data-grid-header {} "Description")]}
|
|
(for [r (take 15 results)]
|
|
(com/data-grid-row
|
|
{}
|
|
(when checkboxes?
|
|
(com/data-grid-cell {} (com/checkbox {:name "transaction-id" :value (:db/id r)})))
|
|
(com/data-grid-cell {} (-> r :transaction/client :client/name))
|
|
(com/data-grid-cell {} (-> r :transaction/bank-account :bank-account/name))
|
|
(com/data-grid-cell {} (some-> r :transaction/date (atime/unparse-local atime/normal-date)))
|
|
(com/data-grid-cell {} (some-> r :transaction/description-original)))))]))
|
|
|
|
(defn- location-select*
|
|
[{:keys [name account-location client-locations value]}]
|
|
(com/select {:options (into [["" ""]]
|
|
(cond account-location
|
|
[[account-location account-location]]
|
|
|
|
(seq client-locations)
|
|
(into [["Shared" "Shared"]]
|
|
(for [cl client-locations]
|
|
[cl cl]))
|
|
:else
|
|
[["Shared" "Shared"]]))
|
|
:name name
|
|
:value value
|
|
:class "w-full"}))
|
|
|
|
(defn- account-typeahead*
|
|
[{:keys [name value client-id x-model]}]
|
|
[:div.flex.flex-col
|
|
(com/typeahead {:name name
|
|
:placeholder "Search..."
|
|
:url (str (bidi/path-for ssr-routes/only-routes :account-search) "?client-id=" client-id)
|
|
:id name
|
|
:x-model x-model
|
|
:value value
|
|
:content-fn (fn [value]
|
|
(let [a (dc/pull (dc/db conn) d-accounts/default-read value)]
|
|
(when value
|
|
(str
|
|
(:account/numeric-code a)
|
|
" - "
|
|
(:account/name (d-accounts/clientize a
|
|
client-id))))))})])
|
|
|
|
(defn- transaction-rule-account-row*
|
|
"One account-coding row, from a plain account map + its index (no cursor). The Alpine
|
|
cross-field dispatch wiring (clientId -> accountId -> location) is preserved verbatim;
|
|
only the field names/values move from the form cursor to explicit data + path->name2."
|
|
[account index client-id client-locations]
|
|
(let [acct (:transaction-rule-account/account account)
|
|
acct-id (if (map? acct) (:db/id acct) acct)
|
|
aname (account-field-name index :transaction-rule-account/account)
|
|
lname (account-field-name index :transaction-rule-account/location)]
|
|
(com/data-grid-row
|
|
(-> {:x-data (hx/json {:accountId acct-id
|
|
:location (:transaction-rule-account/location account)
|
|
:show (boolean (not (:new? account)))})
|
|
:data-key "show"
|
|
:x-ref "p"}
|
|
hx/alpine-mount-then-appear)
|
|
(com/hidden {:name (account-field-name index :db/id)
|
|
:value (:db/id account)})
|
|
(com/data-grid-cell
|
|
{}
|
|
(com/validated-field
|
|
{:errors (account-field-errors index :transaction-rule-account/account)}
|
|
[:div {:hx-trigger "changed"
|
|
:hx-target "next div"
|
|
:hx-vals (format "js:{name: '%s', 'client-id': event.detail.clientId || '', value: event.detail.accountId || ''}" aname)
|
|
:hx-get (str (bidi/path-for ssr-routes/only-routes ::route/account-typeahead))
|
|
:x-init "$watch('clientId', cid => $dispatch('changed', $data));"}]
|
|
(account-typeahead* {:value acct-id
|
|
:client-id client-id
|
|
:name aname
|
|
:x-model "accountId"})))
|
|
(com/data-grid-cell
|
|
{}
|
|
(com/validated-field
|
|
{:errors (account-field-errors index :transaction-rule-account/location)
|
|
:x-data (hx/json {:location (:transaction-rule-account/location account)})}
|
|
[:div {:hx-trigger "changed"
|
|
:hx-target "next *"
|
|
:hx-swap "outerHTML"
|
|
:hx-vals (format "js:{name: '%s', 'client-id': event.detail.clientId || '', 'account-id': event.detail.accountId || '', value: event.detail.location || ''}" lname)
|
|
:hx-get (bidi/path-for ssr-routes/only-routes ::route/location-select)
|
|
:x-init "$watch('clientId', cid => $dispatch('changed', $data)); $watch('accountId', cid => $dispatch('changed', $data) )"}]
|
|
(location-select* {:name lname
|
|
:account-location (:account/location (when (nat-int? acct-id)
|
|
(dc/pull (dc/db conn) '[:account/location] acct-id)))
|
|
:client-locations client-locations
|
|
:value (:transaction-rule-account/location account)})))
|
|
(com/data-grid-cell
|
|
{}
|
|
(com/validated-field
|
|
{:errors (account-field-errors index :transaction-rule-account/percentage)}
|
|
(com/money-input {:name (account-field-name index :transaction-rule-account/percentage)
|
|
:class "w-16"
|
|
:value (some-> (:transaction-rule-account/percentage account)
|
|
(* 100)
|
|
(long))})))
|
|
(com/data-grid-cell {:class "align-top"}
|
|
(com/a-icon-button {"@click.prevent.stop" "show=false; setTimeout(() => $refs.p.remove(), 500)"} svg/x)))))
|
|
|
|
(defn all-ids-not-locked [all-ids]
|
|
(->> all-ids
|
|
(dc/q '[:find ?t
|
|
:in $ [?t ...]
|
|
:where
|
|
[?t :transaction/client ?c]
|
|
[(get-else $ ?c :client/locked-until #inst "2000-01-01") ?lu]
|
|
[?t :transaction/date ?d]
|
|
[(>= ?d ?lu)]]
|
|
(dc/db conn))
|
|
(map first)))
|
|
|
|
(defn execute [{:keys [form-params clients entity identity]}]
|
|
(let [all-results (->> (transactions-matching-rule {:entity entity
|
|
:clients clients
|
|
:only-uncoded? true})
|
|
(map :db/id)
|
|
(into #{}))
|
|
|
|
ids (if (not-empty (:all form-params))
|
|
all-results
|
|
(set/intersection (into #{} (:transaction-id form-params))
|
|
all-results))
|
|
|
|
ids (all-ids-not-locked ids)
|
|
transactions (transduce
|
|
(comp
|
|
(map d-transactions/get-by-id)
|
|
(map #(update % :transaction/date coerce/to-date)))
|
|
conj
|
|
[]
|
|
ids)
|
|
entity (update entity :transaction-rule/description #(some-> % iol-ion.query/->pattern))
|
|
|
|
;; TODO
|
|
#_#_x (doseq [transaction transactions]
|
|
(when (not (rm/rule-applies? transaction entity))
|
|
(throw (ex-info "Transaction rule does not apply" {:validation-error "Transaction rule does not apply"
|
|
:transaction-rule entity
|
|
:transaction transaction})))
|
|
|
|
(when (:transaction/payment transaction)
|
|
|
|
(throw (ex-info "Transaction already associated with a payment" {:validation-error "Transaction already associated with a payment"}))))]
|
|
|
|
(audit-transact (mapv (fn [t]
|
|
[:upsert-transaction
|
|
(remove-nils (rm/apply-rule {:db/id (:db/id t)
|
|
:transaction/amount (:transaction/amount t)}
|
|
entity
|
|
|
|
(or (-> t :transaction/bank-account :bank-account/locations)
|
|
(-> t :transaction/client :client/locations))))])
|
|
transactions)
|
|
identity)
|
|
(doseq [n transactions]
|
|
(solr/touch-with-ledger (:db/id n)))
|
|
|
|
(html-response [:div]
|
|
:headers {"hx-trigger" (hx/json {:modalclose ""
|
|
:notification (format "Successfully coded %d of %d transactions!"
|
|
(count ids)
|
|
(count all-results))})})))
|
|
|
|
(defn location-select [{{:keys [name account-id client-id value] :as qp} :query-params}]
|
|
(html-response (location-select* {:name name
|
|
:value value
|
|
:account-location (some->> account-id
|
|
(pull-attr (dc/db conn) :account/location))
|
|
:client-locations (some->> client-id
|
|
(pull-attr (dc/db conn) :client/locations))})))
|
|
|
|
(defn account-typeahead [{{:keys [name value client-id] :as qp} :query-params}]
|
|
(html-response (account-typeahead* {:name name
|
|
:value value
|
|
:client-id client-id
|
|
:x-model "accountId"})))
|
|
|
|
(def form-schema (mc/schema
|
|
[:map
|
|
[:db/id {:optional true} [:maybe entity-id]]
|
|
[:transaction-rule/client {:optional true} [:maybe entity-id]]
|
|
[:transaction-rule/client-group {:optional true} [:maybe :string]]
|
|
[:transaction-rule/description [:and regex
|
|
[:string {:min 3}]]]
|
|
[:transaction-rule/bank-account [:maybe entity-id]]
|
|
[:transaction-rule/amount-gte {:optional true} [:maybe money]]
|
|
[:transaction-rule/amount-lte {:optional true} [:maybe money]]
|
|
[:transaction-rule/dom-gte {:optional true} [:maybe :int]]
|
|
[:transaction-rule/dom-lte {:optional true} [:maybe :int]]
|
|
[:transaction-rule/vendor {:optional true} [:maybe entity-id]]
|
|
[:transaction-rule/transaction-approval-status (ref->enum-schema "transaction-approval-status")]
|
|
[:transaction-rule/accounts
|
|
(many-entity {:min 1}
|
|
[:db/id [:or entity-id temp-id]]
|
|
[:transaction-rule-account/account entity-id]
|
|
[:transaction-rule-account/location [:string {:min 1 :error/message "required"}]]
|
|
[:transaction-rule-account/percentage percentage])]]))
|
|
|
|
(defn check-badges [{query-params :query-params}]
|
|
(html-response
|
|
[:div (if (not-empty (:all query-params))
|
|
(com/pill {:color :secondary}
|
|
|
|
[:span "All " [:span {:x-text "resultCount" :x-data "{}"}] " transactions"])
|
|
(com/pill {:color :primary}
|
|
(str (count (:transaction-id query-params)) " transactions")))]))
|
|
|
|
(defn execute-dialog [{:keys [entity clients]}]
|
|
(modal-response
|
|
(com/modal {}
|
|
(com/modal-card-advanced
|
|
{}
|
|
(com/modal-header {} [:div.p-2.flex.space-x-4 [:div "Transaction Rule"] [:div ">"] [:div "Results"]])
|
|
(com/modal-body {} [:form#my-form
|
|
{:hx-post (bidi/path-for ssr-routes/only-routes ::route/execute
|
|
:db/id (:db/id entity))
|
|
:hx-indicator "#code"}
|
|
[:div
|
|
{:hx-get (bidi/path-for ssr-routes/only-routes ::route/check-badges)
|
|
:hx-trigger "change"
|
|
:hx-target "#transaction-test-results .gutter"
|
|
:hx-include "this"}
|
|
(transaction-rule-test-table* {:entity entity
|
|
:clients clients
|
|
:checkboxes? true
|
|
:only-uncoded? true})]])
|
|
(com/modal-footer {} [:div.flex.justify-end (com/validated-save-button {:form "my-form" :id "code"} "Code transactions")])))
|
|
:headers (-> {}
|
|
(assoc "hx-trigger-after-settle" "modalnext")
|
|
(assoc "hx-retarget" ".modal-stack")
|
|
(assoc "hx-reswap" "beforeend"))))
|
|
|
|
(defn delete [{:keys [entity] :as request}]
|
|
@(dc/transact conn [[:db/retractEntity (:db/id entity)]])
|
|
|
|
(html-response (row* (:identity request) entity {:delete-after-settle? true :class "live-removed"})
|
|
:headers {"hx-retarget" (format "#entity-table tr[data-id=\"%d\"]" (:db/id entity))}))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; The rule wizard on the data-driven session engine (wizard2 / wizard-state),
|
|
;; replacing the EditModal/TestModal/TransactionRuleWizard records +
|
|
;; MultiStepFormState + the EDN-snapshot round-trip.
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
(defn- rule-modal-card [& {:keys [head body footer]}]
|
|
(com/modal-card-advanced
|
|
{}
|
|
(com/modal-header {} head)
|
|
(com/modal-body {} body)
|
|
(com/modal-footer {} footer)))
|
|
|
|
(defn render-edit-step
|
|
"Edit step: the rule form, de-cursored (explicit data + path->name2 + *errors*)."
|
|
[{:keys [step-data errors]}]
|
|
(binding [*errors* (or errors {})]
|
|
(let [rule (or step-data {})
|
|
rule-client (:transaction-rule/client rule)
|
|
client-id (if (map? rule-client) (:db/id rule-client) rule-client)
|
|
client-locations (some->> client-id (pull-attr (dc/db conn) :client/locations))
|
|
accounts (vec (:transaction-rule/accounts rule))]
|
|
(rule-modal-card
|
|
:head "Transaction rule"
|
|
:body [:div#my-form {:x-trap "true"}
|
|
[:fieldset {:class "hx-disable"
|
|
:x-data (hx/json {:clientId client-id})}
|
|
[:div.space-y-1
|
|
(when-let [id (:db/id rule)]
|
|
(com/hidden {:name "db/id" :value id}))
|
|
(com/validated-field {:label "Description" :errors (ferr :transaction-rule/description)}
|
|
(com/text-input {:name (fname :transaction-rule/description)
|
|
:error? (err? :transaction-rule/description)
|
|
:x-init "$el.focus()"
|
|
:placeholder "HOME DEPOT"
|
|
:class "w-96"
|
|
:value (:transaction-rule/description rule)}))
|
|
[:div.filters {:x-data (hx/json {:clientFilter (boolean (:transaction-rule/client rule))
|
|
:clientGroupFilter (boolean (:transaction-rule/client-group rule))
|
|
:bankAccountFilter (boolean (:transaction-rule/bank-account rule))
|
|
:amountFilter (boolean (or (:transaction-rule/amount-gte rule) (:transaction-rule/amount-lte rule)))
|
|
:domFilter (boolean (or (:transaction-rule/dom-gte rule) (:transaction-rule/dom-lte rule)))})}
|
|
[:div.flex.gap-2.mb-2
|
|
(com/a-button {"@click" "clientFilter=true" "x-show" "!clientFilter"} "Filter client")
|
|
(com/a-button {"@click" "clientGroupFilter=true" "x-show" "!clientGroupFilter"} "Filter client group")
|
|
(com/a-button {"@click" "bankAccountFilter=true" "x-show" "clientFilter && !bankAccountFilter"} "Filter bank account")
|
|
(com/a-button {"@click" "amountFilter=true" "x-show" "!amountFilter"} "Filter amount")
|
|
(com/a-button {"@click" "domFilter=true" "x-show" "!domFilter"} "Filter day of month")]
|
|
(com/validated-field
|
|
(-> {:label "Client" :errors (ferr :transaction-rule/client) :x-show "clientFilter"} (hx/alpine-appear))
|
|
[:div.w-96
|
|
(com/typeahead {:name (fname :transaction-rule/client)
|
|
:error? (err? :transaction-rule/client)
|
|
:class "w-96" :placeholder "Search..."
|
|
:url (bidi/path-for ssr-routes/only-routes :company-search)
|
|
:x-model "clientId"
|
|
:value rule-client
|
|
:content-fn (fn [c] (pull-attr (dc/db conn) :client/name c))})])
|
|
(com/validated-field
|
|
(-> {:label "Client Group" :errors (ferr :transaction-rule/client-group) :x-show "clientGroupFilter"} (hx/alpine-appear))
|
|
[:div.w-96
|
|
(com/text-input {:name (fname :transaction-rule/client-group)
|
|
:error? (err? :transaction-rule/client-group)
|
|
:class "w-24" :placeholder "NTG"
|
|
:value (:transaction-rule/client-group rule)})])
|
|
(com/validated-field
|
|
(-> {:label "Bank Account" :errors (ferr :transaction-rule/bank-account) :x-show "bankAccountFilter"} hx/alpine-appear)
|
|
[:div.w-96
|
|
[:div#bank-account-changer {:hx-get (bidi/path-for ssr-routes/only-routes :bank-account-typeahead)
|
|
:hx-trigger "changed"
|
|
:hx-target "next *"
|
|
:hx-include "#bank-account-changer"
|
|
:hx-swap "outerHTML"
|
|
:hx-vals (format "js:{name: '%s', 'client-id': event.detail.clientId}" (fname :transaction-rule/bank-account))
|
|
:x-init "$watch('clientId', cid => $dispatch('changed', $data))"}]
|
|
(bank-account-typeahead* {:client-id client-id
|
|
:name (fname :transaction-rule/bank-account)
|
|
:value (:transaction-rule/bank-account rule)})])
|
|
(com/field (-> {:label "Amount" :x-show "amountFilter"} hx/alpine-appear)
|
|
[:div.flex.gap-2
|
|
[:div.flex.flex-col
|
|
(com/money-input {:name (fname :transaction-rule/amount-gte) :placeholder ">=" :class "w-24" :value (:transaction-rule/amount-gte rule)})
|
|
(com/errors {:errors (ferr :transaction-rule/amount-gte)})]
|
|
[:div.flex.flex-col
|
|
(com/money-input {:name (fname :transaction-rule/amount-lte) :placeholder "<=" :class "w-24" :value (:transaction-rule/amount-lte rule)})
|
|
(com/errors {:errors (ferr :transaction-rule/amount-lte)})]])
|
|
(com/field (-> {:label "Day of month" :x-show "domFilter"} hx/alpine-appear)
|
|
[:div.flex.gap-2
|
|
(com/validated-field {:errors (ferr :transaction-rule/dom-gte)}
|
|
(com/int-input {:name (fname :transaction-rule/dom-gte) :placeholder ">=" :class "w-24" :value (:transaction-rule/dom-gte rule)}))
|
|
(com/validated-field {:errors (ferr :transaction-rule/dom-lte)}
|
|
(com/int-input {:name (fname :transaction-rule/dom-lte) :placeholder ">=" :class "w-24" :value (:transaction-rule/dom-lte rule)}))])]
|
|
[:h2.text-lg "Outcomes"]
|
|
(com/validated-field {:label "Assign Vendor" :errors (ferr :transaction-rule/vendor)}
|
|
[:div.w-96
|
|
(com/typeahead {:name (fname :transaction-rule/vendor)
|
|
:placeholder "Search..."
|
|
:url (bidi/path-for ssr-routes/only-routes :vendor-search)
|
|
:class "w-96"
|
|
:value (:transaction-rule/vendor rule)
|
|
:content-fn #(pull-attr (dc/db conn) :vendor/name %)})])
|
|
(com/validated-field
|
|
{:errors (ferr :transaction-rule/accounts)}
|
|
(com/data-grid {:headers [(com/data-grid-header {} "Account")
|
|
(com/data-grid-header {:class "w-32"} "Location")
|
|
(com/data-grid-header {:class "w-16"} "%")
|
|
(com/data-grid-header {:class "w-16"})]}
|
|
(map-indexed (fn [i a] (transaction-rule-account-row* a i client-id client-locations)) accounts)
|
|
(com/data-grid-new-row {:colspan 4
|
|
:hx-get (bidi/path-for ssr-routes/only-routes ::route/new-account)
|
|
:index (count accounts)
|
|
:tr-params (hx/bind-alpine-vals {} {"client-id" "clientId"})}
|
|
"New account")))
|
|
(com/validated-field {:label "Approval status" :errors (ferr :transaction-rule/transaction-approval-status)}
|
|
(com/radio-card {:options (ref->radio-options "transaction-approval-status")
|
|
:value (:transaction-rule/transaction-approval-status rule)
|
|
:name (fname :transaction-rule/transaction-approval-status)
|
|
:size :small
|
|
:orientation :horizontal}))]]]
|
|
:footer (wizard2/nav-footer {:next "Test"})))))
|
|
|
|
(defn render-test-step
|
|
"Test step: a read-only preview of the transactions the rule (the combined session
|
|
data) matches. The query/render is reused unchanged."
|
|
[{:keys [all-data request]}]
|
|
(rule-modal-card
|
|
:head [:div.p-2.flex.space-x-4 [:div "Transaction Rule"] [:div ">"] [:div "Results"]]
|
|
:body [:div.space-y-1 {:class "w-[850px] h-[600px]"}
|
|
(transaction-rule-test-table* {:entity all-data :clients (:clients request)})]
|
|
:footer (wizard2/nav-footer {:back? true :save? true})))
|
|
|
|
(defn- decode-rule-form
|
|
"Parse the posted edit-step fields straight into the rule map (no step-params prefix).
|
|
The engine has already stripped its own nav fields (wizard-id / current-step /
|
|
direction), so they can't leak into the decoded rule."
|
|
[request]
|
|
(let [nested (:form-params (nfp/nested-params-request request {}))]
|
|
(mc/decode form-schema nested main-transformer)))
|
|
|
|
(defn- rule-form-errors
|
|
"Per-step validation: schema-validate so an invalid form can't advance to the test step
|
|
(matches the old navigate-validates behavior). Returns a humanized errors map or nil.
|
|
The full custom checks (percentage sum, location, bank-account) run at save."
|
|
[rule _request]
|
|
(when-not (mc/validate form-schema rule)
|
|
(me/humanize (mc/explain form-schema rule))))
|
|
|
|
(defn save-rule!
|
|
"Engine done-fn: validate + upsert the rule, then return the grid row + modalclose."
|
|
[all-data request]
|
|
(validate-transaction-rule all-data)
|
|
(let [editing? (some? (:db/id all-data))
|
|
entity (cond-> all-data
|
|
(:transaction-rule/client-group all-data) (update :transaction-rule/client-group str/upper-case)
|
|
(not editing?) (assoc :db/id "new")
|
|
true (assoc :transaction-rule/note (entity->note all-data)))
|
|
{:keys [tempids]} (audit-transact [[:upsert-entity entity]] (:identity request))
|
|
saved (dc/pull (dc/db conn) default-read (or (get tempids (:db/id entity)) (:db/id entity)))]
|
|
(html-response
|
|
(row* (:identity request) saved {:flash? true})
|
|
:headers (cond-> {"hx-trigger" "modalclose"}
|
|
(not editing?) (assoc "hx-retarget" "#entity-table tbody" "hx-reswap" "afterbegin")
|
|
editing? (assoc "hx-retarget" (format "#entity-table tr[data-id=\"%d\"]" (:db/id saved)) "hx-reswap" "outerHTML")))))
|
|
|
|
(def transaction-rule-wizard-config
|
|
{:name :transaction-rule
|
|
:form-id "wizard-form"
|
|
:submit-route (bidi/path-for ssr-routes/only-routes ::route/save)
|
|
:form-attrs {:hx-ext "response-targets"
|
|
:hx-target-400 "#form-errors"}
|
|
:init-fn (fn [request]
|
|
{:context {}
|
|
:init-data (when-let [e (:entity request)] {:edit e})})
|
|
;; The engine owns the modal wrap: open-wizard applies this to the rendered form, so the
|
|
;; new/edit routes are just (partial wizard2/open-wizard config) -- no hand-rolled
|
|
;; create!/render/wrap/thread boilerplate.
|
|
:open-response (fn [form]
|
|
(modal-response [:div#transitioner.flex-1 form]))
|
|
:steps [{:key :edit
|
|
:decode decode-rule-form
|
|
:validate rule-form-errors
|
|
:render render-edit-step
|
|
:next (fn [_] :test)}
|
|
{:key :test
|
|
:decode (fn [_] {})
|
|
:render render-test-step
|
|
:next (fn [_] :done)}]
|
|
:done-fn save-rule!})
|
|
|
|
(defn save-step
|
|
"POST handler for every step transition (next / back / save) -- the engine reads the
|
|
`direction` field and either advances, goes back, or finishes via done-fn."
|
|
[request]
|
|
(wizard2/handle-step-submit transaction-rule-wizard-config request))
|
|
|
|
(defn- new-account
|
|
"Render one fresh (de-cursored) account row at the posted index (the data grid's
|
|
newRowIndex Alpine counter increments it for repeated adds)."
|
|
[request]
|
|
(let [idx (-> request :query-params :index)
|
|
idx (if (string? idx) (Integer/parseInt idx) idx)
|
|
client-id (-> request :query-params :client-id)
|
|
client-locations (some->> client-id (pull-attr (dc/db conn) :client/locations))]
|
|
(html-response
|
|
(transaction-rule-account-row* (wizard2/blank-row :transaction-rule-account/location "Shared")
|
|
idx client-id client-locations))))
|
|
|
|
(def key->handler
|
|
(apply-middleware-to-all-handlers
|
|
(->>
|
|
{::route/page (helper/page-route grid-page)
|
|
::route/table (helper/table-route grid-page)
|
|
::route/delete (-> delete
|
|
(wrap-entity [:route-params :db/id] default-read)
|
|
(wrap-schema-enforce :route-params [:map [:db/id entity-id]]))
|
|
::route/new-account
|
|
(-> new-account
|
|
(wrap-schema-enforce :query-schema [:map
|
|
[:index {:optional true} [:maybe nat-int?]]
|
|
[:client-id {:optional true}
|
|
[:maybe entity-id]]]))
|
|
|
|
::route/location-select (-> location-select
|
|
(wrap-schema-enforce :query-schema [:map
|
|
[:name :string]
|
|
[:client-id {:optional true}
|
|
[:maybe entity-id]]
|
|
[:account-id {:optional true}
|
|
[:maybe entity-id]]]))
|
|
::route/account-typeahead (-> account-typeahead
|
|
(wrap-schema-enforce :query-schema [:map
|
|
[:name :string]
|
|
[:client-id {:optional true}
|
|
[:maybe entity-id]]
|
|
[:value {:optional true}
|
|
[:maybe entity-id]]]))
|
|
::route/save save-step
|
|
|
|
::route/execute (-> execute
|
|
(wrap-entity [:route-params :db/id] default-read)
|
|
(wrap-schema-enforce :route-schema [:map [:db/id entity-id]])
|
|
(wrap-schema-enforce :form-schema
|
|
[:map
|
|
[:transaction-id {:optional true}
|
|
[:maybe [:vector {:decode/arbitrary (fn [x] ;; TODO make this easier
|
|
(if (sequential? x)
|
|
x
|
|
[x]))}
|
|
entity-id]]]
|
|
[:all {:optional true} [:maybe :string]]])
|
|
#_(wrap-form-4xx-2 (-> edit-dialog ;; TODO for example not having a single one checked
|
|
(wrap-entity [:form-params :db/id] default-read))))
|
|
|
|
::route/check-badges (-> check-badges
|
|
(wrap-schema-enforce :query-schema [:map
|
|
[:transaction-id {:optional true}
|
|
[:maybe [:vector {:decode/arbitrary (fn [x]
|
|
(if (sequential? x)
|
|
x
|
|
[x]))}
|
|
entity-id]]]
|
|
[:all {:optional true} [:maybe :string]]]))
|
|
::route/execute-dialog (-> execute-dialog
|
|
(wrap-entity [:route-params :db/id] default-read)
|
|
(wrap-schema-enforce :route-schema [:map [:db/id entity-id]]))
|
|
|
|
::route/edit-dialog (-> (partial wizard2/open-wizard transaction-rule-wizard-config)
|
|
(wrap-entity [:route-params :db/id] default-read)
|
|
(wrap-schema-enforce :route-schema [:map [:db/id entity-id]]))
|
|
|
|
::route/new-dialog (partial wizard2/open-wizard transaction-rule-wizard-config)})
|
|
(fn [h]
|
|
(-> h
|
|
(wrap-copy-qp-pqp)
|
|
(wrap-apply-sort grid-page)
|
|
(wrap-merge-prior-hx)
|
|
(wrap-schema-enforce :query-schema query-schema)
|
|
(wrap-schema-enforce :hx-schema query-schema)
|
|
(wrap-admin)
|
|
(wrap-client-redirect-unauthenticated)))))
|