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>
293 lines
16 KiB
Clojure
293 lines
16 KiB
Clojure
(ns auto-ap.ssr.components.selmer
|
|
"Selmer-rendered versions of the shared SSR components used by the Transaction Edit
|
|
modal (see .claude/skills/ssr-form-migration). Each wrapper assembles a plain-data
|
|
context and renders its own template under resources/templates/components/ via the
|
|
interop bridge -- the element structure lives entirely in the .html templates; the
|
|
only Clojure is data assembly. Dynamic HTMX/Alpine attributes (which vary per call
|
|
site) are serialized to an attribute string by `attrs->str` and injected with
|
|
{{ attrs|safe }}, so the templates stay free of per-attribute {% if %} ladders.
|
|
|
|
Reuses class logic from auto-ap.ssr.components.inputs so output matches the Hiccup
|
|
components byte-for-byte modulo Tailwind class ordering (verify by string-match +
|
|
e2e, never byte-parity -- see selmer-conventions.md)."
|
|
(:require
|
|
[auto-ap.ssr.components.buttons :as btn]
|
|
[auto-ap.ssr.components.inputs :as inputs]
|
|
[auto-ap.ssr.hiccup-helper :as hh]
|
|
[auto-ap.ssr.hx :as hx]
|
|
[auto-ap.ssr.selmer :as sel]
|
|
[clojure.string :as str]
|
|
[hiccup.util :as hu]))
|
|
|
|
(defn- attr-name [k]
|
|
(if (keyword? k) (subs (str k) 1) (str k)))
|
|
|
|
(defn attrs->str
|
|
"Serialize an attribute map to an HTML attribute string with a leading space, so it
|
|
concatenates after fixed template attributes: <input type=\"text\"{{ attrs|safe }}>.
|
|
nil/false values are dropped, true renders a bare boolean attribute, everything else
|
|
renders name=\"escaped-value\". Mirrors how hiccup2 emits attributes."
|
|
[m]
|
|
(->> m
|
|
(keep (fn [[k v]]
|
|
(cond
|
|
(nil? v) nil
|
|
(false? v) nil
|
|
(true? v) (str " " (attr-name k))
|
|
:else (str " " (attr-name k) "=\""
|
|
(hu/escape-html (if (keyword? v) (name v) (str v)))
|
|
"\""))))
|
|
(apply str)))
|
|
|
|
(defn render
|
|
"Render a component partial and trim outer whitespace (so {# comments #} and the
|
|
file's trailing newline don't leak into the embedding tree). Returns a raw-wrapped
|
|
string ready to drop into Hiccup or another Selmer context value."
|
|
[template ctx]
|
|
(sel/raw (str/trim (sel/render template ctx))))
|
|
|
|
(defn- body->html
|
|
"Render child content (Hiccup vectors and/or raw Selmer fragments) to an HTML string."
|
|
[body]
|
|
(->> (if (sequential? body) body [body])
|
|
(remove nil?)
|
|
(map sel/hiccup->html)
|
|
(apply str)))
|
|
|
|
;; --- leaf inputs -----------------------------------------------------------------
|
|
|
|
(defn hidden [{:keys [name value] :as params}]
|
|
(render "templates/components/hidden.html"
|
|
{:attrs (attrs->str (merge {:name name}
|
|
(when (some? value) {:value value})
|
|
(dissoc params :name :value)))}))
|
|
|
|
(defn text-input [{:keys [size] :as params}]
|
|
(let [attrs (-> params
|
|
(dissoc :error? :size)
|
|
(assoc :type "text" :autocomplete "off")
|
|
(update :class #(-> ""
|
|
(hh/add-class inputs/default-input-classes)
|
|
(hh/add-class %)))
|
|
(update :class #(str % (inputs/use-size size))))]
|
|
(render "templates/components/text-input.html" {:attrs (attrs->str attrs)})))
|
|
|
|
(defn money-input [{:keys [size] :as params}]
|
|
(let [attrs (-> params
|
|
(dissoc :size)
|
|
(update :class (fnil hh/add-class "") inputs/default-input-classes)
|
|
(update :class hh/add-class "appearance-none text-right")
|
|
(update :class #(str % (inputs/use-size size)))
|
|
(assoc :type "number" :step "0.01"))]
|
|
(render "templates/components/money-input.html" {:attrs (attrs->str attrs)})))
|
|
|
|
;; --- field wrapper ---------------------------------------------------------------
|
|
|
|
(defn validated-field
|
|
"Selmer port of com/validated-field (the errors- variant of field-): label + body +
|
|
an always-present error <p>. Pass-through attrs land on the wrapping div (the account
|
|
row's location cell hangs its swap wiring here)."
|
|
[{:keys [label errors] :as params} & body]
|
|
(let [classes (cond-> (or (:class params) "")
|
|
(sequential? errors) (hh/add-class "has-error")
|
|
:always (hh/add-class "group"))
|
|
attrs (dissoc params :label :errors :error-source :error-key :class)
|
|
errors-str (when (sequential? errors)
|
|
(str/join ", " (filter string? errors)))]
|
|
(render "templates/components/validated-field.html"
|
|
{:label label
|
|
:classes classes
|
|
:attrs (attrs->str attrs)
|
|
:body (body->html body)
|
|
:errors_str (or errors-str "")})))
|
|
|
|
;; --- buttons / badges / links ----------------------------------------------------
|
|
|
|
(defn badge [{:keys [color] :as params} & children]
|
|
(let [classes (-> (hh/add-class
|
|
"absolute inline-flex items-center z-10 justify-center w-6 h-6 text-xs font-black text-white \n border-3 border-white rounded-full -top-2 -right-2 dark:border-gray-900"
|
|
(:class params))
|
|
(hh/add-class (or (some-> color (#(str "bg-" % "-300"))) "bg-red-300")))]
|
|
(render "templates/components/badge.html"
|
|
{:classes classes
|
|
:attrs (attrs->str (dissoc params :class))
|
|
:body (body->html children)})))
|
|
|
|
(defn link [{:keys [class] :as params} & children]
|
|
(render "templates/components/link.html"
|
|
{:classes (str class " font-medium text-blue-600 dark:text-blue-500 hover:underline cursor-pointer")
|
|
:attrs (attrs->str (dissoc params :class))
|
|
:body (body->html children)}))
|
|
|
|
(defn button [{:keys [color disabled minimal-loading?] :as params} & children]
|
|
(let [classes (cond-> (:class params)
|
|
true (str " focus:ring-4 font-bold rounded-lg text-xs p-3 text-center mr-2 inline-flex items-center relative justify-center disabled:opacity-50"
|
|
(btn/bg-colors color disabled))
|
|
(not disabled) (str " hover:scale-105 transition duration-100")
|
|
disabled (str " cursor-not-allowed")
|
|
(some? color) (str " text-white ")
|
|
(nil? color) (str " bg-white dark:bg-gray-600 border-gray-300 dark:border-gray-700 text-gray-500 hover:text-gray-800 dark:text-gray-400 dark:hover:text-gray-100 font-medium border border-gray-300 dark:border-gray-700"))]
|
|
(render "templates/components/button.html"
|
|
{:classes classes
|
|
:attrs (attrs->str (dissoc params :class))
|
|
:loading_label (not minimal-loading?)
|
|
:body (body->html children)})))
|
|
|
|
(defn a-button [{:keys [color disabled] :as params} & children]
|
|
(let [indicator? (:indicator? params true)
|
|
classes (cond-> (:class params)
|
|
true (str " focus:ring-4 font-bold rounded-lg text-xs p-3 text-center mr-2 inline-flex items-center hover:scale-105 transition duration-100 justify-center")
|
|
(= :secondary color) (str " text-white bg-blue-500 hover:bg-blue-600 focus:ring-blue-300 dark:bg-blue-600 dark:hover:bg-blue-700")
|
|
(= :primary color) (str " text-white bg-green-500 hover:bg-green-600 focus:ring-green-300 dark:bg-green-600 dark:hover:bg-green-700 ")
|
|
(= :secondary-light color) (str " text-blue-800 bg-white-200 border-gray-100 border hover:bg-blue-100 focus:ring-blue-100 dark:bg-blue-400 dark:hover:bg-blue-800 ")
|
|
(some? color) (str " text-white " (btn/bg-colors color disabled))
|
|
(nil? color) (str " bg-white dark:bg-gray-600 border-gray-300 dark:border-gray-700 text-gray-500 hover:text-gray-800 dark:text-gray-400 dark:hover:text-gray-100 font-medium border border-gray-300 dark:border-gray-700"))]
|
|
(render "templates/components/a-button.html"
|
|
{:classes classes
|
|
:attrs (attrs->str (-> (dissoc params :class)
|
|
(assoc :tabindex 0 :href (:href params "#"))))
|
|
:indicator indicator?
|
|
:body (body->html children)})))
|
|
|
|
(defn a-icon-button [{:keys [class] :as params} & children]
|
|
(let [class-str (or class "")
|
|
has-padding? (re-find #"\bp[xy]?-\d+(\.\d+)?\b" class-str)
|
|
classes (str class-str (if has-padding? "" " p-3")
|
|
" inline-flex items-center justify-center bg-white dark:bg-gray-600 items-center text-sm font-medium border border-gray-300 dark:border-gray-700 text-center text-gray-500 hover:text-gray-800 rounded-lg dark:text-gray-400 dark:hover:text-gray-100")]
|
|
(render "templates/components/a-icon-button.html"
|
|
{:classes classes
|
|
:attrs (attrs->str (-> (dissoc params :class)
|
|
(assoc :href (or (:href params) ""))))
|
|
:body (body->html children)})))
|
|
|
|
(defn button-group-button [{:keys [size] :or {size :normal} :as params} & children]
|
|
(let [classes (cond-> (:class params)
|
|
true (str " font-medium text-gray-900 bg-white border border-gray-200 hover:bg-gray-100 hover:text-primary-700 focus:z-10 focus:ring-2 focus:ring-green-700 focus:text-green-700 dark:bg-gray-700 dark:border-gray-600 dark:text-white dark:hover:text-white dark:hover:bg-gray-600 dark:focus:ring-green-500 dark:focus:text-white disabled:opacity-50")
|
|
(= :small size) (str " text-xs px-3 py-2")
|
|
(= :normal size) (str " text-sm px-4 py-2"))]
|
|
(render "templates/components/button-group-button.html"
|
|
{:classes classes
|
|
:attrs (attrs->str (-> (dissoc params :class :size)
|
|
(assoc :type (or (:type params) "button"))))
|
|
:body (body->html children)})))
|
|
|
|
(defn button-group [{:keys [name]} & children]
|
|
(render "templates/components/button-group.html"
|
|
{:name name
|
|
:body (body->html children)}))
|
|
|
|
;; --- radio-card ------------------------------------------------------------------
|
|
|
|
(defn radio-card
|
|
"Selmer port of com/radio-card. NB: the Hiccup radio-card- has a dangling [:h3 title]
|
|
the let discards, so only the <ul> renders -- reproduced here. Only the documented
|
|
htmx keys ride onto each <input> (the same select-keys filter; :hx-vals / :hx-select
|
|
are intentionally dropped, matching existing behavior)."
|
|
[{:keys [options name title size orientation width] :or {size :medium width "w-48"}
|
|
selected-value :value :as params}]
|
|
(let [htmx-attrs (select-keys params [:hx-post :hx-target :hx-swap :hx-include :hx-trigger])
|
|
sel (cond-> selected-value (keyword? selected-value) clojure.core/name)
|
|
ul-class (cond-> " text-sm font-medium text-gray-900 bg-white border border-gray-200 rounded-lg dark:bg-gray-700 dark:border-gray-600 dark:text-white"
|
|
(= orientation :horizontal) (-> (hh/add-class "flex gap-2 flex-wrap")
|
|
(hh/remove-wildcard ["w-" "rounded-lg" "border" "bg-"]))
|
|
:always (str " " width " "))
|
|
li-class (cond-> "w-full border-b border-gray-200 rounded-t-lg dark:border-gray-600"
|
|
(= orientation :horizontal) (-> (hh/remove-wildcard ["w-full" "rounded-"])
|
|
(hh/add-class "w-auto shrink-0 block rounded-lg border border-gray-200 dark:border-gray-600 px-3")))
|
|
div-class (cond-> "flex items-center"
|
|
(not= orientation :horizontal) (hh/add-class "pl-3"))
|
|
input-class (cond-> "w-4 h-4 text-blue-600 bg-gray-100 border-gray-300 focus:ring-blue-500 dark:focus:ring-blue-600 dark:ring-offset-gray-700 dark:focus:ring-offset-gray-700 focus:ring-2 dark:bg-gray-600 dark:border-gray-500"
|
|
(= size :small) (str " text-xs")
|
|
(= size :medium) (str " text-sm"))
|
|
label-class (cond-> "w-full ml-2 font-medium text-gray-900 dark:text-gray-300"
|
|
(= size :small) (str " text-xs py-2")
|
|
(= size :medium) (str " text-sm py-3")
|
|
(= orientation :horizontal) (hh/remove-class "w-full"))]
|
|
(render "templates/components/radio-card.html"
|
|
{:ul_class ul-class :li_class li-class :div_class div-class
|
|
:input_class input-class :label_class label-class
|
|
:name name
|
|
:input_attrs (attrs->str htmx-attrs)
|
|
:options (for [{:keys [value content]} options]
|
|
{:id (str "list-" name "-" value)
|
|
:value value
|
|
:checked (= sel value)
|
|
:content (body->html content)})})))
|
|
|
|
;; --- data grid -------------------------------------------------------------------
|
|
|
|
(defn data-grid-header [params & body]
|
|
(render "templates/components/data-grid-header.html"
|
|
{:klass (:class params)
|
|
:click (format "$dispatch('sorted', {key: '%s'})" (:sort-key params))
|
|
:sort_key (:sort-key params)
|
|
:attrs (attrs->str (cond-> {} (:style params) (assoc :style (:style params))))
|
|
:body (body->html body)}))
|
|
|
|
(defn data-grid-row [params & body]
|
|
(render "templates/components/data-grid-row.html"
|
|
{:classes (str (:class params) " border-b dark:border-gray-600 group hover:bg-gray-100 dark:hover:bg-gray-700")
|
|
:attrs (attrs->str (dissoc params :class))
|
|
:body (body->html body)}))
|
|
|
|
(defn data-grid-cell [params & body]
|
|
(render "templates/components/data-grid-cell.html"
|
|
{:klass (:class params)
|
|
:attrs (attrs->str (dissoc params :class))
|
|
:body (body->html body)}))
|
|
|
|
(defn data-grid
|
|
"Table shell: outer scroll div > table > thead(headers) > tbody(rows) + optional
|
|
footer-tbody. `headers`, `rows`, and `footer-tbody` are pre-rendered fragments."
|
|
[{:keys [headers footer-tbody] :as params} & rows]
|
|
(render "templates/components/data-grid.html"
|
|
{:table_class "w-full text-sm text-left text-gray-500 dark:text-gray-400 shrink"
|
|
:table_attrs (attrs->str (dissoc params :headers :thead-params :footer-tbody))
|
|
:thead_class "text-xs text-gray-800 uppercase bg-gray-50 dark:bg-gray-700 dark:text-gray-400 group-[.raw]:sticky group-[.raw]:z-10 group-[.raw]:top-0"
|
|
:headers (body->html headers)
|
|
:rows (body->html rows)
|
|
:footer_tbody (when footer-tbody (body->html footer-tbody))}))
|
|
|
|
;; --- modal + typeahead -----------------------------------------------------------
|
|
|
|
(defn modal [{:as params} & children]
|
|
(render "templates/components/modal.html"
|
|
{:classes (hh/add-class "" (:class params ""))
|
|
:attrs (attrs->str (dissoc params :handle-unexpected-error? :class))
|
|
:body (body->html children)}))
|
|
|
|
(defn typeahead
|
|
"Selmer port of com/typeahead. Resolves the initial {value,label} server-side via
|
|
value-fn/content-fn (DB lookups), builds the Alpine x-data, and serializes the
|
|
hidden posting-input attributes. Preserves every tippy?. null-guard."
|
|
[{:keys [value value-fn content-fn x-model x-init id class placeholder disabled url]
|
|
:as params}]
|
|
(let [vf (or value-fn identity)
|
|
cf (or content-fn identity)
|
|
vval (vf value)
|
|
vlabel (cf value)
|
|
x-data (hx/json {:baseUrl (str url)
|
|
:value {:value vval :label vlabel}
|
|
:tippy nil :search "" :active -1
|
|
:elements (if vval [{:value vval :label vlabel}] [])})
|
|
a-class (-> (hh/add-class (or class "") inputs/default-input-classes)
|
|
(hh/add-class "cursor-pointer"))
|
|
a-xinit (str "$nextTick(() => tippy = $el.__x_tippy); " x-init)
|
|
search-class (-> (or class "")
|
|
(hh/add-class inputs/default-input-classes)
|
|
(hh/replace-wildcard ["rounded" "border"] "border-bottom bg-gray-100 rounded-t-lg w-full"))
|
|
hidden-attrs (-> params
|
|
(dissoc :class :value-fn :content-fn :placeholder :x-model)
|
|
(assoc "x-ref" "hidden" :type "hidden" ":value" "value.value"
|
|
:x-init "$watch('value', v => { $el.value = (v && v.value != null) ? v.value : ''; $nextTick(() => $dispatch('change')); }); "))]
|
|
(render "templates/components/typeahead.html"
|
|
{:x_data x-data
|
|
:x_model x-model
|
|
:key (when id (str id "--" vval))
|
|
:disabled disabled
|
|
:a_class a-class
|
|
:a_xinit a-xinit
|
|
:search_class search-class
|
|
:placeholder placeholder
|
|
:hidden_attrs (attrs->str hidden-attrs)})))
|