Bryce
a01dfc197e
Migrate every part of the Transaction Edit modal's HTML to Selmer templates
(zero Hiccup in the render path) and delete the mm multi-modal "wizard"
abstraction entirely -- there was only ever one step.
- New auto-ap.ssr.components.selmer (sc) + ~22 shared component partials under
resources/templates/components/ (typeahead, button-group, radio-card,
data-grid, validated-field, modal, buttons, inputs, SVGs). Each wrapper renders
its own partial; dynamic HTMX/Alpine attrs bridge via attrs->str -> {{attrs|safe}}.
- 15 modal templates under resources/templates/transaction-edit/.
- Delete EditWizard/LinksStep records + all mm/* usage. Plain handlers: flat
wrap-decode-edit (fields renamed off step-params[...], stray keys stripped),
flat wrap-derive-state, *errors*-based field errors, generic wrap-form-4xx-2.
- Drop the edit-wizard-navigate route (routes ~12 -> 5).
- Fix: stray `method` (tab button-group hidden) leaked into the upsert -> 500;
strip decoded map to schema keys.
- e2e selectors updated (#wizard-form->#edit-form, #wizardmodal->#editmodal,
step-params[...] field names). Parity: swap 6/6, edit 8/8, suite 38/1
(1 pre-existing unrelated nav test).
- ssr-form-migration skill updated with the learnings (composition mechanics,
sc/* library, drop-the-wizard recipe, scorecard row, 3 new gotchas).
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
1557 lines
82 KiB
Clojure
1557 lines
82 KiB
Clojure
(ns auto-ap.ssr.transaction.edit
|
||
(:require
|
||
[auto-ap.datomic
|
||
:refer [audit-transact conn pull-attr pull-ref]]
|
||
[auto-ap.datomic.accounts :as d-accounts]
|
||
[auto-ap.datomic.checks :as d-checks]
|
||
[auto-ap.datomic.invoices :as d-invoices]
|
||
[auto-ap.datomic.transactions :as d-transactions]
|
||
[auto-ap.graphql.utils :refer [assert-can-see-client assert-not-locked
|
||
exception->4xx]]
|
||
[auto-ap.import.transactions :as i-transactions]
|
||
[auto-ap.logging :as alog]
|
||
[auto-ap.permissions :refer [wrap-must]]
|
||
[auto-ap.routes.payments :as payment-route]
|
||
[auto-ap.routes.transactions :as route]
|
||
[auto-ap.routes.utils
|
||
:refer [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.components :as com]
|
||
[auto-ap.ssr.components.inputs :as inputs]
|
||
[auto-ap.ssr.components.selmer :as sc]
|
||
[auto-ap.ssr.grid-page-helper :as helper]
|
||
[auto-ap.ssr.transaction.common :refer [grid-page]]
|
||
[auto-ap.ssr.hx :as hx]
|
||
[auto-ap.ssr.nested-form-params :refer [wrap-nested-form-params]]
|
||
[auto-ap.ssr.selmer :as sel]
|
||
[auto-ap.ssr.utils
|
||
:refer [->db-id apply-middleware-to-all-handlers assert-schema
|
||
check-allowance check-location-belongs entity-id
|
||
form-validation-error html-response main-transformer
|
||
modal-response path->name2 ref->enum-schema strip temp-id
|
||
wrap-form-4xx-2 wrap-schema-enforce]]
|
||
[auto-ap.time :as atime]
|
||
[bidi.bidi :as bidi]
|
||
[clj-time.coerce :as coerce]
|
||
[clojure.edn :as edn]
|
||
[clojure.string :as str]
|
||
[datomic.api :as dc]
|
||
[hiccup.util :as hu]
|
||
[iol-ion.query :refer [dollars=]]
|
||
[iol-ion.tx :refer [random-tempid]]
|
||
[malli.core :as mc]))
|
||
|
||
(declare render-full-form wrap-div)
|
||
|
||
(def transaction-approval-status
|
||
{:transaction-approval-status/unapproved "Unapproved"
|
||
:transaction-approval-status/approved "Approved"
|
||
:transaction-approval-status/suppressed "Client Review"})
|
||
|
||
(def row* (partial helper/row* grid-page))
|
||
|
||
(defn get-vendor [vendor-id]
|
||
(dc/pull
|
||
(dc/db conn)
|
||
[:vendor/terms
|
||
:vendor/automatically-paid-when-due
|
||
{:vendor/default-account d-accounts/default-read
|
||
:vendor/account-overrides
|
||
[:vendor-account-override/client
|
||
{:vendor-account-override/account d-accounts/default-read}]}
|
||
{:vendor/terms-overrides
|
||
[:vendor-terms-override/client :vendor-terms-override/terms]}]
|
||
vendor-id))
|
||
|
||
(defn check-vendor-default-account [vendor-id]
|
||
(some? (:vendor/default-account (get-vendor vendor-id))))
|
||
|
||
(defn require-approval [s]
|
||
[:and s
|
||
[:fn {:error/message "Approved transactions must have accounts assigned."}
|
||
(fn [{:transaction/keys [accounts approval-status]}]
|
||
(or (not= approval-status :transaction-approval-status/approved)
|
||
(seq accounts)))]])
|
||
|
||
(def edit-form-schema
|
||
(mc/schema
|
||
[:and
|
||
[:map
|
||
[:db/id {:optional true} [:maybe entity-id]]
|
||
[:action [:enum :apply-rule :unlink-payment :link-unpaid-invoices :link-autopay-invoices :link-payment :manual]]
|
||
[:transaction/memo {:optional true} [:maybe [:string {:decode/string strip}]]]
|
||
[:transaction/vendor {:optional true} [:maybe entity-id]]
|
||
[:transaction/approval-status {:optional true} [:maybe (ref->enum-schema "transaction-approval-status")]]
|
||
[:amount-mode {:optional true} [:maybe [:enum "$" "%"]]]
|
||
[:mode {:optional true} [:maybe [:enum "simple" "advanced"]]]
|
||
[:transaction/accounts {:optional true}
|
||
[:maybe
|
||
[:vector {:coerce? true}
|
||
[:and
|
||
[:map
|
||
[:db/id {:optional true} [:maybe [:or temp-id entity-id]]]
|
||
[:transaction-account/account [:and entity-id
|
||
[:fn {:error/message "Not an allowed account."}
|
||
#(check-allowance % :account/default-allowance)]]]
|
||
[:transaction-account/location :string]
|
||
[:transaction-account/amount :double]]
|
||
[:fn {:error/fn (fn [r x] (:type r))
|
||
:error/path [:transaction-account/location]}
|
||
(fn [iea]
|
||
(check-location-belongs (:transaction-account/location iea)
|
||
(:transaction-account/account iea)))]]]]]]
|
||
[:multi {:dispatch :action}
|
||
[:apply-rule [:map
|
||
[:rule-id {:optional true} [:maybe entity-id]]]]
|
||
[:unlink-payment [:map
|
||
[:transaction-id entity-id]]]
|
||
[:link-unpaid-invoices [:map
|
||
[:unpaid-invoice-ids {:decode/string (fn [x] (edn/read-string x))}
|
||
[:vector {:coerce? true} entity-id]]]]
|
||
[:link-autopay-invoices [:map
|
||
[:autopay-invoice-ids {:decode/string (fn [x] (edn/read-string x))} [:vector {:coerce? true} entity-id]]]]
|
||
[:link-payment [:map
|
||
[:payment-id entity-id]]]
|
||
[:manual (require-approval [:map])]]]))
|
||
|
||
(defn clientize-vendor [{:vendor/keys [terms-overrides automatically-paid-when-due default-account account-overrides] :as vendor} client-id]
|
||
(if (nil? vendor)
|
||
nil
|
||
(let [terms-override (->> terms-overrides
|
||
(filter (fn [to]
|
||
(= (->db-id (:vendor-terms-override/client to))
|
||
client-id)))
|
||
(map :vendor-terms-override/terms)
|
||
first)
|
||
account (or (->> account-overrides
|
||
(filter (fn [to]
|
||
(= (->db-id (:vendor-account-override/client to))
|
||
client-id)))
|
||
(map :vendor-account-override/account)
|
||
first)
|
||
default-account)
|
||
account (d-accounts/clientize account client-id)
|
||
|
||
automatically-paid-when-due (->> automatically-paid-when-due
|
||
(filter (fn [to]
|
||
(= (->db-id to)
|
||
client-id)))
|
||
seq
|
||
boolean)
|
||
vendor (cond-> vendor
|
||
terms-override (assoc :vendor/terms terms-override)
|
||
true (assoc :vendor/automatically-paid-when-due automatically-paid-when-due
|
||
:vendor/default-account account)
|
||
true (dissoc :vendor/account-overrides :vendor/terms-overrides))]
|
||
vendor)))
|
||
|
||
(defn vendor-default-account [vendor-id client-id]
|
||
(when vendor-id
|
||
(let [vendor (get-vendor vendor-id)
|
||
clientized (clientize-vendor vendor client-id)]
|
||
(:vendor/default-account clientized))))
|
||
|
||
(defn location-select*
|
||
"The location <select> for an account row, rendered from a Selmer template
|
||
(templates/components/location-select.html) -- the first interactive modal component
|
||
migrated off Hiccup. Same options/selection/styling as the old com/select, emitted as
|
||
plain HTML and embedded back into the Hiccup row via the interop bridge."
|
||
[{:keys [name account-location client-locations value]}]
|
||
(let [options (cond account-location
|
||
[[account-location account-location]]
|
||
|
||
(seq client-locations)
|
||
(into [["Shared" "Shared"]]
|
||
(for [cl client-locations]
|
||
[cl cl]))
|
||
|
||
:else
|
||
[["Shared" "Shared"]])
|
||
selected (or value (ffirst options))
|
||
classes (str/join " " (conj (vec inputs/default-input-classes) "w-full"))]
|
||
(sel/render->hiccup
|
||
"templates/components/location-select.html"
|
||
{:name name
|
||
:classes classes
|
||
:options (for [[v label] options]
|
||
{:value v :label label :selected (= v selected)})})))
|
||
|
||
(defn account-typeahead*
|
||
[{:keys [name value client-id x-model]}]
|
||
(wrap-div
|
||
"flex flex-col"
|
||
(sc/typeahead {:name name
|
||
:placeholder "Search..."
|
||
:url (hu/url (bidi/path-for ssr-routes/only-routes :account-search)
|
||
(cond-> {:purpose "transaction"}
|
||
client-id (assoc :client-id client-id)))
|
||
:id name
|
||
:x-model x-model
|
||
:value value
|
||
:content-fn (fn [value]
|
||
(:account/name (d-accounts/clientize (dc/pull (dc/db conn) d-accounts/default-read value)
|
||
client-id)))})))
|
||
|
||
(def ^:dynamic *errors*
|
||
"Humanized form errors for the current render, keyed by edit-form-schema paths (e.g.
|
||
{:transaction/accounts {0 {:transaction-account/account [\"...\"]}}}). Bound by
|
||
render-form from the request's :form-errors. Plain map -- no wizard, no cursor."
|
||
{})
|
||
|
||
(defn fname
|
||
"Form-field name for a schema path, e.g. (fname :transaction/accounts 0
|
||
:transaction-account/account) => \"transaction/accounts[0][transaction-account/account]\".
|
||
No step-params prefix: posted fields decode straight into edit-form-schema."
|
||
[& path]
|
||
(apply path->name2 path))
|
||
|
||
(defn ferr
|
||
"Field errors at a schema path, read from *errors* (no step-params prefix)."
|
||
[& path]
|
||
(get-in *errors* (vec path)))
|
||
|
||
(defn- account-field-name [index field]
|
||
(fname :transaction/accounts index field))
|
||
|
||
(defn- account-field-errors [index field]
|
||
(ferr :transaction/accounts index field))
|
||
|
||
(defn wrap-div
|
||
"Trivial structural wrapper <div class=...> around already-rendered HTML fragments.
|
||
Plain-string composition (not Hiccup) -- the substantive markup lives in Selmer
|
||
component templates; this just nests their output."
|
||
[class & body]
|
||
(sel/raw (str "<div class=\"" class "\">"
|
||
(apply str (map str (remove nil? body)))
|
||
"</div>")))
|
||
|
||
(defn simple-mode-fields*
|
||
"Renders the simple-mode account + location row and the toggle-to-advanced link.
|
||
Must be called within a fc/start-form + fc/with-field :step-params context.
|
||
Caller must establish Alpine x-data with simpleAccountId in scope.
|
||
|
||
The single account row is rendered from explicit data with explicit field names
|
||
(account-field-name 0 ...) rather than faking a synthetic MapCursor rooted at
|
||
accounts[0] -- the row always lives at index 0 in simple mode."
|
||
[request]
|
||
(let [snapshot (-> request :multi-form-state :snapshot)
|
||
step-params (-> request :multi-form-state :step-params)
|
||
client-id (or (-> request :entity :transaction/client :db/id)
|
||
(:transaction/client snapshot))
|
||
existing-row (first (or (seq (:transaction/accounts step-params))
|
||
(seq (:transaction/accounts snapshot))))
|
||
account-val (let [av (:transaction-account/account existing-row)]
|
||
(if (map? av) (:db/id av) av))
|
||
location-val (or (:transaction-account/location existing-row) "Shared")
|
||
account-id (when (nat-int? account-val)
|
||
(dc/pull (dc/db conn) '[:account/location] account-val))
|
||
row-id (or (:db/id existing-row) (str (java.util.UUID/randomUUID)))
|
||
total (Math/abs (or (-> request :entity :transaction/amount)
|
||
(:transaction/amount snapshot)
|
||
0.0))
|
||
location-attrs {:x-hx-val:account-id "simpleAccountId"
|
||
:hx-vals (hx/json (cond-> {:name (account-field-name 0 :transaction-account/location)}
|
||
client-id (assoc :client-id client-id)))
|
||
:x-dispatch:changed "simpleAccountId"
|
||
:hx-trigger "changed"
|
||
:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-target "#simple-account-location"
|
||
:hx-select "#simple-account-location"
|
||
:hx-swap "outerHTML"
|
||
:hx-include "closest form"}]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/simple-mode.html"
|
||
{:row_id_hidden (str (sc/hidden {:name (account-field-name 0 :db/id) :value row-id}))
|
||
;; Selecting the account only affects the valid Location options, so the change
|
||
;; swaps just the #simple-account-location cell -- nothing else re-renders.
|
||
:account_field (str (sc/validated-field
|
||
{:label "Account"
|
||
:errors (account-field-errors 0 :transaction-account/account)}
|
||
(wrap-div "w-72"
|
||
(account-typeahead* {:value account-val
|
||
:client-id client-id
|
||
:name (account-field-name 0 :transaction-account/account)
|
||
:x-model "simpleAccountId"}))))
|
||
:location_field (str (sc/validated-field
|
||
(merge {:label "Location"
|
||
:errors (account-field-errors 0 :transaction-account/location)}
|
||
location-attrs)
|
||
(location-select*
|
||
{:name (account-field-name 0 :transaction-account/location)
|
||
:account-location (:account/location account-id)
|
||
:client-locations (pull-attr (dc/db conn) :client/locations client-id)
|
||
:value location-val})))
|
||
:amount_hidden (str (sc/hidden {:name (account-field-name 0 :transaction-account/amount)
|
||
:value total}))
|
||
:toggle_attrs (sc/attrs->str {:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-vals (hx/json {:op "toggle-mode"})
|
||
:hx-include "closest form"
|
||
:hx-target "#edit-form"
|
||
:hx-select "#edit-form"
|
||
:hx-swap "outerHTML"})})))
|
||
|
||
(defn- manual-mode-initial
|
||
"Returns :simple or :advanced based on existing account row count."
|
||
[snapshot]
|
||
(let [rows (seq (:transaction/accounts snapshot))]
|
||
(if (and rows (> (count rows) 1))
|
||
:advanced
|
||
:simple)))
|
||
|
||
(defn transaction-account-row*
|
||
"One row of the advanced account grid, from a plain account map (no cursor). The
|
||
location cell swaps just itself (#account-location-<index>, Rule 2); the amount cell
|
||
swaps only #account-totals (Rule 4); remove swaps the whole #edit-form (Rule 3)."
|
||
[{:keys [value client-id amount-mode index]}]
|
||
(let [account-val (let [av (:transaction-account/account value)]
|
||
(if (map? av) (:db/id av) av))
|
||
location-attrs {:x-hx-val:account-id "accountId"
|
||
:hx-vals (hx/json (cond-> {:name (account-field-name index :transaction-account/location)}
|
||
client-id (assoc :client-id client-id)))
|
||
:x-dispatch:changed "accountId"
|
||
:hx-trigger "changed"
|
||
:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-target (str "#account-location-" index)
|
||
:hx-select (str "#account-location-" index)
|
||
:hx-swap "outerHTML"
|
||
:hx-include "closest form"}
|
||
amount-attrs {:name (account-field-name index :transaction-account/amount)
|
||
:id (str "account-amount-" index)
|
||
:class "w-16 account-amount-field"
|
||
:value (:transaction-account/amount value)
|
||
:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-target "#account-totals"
|
||
:hx-select "#account-totals"
|
||
:hx-swap "outerHTML"
|
||
:hx-trigger "keyup changed delay:300ms"
|
||
:hx-include "closest form"}]
|
||
(sc/data-grid-row
|
||
(-> {:class "account-row"
|
||
:id (str "account-row-" index)
|
||
:x-data (hx/json {:show (boolean (not (:new? value)))
|
||
:accountId account-val})
|
||
:data-key "show"
|
||
:x-ref "p"}
|
||
hx/alpine-mount-then-appear)
|
||
(sc/hidden {:name (account-field-name index :db/id)
|
||
:value (:db/id value)})
|
||
(sc/data-grid-cell
|
||
{}
|
||
(sc/validated-field
|
||
{:errors (account-field-errors index :transaction-account/account)}
|
||
(account-typeahead* {:value account-val
|
||
:client-id client-id
|
||
:name (account-field-name index :transaction-account/account)
|
||
:x-model "accountId"})))
|
||
(sc/data-grid-cell
|
||
{:id (str "account-location-" index)}
|
||
(sc/validated-field
|
||
(merge {:errors (account-field-errors index :transaction-account/location)}
|
||
location-attrs)
|
||
(location-select* {:name (account-field-name index :transaction-account/location)
|
||
:account-location (:account/location (when (nat-int? account-val)
|
||
(dc/pull (dc/db conn) '[:account/location] account-val)))
|
||
:client-locations (pull-attr (dc/db conn) :client/locations client-id)
|
||
:value (:transaction-account/location value)})))
|
||
(sc/data-grid-cell
|
||
{}
|
||
(sc/validated-field
|
||
{:errors (account-field-errors index :transaction-account/amount)}
|
||
(if (= "%" amount-mode)
|
||
(sc/text-input (assoc amount-attrs :type "number" :step "0.01"))
|
||
(sc/money-input amount-attrs))))
|
||
(sc/data-grid-cell
|
||
{:class "align-top"}
|
||
(sc/a-icon-button {:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-vals (hx/json {:op "remove-account" :row-index (or index 0)})
|
||
:hx-target "#edit-form"
|
||
:hx-select "#edit-form"
|
||
:hx-swap "outerHTML"
|
||
:hx-include "closest form"
|
||
:class "account-remove-action"}
|
||
(sc/render "templates/components/svg-x.html" {}))))))
|
||
|
||
(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-total* [request]
|
||
(let [total (->> (-> request
|
||
:multi-form-state
|
||
:step-params
|
||
:transaction/accounts)
|
||
(map (fnil :transaction-account/amount 0.0))
|
||
(filter number?)
|
||
(reduce + 0.0))]
|
||
(format "$%,.2f" total)))
|
||
|
||
(defn account-balance* [request]
|
||
(let [total (->> (-> request
|
||
:multi-form-state
|
||
:step-params
|
||
:transaction/accounts)
|
||
(map (fnil :transaction-account/amount 0.0))
|
||
(filter number?)
|
||
(reduce + 0.0))
|
||
balance (-
|
||
(Math/abs (or (-> request :entity :transaction/amount)
|
||
(-> request :multi-form-state :snapshot :transaction/amount)
|
||
0.0))
|
||
total)]
|
||
(sel/raw (str "<span"
|
||
(when-not (dollars= 0.0 balance) " class=\"text-red-300\"")
|
||
">" (format "$%,.2f" balance) "</span>"))))
|
||
|
||
(defn ->percentage [amount total]
|
||
(when (and amount total (not= total 0))
|
||
(* 100.0 (/ amount total))))
|
||
|
||
(defn percentages->dollars [percentages total]
|
||
(let [total-cents (int (* 100 (Math/abs total)))
|
||
pct-sum (reduce + 0 percentages)
|
||
normalized-pcts (if (zero? pct-sum)
|
||
(repeat (count percentages) 0)
|
||
(map #(* (/ % pct-sum) 100) percentages))
|
||
individual-cents (map #(int (* total-cents (/ % 100))) normalized-pcts)
|
||
short-by (- total-cents (reduce + 0 individual-cents))
|
||
adjustments (concat (take short-by (repeat 1)) (repeat 0))
|
||
final-cents (map + individual-cents adjustments)]
|
||
(map #(* 0.01 %) final-cents)))
|
||
|
||
(defn convert-accounts-mode [accounts old-mode new-mode total]
|
||
(if (= old-mode new-mode)
|
||
accounts
|
||
(let [amounts (map :transaction-account/amount accounts)]
|
||
(map #(assoc %1 :transaction-account/amount %2)
|
||
accounts
|
||
(case [old-mode new-mode]
|
||
["$" "%"] (map #(->percentage % total) amounts)
|
||
["%" "$"] (percentages->dollars amounts total)
|
||
amounts)))))
|
||
|
||
(defn- bold-right [label]
|
||
(sel/raw (str "<span class=\"font-bold text-right\">" label "</span>")))
|
||
|
||
(defn account-totals-tbody*
|
||
"The separately-swappable totals <tbody> (Rule 4 target #account-totals)."
|
||
[request total]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/account-totals.html"
|
||
{:rows (str
|
||
(sc/data-grid-row {:class "account-total-row"}
|
||
(sc/data-grid-cell {})
|
||
(sc/data-grid-cell {:class "text-right"} (bold-right "TOTAL"))
|
||
(sc/data-grid-cell {:id "total" :class "text-right"} (account-total* request))
|
||
(sc/data-grid-cell {}))
|
||
(sc/data-grid-row {:class "account-balance-row"}
|
||
(sc/data-grid-cell {})
|
||
(sc/data-grid-cell {:class "text-right"} (bold-right "BALANCE"))
|
||
(sc/data-grid-cell {:id "balance" :class "text-right"} (account-balance* request))
|
||
(sc/data-grid-cell {}))
|
||
(sc/data-grid-row {:class "account-grand-total-row"}
|
||
(sc/data-grid-cell {})
|
||
(sc/data-grid-cell {:class "text-right"} (bold-right "TRANSACTION TOTAL"))
|
||
(sc/data-grid-cell {:class "text-right"} (format "$%,.2f" total))
|
||
(sc/data-grid-cell {})))}))
|
||
|
||
(defn account-grid-body* [request]
|
||
(let [snapshot (-> request :multi-form-state :snapshot)
|
||
step-params (-> request :multi-form-state :step-params)
|
||
amount-mode (or (:amount-mode snapshot) "$")
|
||
client-id (-> request :entity :transaction/client :db/id)
|
||
total (Math/abs (or (-> request :entity :transaction/amount)
|
||
(:transaction/amount snapshot)
|
||
0.0))
|
||
accounts (vec (or (seq (:transaction/accounts step-params))
|
||
(:transaction/accounts snapshot)
|
||
[]))]
|
||
(apply
|
||
sc/data-grid
|
||
{:headers [(sc/data-grid-header {} "Account")
|
||
(sc/data-grid-header {:class "w-32"} "Location")
|
||
(sc/data-grid-header {:class "w-16"}
|
||
(sc/radio-card {:options [{:value "$" :content "$"}
|
||
{:value "%" :content "%"}]
|
||
:value amount-mode
|
||
:name "amount-mode"
|
||
:orientation :horizontal
|
||
:hx-vals (hx/json {:op "toggle-amount-mode"})
|
||
:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-target "#edit-form"
|
||
:hx-select "#edit-form"
|
||
:hx-swap "outerHTML"
|
||
:hx-include "closest form"}))
|
||
(sc/data-grid-header {:class "w-16"})]
|
||
:footer-tbody (account-totals-tbody* request total)}
|
||
(concat
|
||
(map-indexed
|
||
(fn [index account]
|
||
(transaction-account-row* {:value account
|
||
:client-id client-id
|
||
:amount-mode amount-mode
|
||
:index index}))
|
||
accounts)
|
||
[(sc/data-grid-row
|
||
{:class "new-row"}
|
||
(sc/data-grid-cell {:colspan 4}
|
||
(sc/a-button {:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-vals (hx/json {:op "new-account"})
|
||
:hx-target "#edit-form"
|
||
:hx-select "#edit-form"
|
||
:hx-swap "outerHTML"
|
||
:hx-include "closest form"
|
||
:color :secondary}
|
||
"New account")))]))))
|
||
|
||
(defn manual-coding-section*
|
||
"Renders the vendor field + account/location section for the manual tab.
|
||
mode is :simple or :advanced.
|
||
In simple mode, establishes Alpine x-data with simpleAccountId in scope.
|
||
Must be called within a fc/start-form + fc/with-field :step-params context."
|
||
[mode request]
|
||
(let [snapshot (-> request :multi-form-state :snapshot)
|
||
step-params (-> request :multi-form-state :step-params)
|
||
all-accounts (or (seq (:transaction/accounts step-params))
|
||
(seq (:transaction/accounts snapshot)))
|
||
row-count (count all-accounts)
|
||
vendor-val (:transaction/vendor step-params)
|
||
toggle-attrs (fn [] (sc/attrs->str {:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-vals (hx/json {:op "toggle-mode"})
|
||
:hx-include "closest form"
|
||
:hx-target "#edit-form"
|
||
:hx-select "#edit-form"
|
||
:hx-swap "outerHTML"}))]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/manual-coding.html"
|
||
{:mode_hidden (str (sc/hidden {:name "mode" :value (name mode)}))
|
||
:vendor_changed_attrs (sc/attrs->str {:hx-trigger "change"
|
||
:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-form-changed)
|
||
:hx-vals (hx/json {:op "vendor-changed"})
|
||
:hx-target "#edit-form"
|
||
:hx-select "#edit-form"
|
||
:hx-swap "outerHTML"
|
||
:hx-sync "this:replace"
|
||
:hx-include "closest form"})
|
||
:vendor_field (str (sc/validated-field
|
||
{:label "Vendor" :errors (ferr :transaction/vendor)}
|
||
(wrap-div "w-96"
|
||
(sc/typeahead {:name (fname :transaction/vendor)
|
||
:error? (boolean (seq (ferr :transaction/vendor)))
|
||
:class "w-96"
|
||
:placeholder "Search..."
|
||
:url (bidi/path-for ssr-routes/only-routes :vendor-search)
|
||
:value vendor-val
|
||
:content-fn (fn [c] (pull-attr (dc/db conn) :vendor/name c))}))))
|
||
:is_simple (= mode :simple)
|
||
:simple_xdata (when (= mode :simple)
|
||
(hx/json {:simpleAccountId (let [av (-> (first all-accounts) :transaction-account/account)]
|
||
(if (map? av) (:db/id av) av))}))
|
||
:simple_mode (when (= mode :simple) (str (simple-mode-fields* request)))
|
||
:toggle_link (when (and (not= mode :simple) (<= row-count 1))
|
||
(str (wrap-div "mb-2"
|
||
(sel/raw (str "<a class=\"text-sm text-blue-600 hover:underline cursor-pointer\""
|
||
(toggle-attrs)
|
||
">Switch to simple mode</a>")))))
|
||
:accounts_field (when (not= mode :simple)
|
||
(str (sc/validated-field
|
||
{:errors (ferr :transaction/accounts)}
|
||
(sel/raw (str "<div id=\"account-grid-body\">"
|
||
(str (account-grid-body* request))
|
||
"</div>")))))})))
|
||
|
||
(defn apply-toggle-amount-mode
|
||
"edit-form-changed op: convert account amounts between $ and % and record the new mode."
|
||
[request]
|
||
(let [snapshot (-> request :multi-form-state :snapshot)
|
||
step-params (-> request :multi-form-state :step-params)
|
||
old-mode (or (:amount-mode snapshot) "$")
|
||
new-mode (or (:amount-mode step-params) "$")
|
||
total (Math/abs (or (:transaction/amount snapshot) 0.0))
|
||
;; Convert the LIVE rows (step-params), not the stale snapshot, so amounts the
|
||
;; user typed before toggling survive. step-params is already schema-decoded.
|
||
accounts (convert-accounts-mode (or (seq (:transaction/accounts step-params))
|
||
(:transaction/accounts snapshot))
|
||
old-mode new-mode total)]
|
||
(-> request
|
||
(assoc-in [:multi-form-state :snapshot :transaction/accounts] accounts)
|
||
(assoc-in [:multi-form-state :snapshot :amount-mode] new-mode))))
|
||
|
||
(defn transaction-details-panel [tx]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/details-panel.html"
|
||
{:amount (format "$%,.2f" (Math/abs (or (:transaction/amount tx) 0.0)))
|
||
:date (some-> tx :transaction/date coerce/to-date-time (atime/unparse-local atime/normal-date))
|
||
:bank_account (or (-> tx :transaction/bank-account :bank-account/name) "-")
|
||
:post_date (some-> tx :transaction/post-date coerce/to-date-time (atime/unparse-local atime/normal-date))
|
||
:description_original (or (:transaction/description-original tx) "No original description")
|
||
:description_simple (or (:transaction/description-simple tx) "-")
|
||
:check_number (or (:transaction/check-number tx) "-")
|
||
:status (or (some-> tx :transaction/status) "-")
|
||
:type (or (some-> tx :transaction/type) "-")}))
|
||
|
||
(defn get-available-payments [request]
|
||
(let [tx-id (or (get-in request [:form-params :transaction-id])
|
||
(-> request :multi-form-state :snapshot :db/id)
|
||
(get-in request [:route-params :db/id]))
|
||
tx (when tx-id (d-transactions/get-by-id tx-id))
|
||
client-id (-> tx :transaction/client :db/id)
|
||
payments (when client-id
|
||
(dc/q '[:find [(pull ?p [:db/id :payment/invoice-number :payment/amount :payment/date
|
||
{:payment/vendor [:db/id :vendor/name]}]) ...]
|
||
:in $ ?client
|
||
:where
|
||
[?p :payment/client ?client]
|
||
[?p :payment/status :payment-status/pending]]
|
||
(dc/db conn)
|
||
client-id))]
|
||
(filter #(dollars= (Math/abs (:transaction/amount tx)) (:payment/amount %)) payments)))
|
||
|
||
(defn get-available-autopay-invoices [request]
|
||
(let [tx-id (or (-> request :multi-form-state :snapshot :db/id)
|
||
(get-in request [:route-params :db/id]))
|
||
tx (when tx-id (d-transactions/get-by-id tx-id))
|
||
client-id (-> request :entity :transaction/client :db/id)
|
||
matches-set (when (and tx client-id)
|
||
(i-transactions/match-transaction-to-unfulfilled-autopayments
|
||
(:transaction/amount tx)
|
||
client-id))]
|
||
(when matches-set
|
||
(for [matches matches-set]
|
||
(for [[_ invoice-id] matches]
|
||
(d-invoices/get-by-id invoice-id))))))
|
||
|
||
(defn- panel-wrap [inner]
|
||
(sel/raw (str "<div>" (str inner) "</div>")))
|
||
|
||
(defn- panel-empty* [message]
|
||
(sel/render->hiccup "templates/transaction-edit/panel-empty.html" {:message message}))
|
||
|
||
(defn- panel-list* [{:keys [heading action-hidden prompt radio]}]
|
||
(sel/render->hiccup "templates/transaction-edit/panel-list.html"
|
||
{:heading heading
|
||
:action_hidden (str action-hidden)
|
||
:prompt prompt
|
||
:radio (str radio)}))
|
||
|
||
(defn- invoice-group-content [match-group]
|
||
(sel/raw (apply str (for [invoice match-group]
|
||
(sel/render "templates/transaction-edit/invoice-option.html"
|
||
{:number (:invoice/invoice-number invoice)
|
||
:vendor (-> invoice :invoice/vendor :vendor/name)
|
||
:date (some-> invoice :invoice/date coerce/to-date-time (atime/unparse-local atime/normal-date))
|
||
:amount (format "$%.2f" (:invoice/outstanding-balance invoice))})))))
|
||
|
||
(defn autopay-invoices-view [request]
|
||
(let [invoice-matches (get-available-autopay-invoices request)]
|
||
(panel-wrap
|
||
(if (seq invoice-matches)
|
||
(panel-list* {:heading "Available Autopay Invoices"
|
||
:action-hidden (sc/hidden {:name "action" :value "link-autopay-invoices"})
|
||
:prompt "Select an autopay invoice to apply:"
|
||
:radio (sc/radio-card {:options (for [match-group invoice-matches]
|
||
{:value (pr-str (map :db/id match-group))
|
||
:content (invoice-group-content match-group)})
|
||
:name (fname :autopay-invoice-ids)
|
||
:width "w-full"})})
|
||
(panel-empty* "No matching autopay invoices available for this transaction.")))))
|
||
|
||
(defn get-available-unpaid-invoices [request]
|
||
(let [tx-id (or (-> request :multi-form-state :snapshot :db/id)
|
||
(get-in request [:route-params :db/id]))
|
||
tx (when tx-id (d-transactions/get-by-id tx-id))
|
||
client-id (or (get-in request [:multi-form-state :snapshot :transaction/client])
|
||
(get-in request [:client :db/id]))
|
||
matches-set (when (and tx client-id)
|
||
(i-transactions/match-transaction-to-unpaid-invoices
|
||
(:transaction/amount tx)
|
||
client-id))]
|
||
(when matches-set
|
||
(for [matches matches-set]
|
||
(for [[_ invoice-id] matches]
|
||
(d-invoices/get-by-id invoice-id))))))
|
||
|
||
(defn unpaid-invoices-view [request]
|
||
(let [invoice-matches (get-available-unpaid-invoices request)]
|
||
(panel-wrap
|
||
(if (seq invoice-matches)
|
||
(panel-list* {:heading "Available Unpaid Invoices"
|
||
:action-hidden (sc/hidden {:name "action" :value "link-unpaid-invoices" :form ""})
|
||
:prompt "Select an unpaid invoice to apply:"
|
||
:radio (sc/radio-card {:options (for [match-group invoice-matches]
|
||
{:value (pr-str (map :db/id match-group))
|
||
:content (invoice-group-content match-group)})
|
||
:name (fname :unpaid-invoice-ids)
|
||
:width "w-full"})})
|
||
(panel-empty* "No matching unpaid invoices available for this transaction.")))))
|
||
|
||
(defn get-available-rules [request]
|
||
(let [tx-id (or (-> request :multi-form-state :snapshot :db/id)
|
||
(get-in request [:route-params :db/id]))
|
||
tx (when tx-id (d-transactions/get-by-id tx-id))
|
||
patterns (dc/q '[:find (pull ?r
|
||
[:db/id
|
||
:transaction-rule/description
|
||
:transaction-rule/note
|
||
:transaction-rule/client-group
|
||
:transaction-rule/dom-gte :transaction-rule/dom-lte
|
||
:transaction-rule/amount-gte :transaction-rule/amount-lte
|
||
:transaction-rule/client :transaction-rule/bank-account
|
||
:transaction-rule/yodlee-merchant])
|
||
:where
|
||
[?r :transaction-rule/description]]
|
||
|
||
(dc/db conn))]
|
||
(when tx
|
||
(->> patterns
|
||
(map first)
|
||
(filter (fn [rule]
|
||
(rm/rule-applies? (-> tx
|
||
(update :transaction/date coerce/to-date))
|
||
(-> rule
|
||
(update :transaction-rule/description #(some-> % iol-ion.query/->pattern))))))))))
|
||
|
||
(defn transaction-rules-view [request]
|
||
(let [matching-rules (get-available-rules request)]
|
||
(panel-wrap
|
||
(if (seq matching-rules)
|
||
(panel-list* {:heading "Matching Transaction Rules"
|
||
:action-hidden (sc/hidden {:name (fname :action) :value "apply-rule" :form ""})
|
||
:prompt "Select a rule to apply:"
|
||
:radio (sc/radio-card {:options (for [{:keys [:db/id :transaction-rule/note :transaction-rule/description]} matching-rules]
|
||
{:value id
|
||
:content (sel/render->hiccup "templates/transaction-edit/rule-option.html"
|
||
{:note note :description description})})
|
||
:name (fname :rule-id)
|
||
:width "w-full"})})
|
||
(panel-empty* "No matching rules found for this transaction.")))))
|
||
|
||
(defn payment-matches-view [request]
|
||
(let [payments (get-available-payments request)
|
||
tx-id (or (-> request :multi-form-state :snapshot :db/id)
|
||
(get-in request [:route-params :db/id]))
|
||
tx (when tx-id (d-transactions/get-by-id tx-id))
|
||
payment (dc/pull
|
||
(dc/db conn)
|
||
'[:payment/amount
|
||
:db/id
|
||
[:payment/date :xform clj-time.coerce/from-date]
|
||
{[:payment/status :xform iol-ion.query/ident] [:db/ident]
|
||
|
||
:payment/vendor [:vendor/name]}]
|
||
|
||
(-> tx :transaction/payment :db/id))]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/payment-matches.html"
|
||
{:inner
|
||
(str
|
||
(if (and payment (:db/id payment))
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/linked-payment.html"
|
||
{:external_link (str (sc/a-icon-button {:href (hu/url (bidi/path-for ssr-routes/only-routes ::payment-route/all-page)
|
||
{:exact-match-id (:db/id payment)})}
|
||
(sc/render "templates/components/svg-external-link.html" {})))
|
||
:number (:payment/invoice-number payment)
|
||
:vendor (-> payment :payment/vendor :vendor/name)
|
||
:amount (some->> (:payment/amount payment) (format "$%.2f"))
|
||
:status (some-> payment :payment/status name)
|
||
:date (some-> payment :payment/date (atime/unparse-local atime/normal-date))
|
||
:payment_id_hidden (str (sc/hidden {:name (fname :payment-id) :value (:db/id payment)}))
|
||
:unlink_attrs (sc/attrs->str {:hx-post (bidi/path-for ssr-routes/only-routes ::route/unlink-payment)
|
||
:hx-trigger "unlinkPayment"
|
||
:hx-target "#payment-matches"
|
||
:hx-include "closest form"
|
||
:hx-swap "outerHTML"
|
||
:hx-confirm "Are you sure you want to unlink this payment?"})
|
||
:unlink_button (str (sc/a-button {:color :red :size :small "@click" "$dispatch('unlinkPayment')"}
|
||
"Unlink Payment"))})
|
||
(if (seq payments)
|
||
(panel-list* {:heading "Available Payments"
|
||
:action-hidden ""
|
||
:prompt "Select a payment to match:"
|
||
:radio (sc/radio-card {:options (for [payment payments]
|
||
{:value (:db/id payment)
|
||
:content (str (:payment/invoice-number payment) " - "
|
||
(-> payment :payment/vendor :vendor/name)
|
||
" - Amount: $" (format "%.2f" (:payment/amount payment))
|
||
" • Date: " (some-> payment :payment/date coerce/to-date-time (atime/unparse-local atime/normal-date)))})
|
||
:name (fname :payment-id)
|
||
:width "w-full"})})
|
||
(panel-empty* "No matching payments available for this transaction."))))})))
|
||
|
||
(defn count-payment-matches [request]
|
||
(count (get-available-payments request)))
|
||
|
||
(defn count-autopay-invoice-matches [request]
|
||
(count (get-available-autopay-invoices request)))
|
||
|
||
(defn count-unpaid-invoice-matches [request]
|
||
(count (get-available-unpaid-invoices request)))
|
||
|
||
(defn count-rule-matches [request]
|
||
(count (get-available-rules request)))
|
||
|
||
(defn- tab-button [{:keys [active value badge-count disabled? relative?] :or {relative? true}} label]
|
||
(sc/button-group-button
|
||
(cond-> {"@click" (str "activeForm = '" active "'")
|
||
:value value
|
||
":class" (str "{ '!bg-primary-200 text-primary-800': activeForm === '" active "'}")}
|
||
relative? (assoc :class "relative")
|
||
disabled? (assoc ":disabled" "!canChange"))
|
||
(when (and badge-count (> badge-count 0))
|
||
(sc/badge {:color "green"} (str badge-count)))
|
||
label))
|
||
|
||
(defn- tabs* [request]
|
||
(sc/button-group
|
||
{:name "method"}
|
||
(tab-button {:active "link-payment" :value "payment"
|
||
:badge-count (count-payment-matches request)} "Link to payment")
|
||
(tab-button {:active "link-unpaid-invoices" :value "unpaid" :disabled? true
|
||
:badge-count (count-unpaid-invoice-matches request)} "Link to unpaid invoices")
|
||
(tab-button {:active "link-autopay-invoices" :value "autopay" :disabled? true
|
||
:badge-count (count-autopay-invoice-matches request)} "Link to autopay invoices")
|
||
(tab-button {:active "apply-rule" :value "rule" :disabled? true
|
||
:badge-count (count-rule-matches request)} "Apply rule")
|
||
(tab-button {:active "manual" :value "manual" :disabled? true :relative? false} "Manual")))
|
||
|
||
(defn- approval-status* [request]
|
||
(let [step-params (-> request :multi-form-state :step-params)
|
||
v (:transaction/approval-status step-params)
|
||
current-value (name (or (if (map? v) (:db/ident v) v)
|
||
:transaction-approval-status/unapproved))]
|
||
(sc/validated-field
|
||
{:label "Status" :errors (ferr :transaction/approval-status)}
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/approval-status.html"
|
||
{:x_data (hx/json {:approvalStatus current-value})
|
||
:status_hidden (str (sc/hidden {:name (fname :transaction/approval-status)
|
||
:value current-value ":value" "approvalStatus"}))
|
||
:buttons (str
|
||
(sc/button-group-button {"@click" "approvalStatus = 'approved'" ":class" "{ '!bg-primary-200 text-primary-800': approvalStatus === 'approved' }" :class "rounded-l-lg"} "Approved")
|
||
(sc/button-group-button {"@click" "approvalStatus = 'unapproved'" ":class" "{ '!bg-primary-200 text-primary-800': approvalStatus === 'unapproved' }" :class "rounded-r-lg"} "Unapproved")
|
||
(sc/button-group-button {"@click" "approvalStatus = 'suppressed'" ":class" "{ '!bg-primary-200 text-primary-800': approvalStatus === 'suppressed' }" :class "rounded-r-lg"} "Client Review"))}))))
|
||
|
||
(defn- links-body* [request mode]
|
||
(let [step-params (-> request :multi-form-state :step-params)
|
||
payment? (:transaction/payment (:entity request))
|
||
action-str (some-> (:action step-params) name)]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/links-body.html"
|
||
{:memo_field (str (sc/validated-field
|
||
{:label "Memo" :errors (ferr :transaction/memo)}
|
||
(wrap-div "w-96"
|
||
(sc/text-input {:value (:transaction/memo step-params)
|
||
:name (fname :transaction/memo)
|
||
:id "edit-memo"
|
||
:error? (ferr :transaction/memo)
|
||
:placeholder "Optional note"}))))
|
||
:x_data (hx/json {:activeForm (if payment? "link-payment" (or action-str "manual"))
|
||
:canChange (boolean (not payment?))})
|
||
:action_hidden (str (sc/hidden {:name (fname :action) :value action-str ":value" "activeForm"}))
|
||
:tabs (str (tabs* request))
|
||
:panel_payment (str (payment-matches-view request))
|
||
:panel_unpaid (str (unpaid-invoices-view request))
|
||
:panel_autopay (str (autopay-invoices-view request))
|
||
:panel_rule (str (transaction-rules-view request))
|
||
:panel_manual (str (manual-coding-section* mode request)
|
||
(approval-status* request))})))
|
||
|
||
(defn- form-errors-html [errors]
|
||
(str "<div id=\"form-errors\">"
|
||
(when (seq errors)
|
||
(str "<span class=\"error-content\"><p class=\"mt-2 text-xs text-red-600 dark:text-red-500 h-4\">"
|
||
(str/join ", " (filter string? errors))
|
||
"</p></span>"))
|
||
"</div>"))
|
||
|
||
(defn- footer* [request]
|
||
(sel/raw
|
||
(str "<div class=\"flex justify-end\"><div class=\"flex items-baseline gap-x-4\">"
|
||
(form-errors-html (:errors (:form-errors request)))
|
||
(str (sc/button {:color :primary :x-ref "next" :class "w-32 wizard-save-action"} "Done"))
|
||
"</div></div>")))
|
||
|
||
(defn render-form
|
||
"Renders the whole plain edit form (no wizard). Binds *errors* from the request's
|
||
:form-errors so the field-level error lookups (ferr) resolve."
|
||
[request]
|
||
(binding [*errors* (or (:form-errors request) {})]
|
||
(let [multi-form-state (:multi-form-state request)
|
||
snapshot (:snapshot multi-form-state)
|
||
step-params (:step-params multi-form-state)
|
||
tx-id (or (:db/id snapshot) (-> request :route-params :db/id))
|
||
tx (d-transactions/get-by-id tx-id)
|
||
;; Preserve an explicit mode choice; fall back to the row-count heuristic only
|
||
;; on initial open.
|
||
mode (keyword (or (:mode step-params) (name (manual-mode-initial snapshot))))
|
||
modal-card (sel/render "templates/transaction-edit/edit-modal.html"
|
||
{:head "<div class=\"p-2\">Edit Transaction</div>"
|
||
:side_panel (str (transaction-details-panel tx))
|
||
:body (str (links-body* request mode))
|
||
:footer (str (footer* request))})]
|
||
(sel/render->hiccup
|
||
"templates/transaction-edit/edit-form.html"
|
||
{:db_id (:db/id snapshot)
|
||
:form_attrs (sc/attrs->str {:hx-ext "response-targets"
|
||
:hx-swap "outerHTML"
|
||
:hx-target-400 "#form-errors .error-content"
|
||
:hx-trigger "submit"
|
||
:hx-target "this"
|
||
:hx-post (bidi/path-for ssr-routes/only-routes ::route/edit-submit)})
|
||
:modal (str (sc/modal {:id "editmodal"} (sel/raw modal-card)))}))))
|
||
|
||
(defmulti save-handler (fn [request]
|
||
(-> request :multi-form-state :snapshot :action)))
|
||
|
||
(defn- default-update-tx [snapshot transaction]
|
||
(merge {:transaction/memo (:transaction/memo snapshot)}
|
||
transaction))
|
||
|
||
(defn- save-linked-transaction [{{snapshot :snapshot} :multi-form-state :as request transaction :entity} payment]
|
||
(exception->4xx #(assert-not-locked (-> transaction :transaction/client :db/id) (:transaction/date transaction)))
|
||
(audit-transact (into
|
||
[{:db/id (:db/id payment)
|
||
:payment/status :payment-status/cleared
|
||
:payment/date (coerce/to-date (first (sort [(:payment/date payment)
|
||
(coerce/to-date-time (:transaction/date transaction))])))}
|
||
[:upsert-transaction
|
||
(default-update-tx
|
||
snapshot
|
||
{:db/id (:db/id transaction)
|
||
:transaction/payment (:db/id payment)
|
||
:transaction/vendor (-> payment :payment/vendor :db/id)
|
||
:transaction/approval-status :transaction-approval-status/approved
|
||
:transaction/accounts [{:db/id (random-tempid)
|
||
:transaction-account/account (:db/id (d-accounts/get-account-by-numeric-code-and-sets 21000 ["default"]))
|
||
:transaction-account/location "A"
|
||
:transaction-account/amount (Math/abs (:transaction/amount transaction))}]})]])
|
||
(:identity request)))
|
||
|
||
(defn- save-memo-only [{{snapshot :snapshot} :multi-form-state :as request}]
|
||
(audit-transact [[:upsert-transaction (default-update-tx snapshot {})]]
|
||
(:identity request)))
|
||
|
||
(defn- is-already-linked-to-this-payment? [transaction payment-id]
|
||
(= (pull-attr (dc/db conn)
|
||
:transaction/payment
|
||
(:db/id transaction))
|
||
payment-id))
|
||
|
||
(defmethod save-handler
|
||
:link-payment [{{{:keys [transaction-id payment-id] :as snapshot} :snapshot} :multi-form-state :as request transaction :entity}]
|
||
(let [payment (d-checks/get-by-id payment-id)]
|
||
|
||
(exception->4xx #(assert-can-see-client (:identity request) (-> transaction :transaction/client :db/id)))
|
||
(exception->4xx #(assert-can-see-client (:identity request) (-> payment :payment/client :db/id)))
|
||
(when (not= (-> transaction :transaction/client :db/id)
|
||
(-> payment :payment/client :db/id))
|
||
(form-validation-error "Clients don't match."
|
||
:payment-client-id (:payment/client payment)
|
||
:transaction-client-id (:transaction/client transaction))
|
||
#_(throw (ex-info "Clients don't match" {:validation-error "Payment and client do not match."})))
|
||
|
||
(when-not (dollars= (- (:transaction/amount transaction))
|
||
(:payment/amount payment))
|
||
(throw (ex-info "Amounts don't match" {:validation-error "Amounts don't match"})))
|
||
(if (is-already-linked-to-this-payment? transaction payment-id)
|
||
(save-memo-only request)
|
||
(save-linked-transaction request payment))
|
||
(solr/touch-with-ledger (:db/id transaction))
|
||
|
||
(modal-response
|
||
(com/success-modal {:title "Transaction linked successfully"}
|
||
|
||
[:p.text-gray-600.mt-2 "The transaction has been linked to the autopay invoices."]
|
||
[:p.text-gray-600.mt-2 "To view the new payment, click "
|
||
(com/link {:href (hu/url (bidi/path-for ssr-routes/only-routes ::payment-route/all-page)
|
||
{:exact-match-id payment-id})
|
||
:hx-boost true}
|
||
"here")
|
||
" to view it."])
|
||
:headers {"hx-trigger" "invalidated"})))
|
||
|
||
(defmethod save-handler :link-autopay-invoices
|
||
[{{{:keys [autopay-invoice-ids] :as snapshot} :snapshot} :multi-form-state :as request transaction :entity}]
|
||
(let [db (dc/db conn)
|
||
invoice-clients (set (map #(pull-ref db :invoice/client %) autopay-invoice-ids))
|
||
invoice-amount (reduce + 0.0 (map #(pull-attr db :invoice/total %) autopay-invoice-ids))]
|
||
|
||
(exception->4xx #(assert-can-see-client (:identity request) (-> transaction :transaction/client :db/id)))
|
||
(exception->4xx #(assert-not-locked (-> transaction :transaction/client :db/id) (:transaction/date transaction)))
|
||
|
||
(when (:transaction/payment transaction)
|
||
(throw (ex-info "Transaction already linked" {:validation-error "Transaction already linked"})))
|
||
|
||
(when (or (> (count invoice-clients) 1)
|
||
(not= (-> transaction :transaction/client :db/id)
|
||
(first invoice-clients)))
|
||
(throw (ex-info "Clients don't match" {:validation-error "Invoice(s) and transaction client do not match."})))
|
||
|
||
(when-not (dollars= (- (:transaction/amount transaction))
|
||
invoice-amount)
|
||
(throw (ex-info "Amounts don't match" {:validation-error "Amounts don't match"})))
|
||
|
||
(let [payment-tx (i-transactions/add-new-payment
|
||
(dc/pull db [:transaction/amount :transaction/date :db/id] (:db/id transaction))
|
||
(map (fn [id]
|
||
(let [entity (dc/pull db [:invoice/vendor :db/id :invoice/total] id)]
|
||
[(or (-> entity :invoice/vendor :db/id)
|
||
(-> entity :invoice/vendor))
|
||
(-> entity :db/id)
|
||
(-> entity :invoice/total)]))
|
||
autopay-invoice-ids)
|
||
(-> transaction :transaction/bank-account :db/id)
|
||
(-> transaction :transaction/client :db/id))]
|
||
(audit-transact (conj payment-tx
|
||
[:upsert-transaction (default-update-tx snapshot {:db/id (:db/id transaction)})]) (:identity request)))
|
||
|
||
(solr/touch-with-ledger (:db/id transaction))
|
||
|
||
(modal-response
|
||
(com/success-modal {:title "Transaction linked successfully"}
|
||
|
||
[:p.text-gray-600.mt-2 "The transaction has been linked to the autopay invoices."])
|
||
:headers {"hx-trigger" "invalidated"})))
|
||
|
||
(defmethod save-handler :link-unpaid-invoices
|
||
[{{{:keys [unpaid-invoice-ids] :as snapshot} :snapshot} :multi-form-state :as request transaction :entity}]
|
||
(let [db (dc/db conn)
|
||
invoice-clients (set (map #(pull-ref db :invoice/client %) unpaid-invoice-ids))
|
||
invoice-amount (reduce + 0.0 (map #(pull-attr db :invoice/outstanding-balance %) unpaid-invoice-ids))]
|
||
|
||
(exception->4xx #(assert-can-see-client (:identity request) (-> transaction :transaction/client :db/id)))
|
||
(exception->4xx #(assert-not-locked (-> transaction :transaction/client :db/id) (:transaction/date transaction)))
|
||
|
||
(when (or (> (count invoice-clients) 1)
|
||
(not= (-> transaction :transaction/client :db/id)
|
||
(first invoice-clients)))
|
||
(throw (ex-info "Clients don't match" {:validation-error "Invoice(s) and transaction client do not match."
|
||
:transaction-client (-> transaction :transaction/client :db/id)
|
||
:invoice-clients invoice-clients})))
|
||
|
||
(when-not (dollars= (- (:transaction/amount transaction))
|
||
invoice-amount)
|
||
(throw (ex-info "Amounts don't match" {:validation-error "Amounts don't match"})))
|
||
|
||
(when (:transaction/payment transaction)
|
||
(throw (ex-info "Transaction already linked" {:validation-error "Transaction already linked"})))
|
||
|
||
(let [payment-tx (i-transactions/add-new-payment
|
||
(dc/pull db [:transaction/amount :transaction/date :db/id] (:db/id transaction))
|
||
(map (fn [id]
|
||
(let [entity (dc/pull db [:invoice/vendor :db/id :invoice/total] id)]
|
||
[(or (-> entity :invoice/vendor :db/id)
|
||
(-> entity :invoice/vendor))
|
||
(-> entity :db/id)
|
||
(-> entity :invoice/total)]))
|
||
unpaid-invoice-ids)
|
||
(-> transaction :transaction/bank-account :db/id)
|
||
(-> transaction :transaction/client :db/id))]
|
||
(audit-transact (conj payment-tx
|
||
[:upsert-transaction (default-update-tx snapshot {:db/id (:db/id transaction)})]) (:identity request)))
|
||
|
||
(solr/touch-with-ledger (:db/id transaction))
|
||
|
||
(modal-response
|
||
(com/success-modal {:title "Transaction linked successfully"}
|
||
|
||
[:p.text-gray-600.mt-2 "The transaction has been linked to the autopay invoices."]
|
||
[:p.text-gray-600.mt-2 "To view the new payment, click "
|
||
(com/link {:href (hu/url (bidi/path-for ssr-routes/only-routes ::payment-route/all-page)
|
||
{:exact-match-id (:db/id (pull-attr (dc/db conn)
|
||
:transaction/payment
|
||
(:db/id transaction)))})
|
||
:hx-boost true}
|
||
"here")
|
||
" to view it."])
|
||
:headers {"hx-trigger" "invalidated"})))
|
||
|
||
(defmethod save-handler
|
||
:apply-rule
|
||
[{{{:keys [rule-id] :as snapshot} :snapshot} :multi-form-state :as request transaction :entity}]
|
||
(let [transaction-rule (dc/pull (dc/db conn)
|
||
[:transaction-rule/description
|
||
:transaction-rule/vendor
|
||
:transaction-rule/accounts
|
||
:transaction-rule/approval-status]
|
||
rule-id)]
|
||
|
||
(exception->4xx #(assert-can-see-client (:identity request) (-> transaction :transaction/client :db/id)))
|
||
(exception->4xx #(assert-not-locked (-> transaction :transaction/client :db/id) (:transaction/date transaction)))
|
||
|
||
(let [description-pattern (some-> transaction-rule :transaction-rule/description iol-ion.query/->pattern)]
|
||
(when (not (rm/rule-applies? transaction {:transaction-rule/description description-pattern}))
|
||
(throw (ex-info "Transaction rule does not apply"
|
||
{:validation-error "Transaction rule does not apply"}))))
|
||
|
||
(when (:transaction/payment transaction)
|
||
(throw (ex-info "Transaction already associated with a payment"
|
||
{:validation-error "Transaction already associated with a payment"})))
|
||
|
||
(let [locations (-> transaction :transaction/client :client/locations)
|
||
updated-tx (rm/apply-rule {:db/id (:db/id transaction)
|
||
:transaction/amount (:transaction/amount transaction)}
|
||
transaction-rule
|
||
locations)
|
||
updated-tx (default-update-tx snapshot updated-tx)]
|
||
(alog/info ::applying-rule-tx :tx-data updated-tx
|
||
:transaction transaction
|
||
:transaction-rule transaction-rule)
|
||
(audit-transact [[:upsert-transaction updated-tx]] (:identity request)))
|
||
|
||
(solr/touch-with-ledger (:db/id transaction))
|
||
|
||
(modal-response
|
||
(com/success-modal {:title "Rule applied successfully"}
|
||
|
||
[:p.text-gray-600.mt-2 "The selected rule has been applied to this transaction."])
|
||
:headers {"hx-trigger" "invalidated"})))
|
||
|
||
(defn- calculate-spread
|
||
"Helper function to calculate the amount to be assigned to each location"
|
||
[shared-amount total-locations]
|
||
(let [base-amount (int (/ shared-amount total-locations))
|
||
remainder (- shared-amount (* base-amount total-locations))]
|
||
{:base-amount base-amount
|
||
:remainder remainder}))
|
||
|
||
(defn- spread-account
|
||
"Spreads the expense account amount across the given locations"
|
||
[locations account]
|
||
(if (= "Shared" (:transaction-account/location account))
|
||
(let [{:keys [base-amount remainder]} (calculate-spread (:transaction-account/amount account) (count locations))]
|
||
(map-indexed (fn [idx _]
|
||
(assoc account
|
||
:db/id (if (= idx 0)
|
||
(:db/id account)
|
||
(random-tempid))
|
||
:transaction-account/amount (+ base-amount (if (< idx remainder) 1 0))
|
||
:transaction-account/location (nth locations idx)))
|
||
locations))
|
||
[account]))
|
||
|
||
(defn- apply-total-delta-to-account [invoice-total eas]
|
||
(when (seq eas)
|
||
(let [leftover (- invoice-total (reduce + 0 (map :transaction-account/amount eas)))
|
||
leftover-beyond-a-single-cent? (or (< leftover -1)
|
||
(> leftover 1))
|
||
leftover (if leftover-beyond-a-single-cent?
|
||
0
|
||
leftover)
|
||
[first-eas & rest] eas]
|
||
(cons
|
||
(update first-eas :transaction-account/amount #(+ % leftover))
|
||
rest))))
|
||
|
||
(defn $->cents [x]
|
||
(int
|
||
(let [result (* 100M (bigdec x))]
|
||
(.setScale result 0 java.math.BigDecimal/ROUND_HALF_UP))))
|
||
|
||
(defn cents->$ [x]
|
||
(double
|
||
(let [result (* 0.01M (bigdec x))]
|
||
(.setScale result 2 java.math.BigDecimal/ROUND_HALF_UP))))
|
||
|
||
(defn maybe-spread-locations
|
||
"Converts any expense account for a \"Shared\" location into a separate expense account for all valid locations for that client"
|
||
([transaction]
|
||
(maybe-spread-locations transaction (pull-attr (dc/db conn) :client/locations (:transaction/client transaction))))
|
||
([transaction locations]
|
||
(clojure.pprint/pprint transaction)
|
||
(update-in transaction
|
||
[:transaction/accounts]
|
||
(fn [accounts]
|
||
(->> accounts
|
||
(map (fn [ea] (update ea :transaction-account/amount $->cents)))
|
||
(mapcat (partial spread-account locations))
|
||
(apply-total-delta-to-account ($->cents (:transaction/amount transaction)))
|
||
(map (fn [ea] (update ea :transaction-account/amount cents->$))))))))
|
||
|
||
(defmethod save-handler :manual
|
||
[{:as request
|
||
transaction :entity
|
||
:keys [multi-form-state]}]
|
||
(let [;; :mode is a UI-only field (simple/advanced); :action/:amount-mode are control
|
||
;; fields. None are Datomic attributes, so strip them before building the upsert
|
||
;; (otherwise :upsert-transaction fails with :db.error/not-an-entity :mode).
|
||
tx-data (-> multi-form-state :snapshot (dissoc :action :mode))
|
||
tx-id (:db/id tx-data)
|
||
client-id (->db-id (:transaction/client tx-data))
|
||
existing-tx (d-transactions/get-by-id tx-id)
|
||
amount-mode (or (:amount-mode tx-data) "$")
|
||
total (Math/abs (or (:transaction/amount existing-tx) 0.0))
|
||
tx-data (if (= "%" amount-mode)
|
||
(update tx-data :transaction/accounts
|
||
#(map (fn [account dollar-amount]
|
||
(assoc account :transaction-account/amount dollar-amount))
|
||
%
|
||
(percentages->dollars (map :transaction-account/amount %) total)))
|
||
tx-data)
|
||
tx-data (dissoc tx-data :amount-mode)
|
||
transaction [:upsert-transaction (maybe-spread-locations (assoc tx-data :db/id tx-id))]]
|
||
|
||
(alog/info ::transaction transaction :entity transaction)
|
||
(exception->4xx #(assert-can-see-client (:identity request) client-id))
|
||
(exception->4xx #(assert-not-locked client-id (:transaction/date existing-tx)))
|
||
|
||
(when (and (= :transaction-approval-status/approved (keyword (:transaction/approval-status tx-data)))
|
||
(not (seq (:transaction/accounts tx-data))))
|
||
(throw (ex-info "Approved transactions must have accounts assigned."
|
||
{:type :form-validation
|
||
:form-validation-errors ["Approved transactions must have accounts assigned."]})))
|
||
|
||
(when (seq (:transaction/accounts tx-data))
|
||
(let [account-total (reduce + 0 (map :transaction-account/amount (:transaction/accounts tx-data)))
|
||
tx-amount (Math/abs (:transaction/amount existing-tx))]
|
||
(when (not (dollars= tx-amount account-total))
|
||
(throw (ex-info (format "The total of your expense accounts ($%,.2f) must equal the transaction amount ($%,.2f)." account-total tx-amount)
|
||
{:type :form-validation
|
||
:form-validation-errors [(format "The total of your expense accounts ($%,.2f) must equal the transaction amount ($%,.2f)." account-total tx-amount)]})))))
|
||
|
||
(let [transaction-result (audit-transact [transaction] (:identity request))]
|
||
(try
|
||
(solr/touch-with-ledger tx-id)
|
||
(catch Exception e
|
||
(alog/error ::cant-save-solr :error e)))
|
||
|
||
(html-response
|
||
(row* (:identity request) (d-transactions/get-by-id tx-id) {:flash? true})
|
||
:headers {"hx-trigger" "modalclose"
|
||
"hx-retarget" (format "#entity-table tr[data-id=\"%d\"]" tx-id)
|
||
"hx-reswap" "outerHTML"}))))
|
||
|
||
(defn unlink-payment [{{{transaction-id :db/id} :snapshot} :multi-form-state :as request}]
|
||
(let [transaction (dc/pull (dc/db conn)
|
||
'[:transaction/approval-status
|
||
:transaction/date
|
||
:transaction/location
|
||
:transaction/vendor
|
||
:transaction/accounts
|
||
:transaction/status
|
||
:transaction/client [:db/id]
|
||
{:transaction/payment [:payment/date
|
||
{[:payment/status :xform iol-ion.query/ident] [:db/ident]} :db/id]}]
|
||
transaction-id)
|
||
payment (-> transaction :transaction/payment)]
|
||
|
||
(exception->4xx #(assert-can-see-client (:identity request) (-> transaction :transaction/client :db/id)))
|
||
(exception->4xx #(assert-not-locked (-> transaction :transaction/client :db/id) (:transaction/date transaction)))
|
||
|
||
(when (not= :payment-status/cleared (-> payment :payment/status))
|
||
(throw (ex-info "Payment can't be undone because it isn't cleared."
|
||
{:validation-error "Payment can't be undone because it isn't cleared."})))
|
||
|
||
(let [is-autopay-payment? (some->> (dc/q {:find ['?sp]
|
||
:in ['$ '?payment]
|
||
:where ['[?ip :invoice-payment/payment ?payment]
|
||
'[?ip :invoice-payment/invoice ?i]
|
||
'[(get-else $ ?i :invoice/scheduled-payment "N/A") ?sp]]}
|
||
(dc/db conn) (:db/id payment))
|
||
seq
|
||
(map first)
|
||
(every? #(instance? java.util.Date %)))]
|
||
(if is-autopay-payment?
|
||
(audit-transact
|
||
(-> [{:db/id (:db/id payment)
|
||
:payment/status :payment-status/pending}
|
||
[:upsert-transaction
|
||
{:db/id (:db/id transaction)
|
||
:transaction/approval-status :transaction-approval-status/unapproved
|
||
:transaction/payment nil
|
||
:transaction/vendor nil
|
||
:transaction/location nil
|
||
:transaction/accounts nil}]
|
||
[:db/retractEntity (:db/id payment)]]
|
||
(into (map (fn [[invoice-payment]]
|
||
[:db/retractEntity invoice-payment])
|
||
(dc/q {:find ['?ip]
|
||
:in ['$ '?p]
|
||
:where ['[?ip :invoice-payment/payment ?p]]}
|
||
(dc/db conn)
|
||
(:db/id payment)))))
|
||
(:identity request))
|
||
(audit-transact
|
||
[{:db/id (:db/id payment)
|
||
:payment/status :payment-status/pending}
|
||
[:upsert-transaction
|
||
{:db/id (:db/id transaction)
|
||
:transaction/approval-status :transaction-approval-status/unapproved
|
||
:transaction/payment nil
|
||
:transaction/vendor nil
|
||
:transaction/location nil
|
||
:transaction/accounts nil}]]
|
||
(:identity request))))
|
||
|
||
(solr/touch-with-ledger (:db/id transaction))
|
||
(html-response (payment-matches-view request)
|
||
:headers {"hx-trigger" "unlinked"})))
|
||
|
||
(defn entity->base
|
||
"The persisted transaction, shaped like the form's base state (what the old snapshot was
|
||
seeded with). The plain form derives its state fresh from this + the live posted form,
|
||
instead of round-tripping an EDN snapshot hidden field."
|
||
[tx-id]
|
||
(-> (dc/pull (dc/db conn)
|
||
'[:db/id
|
||
:transaction/vendor
|
||
:transaction/client
|
||
:transaction/description-original
|
||
:transaction/status
|
||
:transaction/type
|
||
:transaction/memo
|
||
{[:transaction/approval-status :xform iol-ion.query/ident] [:db/ident]}
|
||
:transaction/amount
|
||
:transaction/accounts]
|
||
tx-id)
|
||
(update :transaction/vendor :db/id)
|
||
(update :transaction/client :db/id)))
|
||
|
||
(defn wrap-derive-state
|
||
"Plain-form replacement for the EDN-snapshot round-trip. Builds :multi-form-state from
|
||
the entity (loaded by the db/id hidden field, or the route on initial open) overlaid
|
||
with the live posted step-params -- no serialized snapshot. Runs after wrap-decode /
|
||
wrap-wizard, which provide nested + schema-typed step-params. The 30-odd `:snapshot`
|
||
reads keep working: snapshot is now `entity ∪ step-params`, derived per request."
|
||
[handler]
|
||
(fn [request]
|
||
(let [tx-id (->db-id (or (some-> request :form-params (get "db/id"))
|
||
(-> request :route-params :db/id)))
|
||
base (entity->base tx-id)
|
||
posted (-> request :multi-form-state :step-params)
|
||
;; Fields the form does NOT edit always come from the entity. Everything else is
|
||
;; the live posted form, which is authoritative even when ABSENT -- an absent
|
||
;; field means the user cleared it (e.g. removed all account rows), not "fall
|
||
;; back to the entity's persisted value". Merging base's editable fields back in
|
||
;; would resurrect persisted accounts after a remove-all.
|
||
entity-only (select-keys base [:db/id :transaction/client :transaction/amount
|
||
:transaction/description-original
|
||
:transaction/status :transaction/type])
|
||
;; On initial open there is no posted form -> render the entity. On every post
|
||
;; the form is authoritative for the editable fields.
|
||
step-params (if (seq posted) posted base)
|
||
snapshot (if (seq posted) (merge entity-only posted) base)]
|
||
(handler (-> request
|
||
(assoc :entity (d-transactions/get-by-id tx-id))
|
||
(assoc :multi-form-state {:snapshot snapshot :edit-path [] :step-params step-params}))))))
|
||
|
||
(def ^:private edit-form-keys
|
||
"Top-level keys edit-form-schema recognises (the [:map] fields + every :multi branch
|
||
field). Posted fields outside this set -- e.g. the tab button-group's `method` hidden --
|
||
are dropped so they can't leak into the saved entity (the old step-params[...] prefix
|
||
excluded them implicitly)."
|
||
[:db/id :action :transaction/memo :transaction/vendor :transaction/approval-status
|
||
:amount-mode :mode :transaction/accounts
|
||
:rule-id :transaction-id :unpaid-invoice-ids :autopay-invoice-ids :payment-id])
|
||
|
||
(defn wrap-decode-edit
|
||
"Replaces the wizard's two-key snapshot/step-params decode. Parses the posted (nested)
|
||
form params and decodes them straight into edit-form-schema -- the field names have no
|
||
step-params[...] prefix, so they map directly onto the schema keys. Strips stray
|
||
non-schema fields. wrap-derive-state then fills :snapshot from the entity."
|
||
[handler]
|
||
(-> (fn [request]
|
||
(let [decoded (mc/decode edit-form-schema (:form-params request) main-transformer)
|
||
decoded (if (map? decoded) (select-keys decoded edit-form-keys) {})]
|
||
(handler (assoc request :multi-form-state {:step-params decoded}))))
|
||
(wrap-nested-form-params)))
|
||
|
||
(defn render-full-form
|
||
"Renders the complete edit form for whole-form re-rendering."
|
||
[request]
|
||
(render-form request))
|
||
|
||
(defn open-handler
|
||
"Initial modal open (GET). Wraps the rendered form in the #transitioner shell expected
|
||
by the modal stack."
|
||
[request]
|
||
(modal-response
|
||
(sel/render->hiccup "templates/transaction-edit/transitioner.html"
|
||
{:body (str (render-form request))})))
|
||
|
||
(defn submit-edit
|
||
"Validates the merged record against edit-form-schema (field-level errors surface via
|
||
wrap-form-4xx-2), then dispatches to the save-handler for the chosen action."
|
||
[request]
|
||
(assert-schema edit-form-schema (-> request :multi-form-state :snapshot))
|
||
(save-handler request))
|
||
|
||
(defn- render-form-response
|
||
"wrap-form-4xx-2 form-handler: re-render the whole form with field/form errors."
|
||
[request]
|
||
(html-response (render-form request)
|
||
:headers {"HX-reswap" "outerHTML"}))
|
||
|
||
(defn apply-vendor-changed [request]
|
||
(let [multi-form-state (:multi-form-state request)
|
||
snapshot (:snapshot multi-form-state)
|
||
step-params (:step-params multi-form-state)
|
||
mode (keyword (or (:mode step-params)
|
||
(get (:form-params request) "mode")
|
||
"simple"))
|
||
client-id (or (:transaction/client snapshot)
|
||
(-> request :entity :transaction/client :db/id))
|
||
vendor-id (or (->db-id (:transaction/vendor step-params))
|
||
(->db-id (get step-params "transaction/vendor"))
|
||
(:transaction/vendor snapshot))
|
||
total (Math/abs (or (-> request :entity :transaction/amount)
|
||
(:transaction/amount snapshot)
|
||
0.0))
|
||
amount-mode (or (:amount-mode snapshot) "$")
|
||
existing-accounts (or (seq (:transaction/accounts step-params))
|
||
(seq (:transaction/accounts snapshot)))
|
||
;; The form always submits an account row (even when empty with account=nil),
|
||
;; so we check if any row has a meaningful account ID.
|
||
has-meaningful-accounts? (some #(some? (:transaction-account/account %))
|
||
existing-accounts)
|
||
;; Simple mode: always populate vendor default (overwrite existing).
|
||
;; Advanced mode: populate only when 0 rows OR 1 empty row.
|
||
should-populate? (case mode
|
||
:simple true
|
||
:advanced (or (empty? existing-accounts)
|
||
(and (= 1 (count existing-accounts))
|
||
(not has-meaningful-accounts?))))
|
||
default-account (when (and should-populate? vendor-id client-id)
|
||
(vendor-default-account vendor-id client-id))
|
||
render-request
|
||
(-> (if (and should-populate? vendor-id client-id)
|
||
(let [new-account (cond-> {:db/id (str (java.util.UUID/randomUUID))
|
||
:transaction-account/location (or (:account/location default-account) "Shared")
|
||
:transaction-account/amount (if (= amount-mode "%") 100.0 total)}
|
||
default-account (assoc :transaction-account/account (:db/id default-account)))]
|
||
(-> request
|
||
(assoc-in [:multi-form-state :snapshot :transaction/accounts] [new-account])
|
||
(assoc-in [:multi-form-state :step-params :transaction/accounts] [new-account])))
|
||
request)
|
||
(assoc-in [:multi-form-state :step-params :transaction/vendor] vendor-id))]
|
||
render-request))
|
||
|
||
(defn apply-toggle-mode [request]
|
||
(let [step-params (-> request :multi-form-state :step-params)
|
||
snapshot (-> request :multi-form-state :snapshot)
|
||
current-mode (keyword (or (:mode step-params) "simple"))
|
||
target-mode (if (= current-mode :simple) :advanced :simple)
|
||
;; When switching simple→advanced, promote simple-mode values into accounts
|
||
render-request
|
||
(if (and (= target-mode :advanced)
|
||
(= current-mode :simple))
|
||
;; carry the simple-mode single row into snapshot so the table shows it
|
||
(let [accounts (or (seq (:transaction/accounts step-params))
|
||
(seq (:transaction/accounts snapshot)))]
|
||
(-> request
|
||
(assoc-in [:multi-form-state :snapshot :transaction/accounts]
|
||
(vec accounts))
|
||
(assoc-in [:multi-form-state :step-params :transaction/accounts]
|
||
(vec accounts))
|
||
(assoc-in [:multi-form-state :step-params :mode]
|
||
(name target-mode))))
|
||
;; advanced→simple: take first row only
|
||
(let [first-row (first (or (seq (:transaction/accounts step-params))
|
||
(seq (:transaction/accounts snapshot))))]
|
||
(-> request
|
||
(assoc-in [:multi-form-state :snapshot :transaction/accounts]
|
||
(if first-row [first-row] []))
|
||
(assoc-in [:multi-form-state :step-params :transaction/accounts]
|
||
(if first-row [first-row] []))
|
||
(assoc-in [:multi-form-state :step-params :mode]
|
||
(name target-mode)))))]
|
||
render-request))
|
||
|
||
(defn apply-new-account
|
||
"edit-form-changed op: append a fresh account row."
|
||
[request]
|
||
(let [snapshot (-> request :multi-form-state :snapshot)
|
||
step-params (-> request :multi-form-state :step-params)
|
||
amount-mode (or (:amount-mode step-params) (:amount-mode snapshot) "$")
|
||
total (Math/abs (or (:transaction/amount snapshot) 0.0))
|
||
new-account {:db/id (str (java.util.UUID/randomUUID))
|
||
:new? true
|
||
:transaction-account/location "Shared"
|
||
:transaction-account/amount (if (= amount-mode "%") 100.0 total)}
|
||
;; Append to the LIVE rows (step-params) so values typed before clicking
|
||
;; "New account" are not reverted to the stale snapshot.
|
||
accounts (vec (or (seq (:transaction/accounts step-params))
|
||
(:transaction/accounts snapshot) []))
|
||
updated-accounts (conj accounts new-account)
|
||
updated-request (-> request
|
||
(assoc-in [:multi-form-state :snapshot :transaction/accounts] updated-accounts)
|
||
(assoc-in [:multi-form-state :step-params :transaction/accounts] updated-accounts))]
|
||
updated-request))
|
||
|
||
(defn apply-remove-account
|
||
"edit-form-changed op: remove the account row at form-param row-index."
|
||
[request]
|
||
(let [row-index (some-> request :form-params (get "row-index") Integer/parseInt)
|
||
snapshot (-> request :multi-form-state :snapshot)
|
||
step-params (-> request :multi-form-state :step-params)
|
||
;; Remove from the LIVE rows (step-params) so the surviving rows keep the values
|
||
;; the user typed, rather than reverting to the stale snapshot.
|
||
accounts (vec (or (seq (:transaction/accounts step-params))
|
||
(:transaction/accounts snapshot) []))
|
||
updated-accounts (if (and row-index (< row-index (count accounts)))
|
||
(vec (concat (subvec accounts 0 row-index)
|
||
(subvec accounts (inc row-index))))
|
||
accounts)
|
||
updated-request (-> request
|
||
(assoc-in [:multi-form-state :snapshot :transaction/accounts] updated-accounts)
|
||
(assoc-in [:multi-form-state :step-params :transaction/accounts] updated-accounts))]
|
||
updated-request))
|
||
|
||
(defn edit-form-changed-handler
|
||
"Single whole-form re-render endpoint. Dispatches on the `op` form-param to apply the
|
||
relevant state mutation (vendor change, mode toggle, add/remove row, $/% toggle), then
|
||
re-renders the whole form. A missing/unknown op (a plain dependent-field change) just
|
||
re-renders. Replaces the per-operation edit-wizard-* / toggle-amount-mode routes."
|
||
[request]
|
||
(let [op (get-in request [:form-params "op"])
|
||
request' (case op
|
||
"vendor-changed" (apply-vendor-changed request)
|
||
"toggle-mode" (apply-toggle-mode request)
|
||
"new-account" (apply-new-account request)
|
||
"remove-account" (apply-remove-account request)
|
||
"toggle-amount-mode" (apply-toggle-amount-mode request)
|
||
request)]
|
||
(html-response
|
||
(render-full-form request'))))
|
||
|
||
(def ^:private get-client (fn [request] (-> request :entity :transaction/client)))
|
||
|
||
(def key->handler
|
||
(apply-middleware-to-all-handlers
|
||
{::route/edit-wizard (-> open-handler
|
||
(wrap-must {:activity :edit :subject :transaction} get-client)
|
||
(wrap-derive-state)
|
||
(wrap-decode-edit)
|
||
(wrap-schema-enforce :route-schema [:map [:db/id entity-id]]))
|
||
::route/edit-submit (-> submit-edit
|
||
(wrap-form-4xx-2 render-form-response)
|
||
(wrap-must {:activity :edit :subject :transaction} get-client)
|
||
(wrap-derive-state)
|
||
(wrap-decode-edit))
|
||
::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/edit-form-changed (-> edit-form-changed-handler
|
||
(wrap-derive-state)
|
||
(wrap-decode-edit))
|
||
::route/unlink-payment (-> unlink-payment
|
||
(wrap-must {:activity :edit :subject :transaction} get-client)
|
||
(wrap-derive-state)
|
||
(wrap-decode-edit))}
|
||
(fn [h]
|
||
(-> h
|
||
(wrap-client-redirect-unauthenticated)))))
|
||
|
||
|
||
|