Bake the Tailwind class base into the shared Selmer component partials so the partials own their markup and callers pass only data + a small variant (width / size / color). Applies across all four modals that share them (bulk-code, invoices, sales-summaries, transaction-edit). - typeahead / select / location-select / money-input / validated-field / button / a-button / a-icon-button: the class base, the validated-field has-error toggle, and the button color ladders now live in the .html. The sc/*-ctx fns pass width / variant / extra / color plus the non-class attrs (computed exactly as before, so every non-class attribute is unchanged). - bulk-code templates updated to the new partial contracts; account-row pulls money-input and a-icon-button in via includes. Verified: every component's class SET is identical to before across all variants (14/14 oracle match -- buttons reorder/dedupe classes, CSS is order-independent); bulk-code full render is DOM-equivalent to the pre-sweep baseline (class-set + attr-order normalized) for empty / populated / error; browser QA of bulk-code (full flow) and transaction-edit (open + render) clean, no JS errors; invoices + sales-summaries compile and render through the same sc/* fns. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
328 lines
16 KiB
Clojure
328 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.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-ctx
|
|
"Plain-data context for templates/components/money-input.html. The class base is owned
|
|
by the template; this passes the non-class attributes (name/value/...) and the variant
|
|
class (caller width + size). Split out so a template can include the partial directly."
|
|
[{:keys [size class] :as params}]
|
|
{:variant (str (or class "") (inputs/use-size size))
|
|
:attrs (attrs->str (dissoc params :class :size))})
|
|
|
|
(defn money-input [params]
|
|
(render "templates/components/money-input.html" (money-input-ctx params)))
|
|
|
|
(defn select-ctx
|
|
"Plain-data context for templates/components/select.html. options = [[value label] ...];
|
|
`value` (string or keyword) marks the selected option. Split out so a template can
|
|
{% include %} the partial via {% with %} without re-deriving classes/selection."
|
|
[{:keys [name value options class] :as params}]
|
|
(let [sel (cond-> value (keyword? value) clojure.core/name)
|
|
attrs (dissoc params :name :value :options :class)]
|
|
{:name name
|
|
:variant (or class "")
|
|
:attrs (attrs->str attrs)
|
|
:options (for [[v label] options]
|
|
{:value v :label label :selected (= (str v) (str sel))})}))
|
|
|
|
(defn select
|
|
"Generic <select> rendered from a Selmer partial (the location-select.html shape,
|
|
generalized). See select-ctx."
|
|
[params]
|
|
(render "templates/components/select.html" (select-ctx params)))
|
|
|
|
;; --- field wrapper ---------------------------------------------------------------
|
|
|
|
(defn validated-field-classes
|
|
"The wrapping-div class string for a validated field (group + optional has-error +
|
|
caller class). Split out so a template-driven row can stamp the same classes."
|
|
[{:keys [errors] :as params}]
|
|
(cond-> (or (:class params) "")
|
|
(sequential? errors) (hh/add-class "has-error")
|
|
:always (hh/add-class "group")))
|
|
|
|
(defn errors-str
|
|
"Comma-join the string errors at a field (nil/empty -> empty string), matching the
|
|
validated-field error <p>."
|
|
[errors]
|
|
(or (when (sequential? errors)
|
|
(str/join ", " (filter string? errors)))
|
|
""))
|
|
|
|
(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 class] :as params} & body]
|
|
(let [attrs (dissoc params :label :errors :error-source :error-key :class)]
|
|
(render "templates/components/validated-field.html"
|
|
{:label label
|
|
:has_error (sequential? errors)
|
|
:extra (or class "")
|
|
:attrs (attrs->str attrs)
|
|
:body (body->html body)
|
|
:errors_str (errors-str errors)})))
|
|
|
|
;; --- 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-ctx
|
|
"Plain-data context for templates/components/button.html. The class base + color ladder
|
|
are owned by the template; this passes the color (name), the caller's extra class, the
|
|
non-class attrs, loading_label and body. NB: Selmer button callers only pass static
|
|
colors (primary); dynamic colors go through the Hiccup com/button."
|
|
[{:keys [color minimal-loading?] :as params} & children]
|
|
{:color (some-> color name)
|
|
:extra (or (:class params) "")
|
|
:attrs (attrs->str (dissoc params :class))
|
|
:loading_label (not minimal-loading?)
|
|
:body (body->html children)})
|
|
|
|
(defn button [params & children]
|
|
(render "templates/components/button.html" (apply button-ctx params children)))
|
|
|
|
(defn a-button-ctx
|
|
"Plain-data context for templates/components/a-button.html. The class base + color
|
|
ladder (secondary/primary/red/default) are owned by the template; this passes the
|
|
color (name), the caller's extra class, the non-class attrs, indicator and body."
|
|
[{:keys [color] :as params} & children]
|
|
{:color (some-> color name)
|
|
:extra (or (:class params) "")
|
|
:attrs (attrs->str (-> (dissoc params :class)
|
|
(assoc :tabindex 0 :href (:href params "#"))))
|
|
:indicator (:indicator? params true)
|
|
:body (body->html children)})
|
|
|
|
(defn a-button [params & children]
|
|
(render "templates/components/a-button.html" (apply a-button-ctx params children)))
|
|
|
|
(defn a-icon-button-ctx
|
|
"Plain-data context for templates/components/a-icon-button.html. The fixed class base is
|
|
owned by the template; `extra` is the caller class plus the conditional p-3 padding."
|
|
[{:keys [class] :as params} & children]
|
|
(let [class-str (or class "")
|
|
has-padding? (re-find #"\bp[xy]?-\d+(\.\d+)?\b" class-str)]
|
|
{:extra (str class-str (if has-padding? "" " p-3"))
|
|
:attrs (attrs->str (-> (dissoc params :class)
|
|
(assoc :href (or (:href params) ""))))
|
|
:body (body->html children)}))
|
|
|
|
(defn a-icon-button [params & children]
|
|
(render "templates/components/a-icon-button.html" (apply a-icon-button-ctx params 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-ctx
|
|
"Build the plain-data context map for templates/components/typeahead.html. 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. Split out from
|
|
`typeahead` so a fully template-driven grid can feed the same partial per row (via
|
|
{% with %}) without re-deriving any of this logic. Every value is a string/boolean."
|
|
[{: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-xinit (str "$nextTick(() => tippy = $el.__x_tippy); " x-init)
|
|
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')); }); "))]
|
|
{:x_data x-data
|
|
:x_model x-model
|
|
:key (when id (str id "--" vval))
|
|
:disabled disabled
|
|
:width (or class "")
|
|
:a_xinit a-xinit
|
|
:placeholder placeholder
|
|
:hidden_attrs (attrs->str hidden-attrs)}))
|
|
|
|
(defn typeahead
|
|
"Selmer port of com/typeahead. Preserves every tippy?. null-guard. See typeahead-ctx."
|
|
[params]
|
|
(render "templates/components/typeahead.html" (typeahead-ctx params)))
|