(ns auto-ap.ssr.components.multi-modal (:require [auto-ap.cursor :as cursor] [auto-ap.ssr-routes :as ssr-routes] [auto-ap.ssr.components :as com] [auto-ap.ssr.components.timeline :as timeline] [auto-ap.ssr.form-cursor :as fc] [auto-ap.ssr.hx :as hx] [auto-ap.ssr.nested-form-params :refer [wrap-nested-form-params]] [auto-ap.ssr.svg :as svg] [auto-ap.ssr.utils :refer [assert-schema html-response main-transformer modal-response wrap-form-4xx-2 wrap-schema-enforce]] [bidi.bidi :as bidi] [hiccup.util :as hu] [malli.core :as mc] [malli.core :as m])) (def default-form-props {:hx-ext "response-targets" :hx-swap "outerHTML" :hx-target-400 "#form-errors .error-content" :hx-trigger "submit" :hx-target "this"}) (defprotocol ModalWizardStep (step-key [this]) (edit-path [this request]) (render-step [this request]) (step-schema [this]) (step-name [this])) (defprotocol Initializable (init-step-params [this multi-form-state request])) (defprotocol CustomNext (custom-next-handler [this request])) (defprotocol Discardable (can-discard? [this step-params]) (discard-changes [this request])) (defprotocol LinearModalWizard (hydrate-from-request [this request]) (get-current-step [this]) (navigate [this step-key]) (form-schema [this]) (steps [this]) (get-step [this step-key]) (render-wizard [this request]) (submit [this request])) (defrecord MultiStepFormState [snapshot edit-path step-params]) (defn select-state [multi-form-state edit-path default] (->MultiStepFormState (:snapshot multi-form-state) edit-path (or (get-in (:snapshot multi-form-state) edit-path) default))) (defn merge-multi-form-state [{:keys [snapshot edit-path step-params] :as multi-form-state}] (let [cursor (cursor/cursor (or snapshot {})) ;; this hack makes sure that, in the event of a missing vector entry, will make sure to add it first edit-cursor (cond-> cursor (seq edit-path) (cursor/ensure-path! edit-path {}) (seq edit-path) (get-in edit-path {})) _ (cursor/transact! edit-cursor (fn [spot] (merge spot step-params)))] (assoc multi-form-state :snapshot @cursor :edit-path [] :step-params @cursor))) (defn get-mfs-field [mfs k] (or (get (:step-params mfs) k) (get-in (:snapshot mfs) (conj (or (:edit-path mfs) []) k)))) (def step-key-schema (mc/schema [:orn {:decode/arbitrary clojure.edn/read-string :encode/arbitrary pr-str} [:sub-step [:cat :keyword [:or :int :string]]] [:step :keyword]])) (def encode-step-key (m/-instrument {:schema [:=> [:cat step-key-schema] :any]} (fn encode-step-key [sk] (mc/encode step-key-schema sk main-transformer)))) (defn render-timeline [linear-wizard current-step validation-route] (let [step-names (map #(step-name (get-step linear-wizard %)) (steps linear-wizard)) active-index (.indexOf step-names (step-name current-step))] (timeline/vertical-timeline {} (for [[n i] (map vector (steps linear-wizard) (range))] (timeline/vertical-timeline-step (cond-> {} (= i active-index) (assoc :active? true) (< i active-index) (assoc :visited? true) (= i (dec (count step-names))) (assoc :last? true)) [:a.cursor-pointer.whitespace-nowrap {:x-data (hx/json {:timelineIndex i}) :hx-put (hu/url (bidi/path-for ssr-routes/only-routes validation-route) {:from (encode-step-key (step-key current-step)) :to (encode-step-key (step-key (get-step linear-wizard n)))})} (step-name (get-step linear-wizard n))]))))) (defn back-button [linear-wizard step validation-route] [:a.cursor-pointer.whitespace-nowrap.font-medium.text-blue-600 {:hx-put (hu/url (bidi/path-for ssr-routes/only-routes validation-route) {:from (encode-step-key (step-key step)) :to (encode-step-key (->> (partition-all 2 1 (steps linear-wizard)) (filter (fn [[from to]] (= to (step-key step)))) ffirst))}) :class "dark:text-blue-500"} "Back"]) (defn default-next-button [linear-wizard step validation-route & {:keys [next-button-content]}] (let [steps (steps linear-wizard) last? (= (step-key step) (last steps)) next-step (when-not last? (->> steps (drop-while #(not= (step-key step) %)) (drop 1) first (get-step linear-wizard)))] (com/validated-save-button (cond-> {:errors (seq fc/*form-errors*) ;;:x-data (hx/json {}) :x-ref "next" :class "w-48"} (not last?) (assoc :hx-put (hu/url (bidi/path-for ssr-routes/only-routes validation-route) {:from (encode-step-key (step-key step)) :to (encode-step-key (step-key next-step))}))) (or next-button-content (if next-step (step-name next-step) "Save")) (when-not last? [:div.w-5.h-5 svg/arrow-right])))) (defn default-step-body [params & children] [:div.space-y-1 {} children]) (defn flatten-form-errors "Walks a malli-humanized error structure and returns a flat sequence of human-readable strings, prefixing each leaf message with the nearest field name for context. Lets the footer's error bar surface every validation error for the whole form, even ones whose field lives on a hidden step/tab and so would otherwise be invisible." ([errors] (flatten-form-errors nil errors)) ([field errors] (let [label (cond (keyword? field) (name field) (string? field) field :else nil) decorate (fn [msg] (if label (str label ": " msg) msg))] (cond (map? errors) (mapcat (fn [[k v]] (flatten-form-errors k v)) errors) (and (sequential? errors) (every? string? errors)) (map decorate errors) (sequential? errors) (mapcat #(flatten-form-errors field %) errors) (string? errors) [(decorate errors)] :else nil)))) (defn default-step-footer [linear-wizard step & {:keys [validation-route discard-button next-button next-button-content]}] [:div.flex.justify-end [:div.flex.items-baseline.gap-x-4 (let [step-errors (:step-params fc/*form-errors*)] (com/form-errors {:errors (or (:errors step-errors) (when (sequential? step-errors) step-errors) (seq (distinct (flatten-form-errors step-errors))))})) (when (not= (first (steps linear-wizard)) (step-key step)) (when validation-route (back-button linear-wizard step validation-route))) (when (and (satisfies? Discardable step) (can-discard? step @fc/*current*)) discard-button) (cond next-button next-button validation-route (default-next-button linear-wizard step validation-route :next-button-content next-button-content) :else [:div "No action possible."])]]) (defn default-render-step [linear-wizard step & {:keys [head body footer validation-route discard-route width-height-class side-panel]}] (let [is-last? (= (step-key step) (last (steps linear-wizard)))] (com/modal-card-advanced {"@keydown.enter.prevent.stop" "if ($refs.next ) {$refs.next.click()}" :class (str (or width-height-class " md:w-[750px] md:h-[600px] ") " w-full h-full group-[.forward]/transition:htmx-swapping:opacity-0 group-[.forward]/transition:htmx-swapping:-translate-x-1/4 group-[.forward]/transition:htmx-swapping:scale-75 group-[.forward]/transition:htmx-swapping:ease-in group-[.forward]/transition:htmx-added:opacity-0 group-[.forward]/transition:htmx-added:scale-75 group-[.forward]/transition:htmx-added:translate-x-1/4 group-[.forward]/transition:htmx-added:ease-out group-[.backward]/transition:htmx-swapping:opacity-0 group-[.backward]/transition:htmx-swapping:translate-x-1/4 group-[.backward]/transition:htmx-swapping:scale-75 group-[.backward]/transition:htmx-swapping:ease-in group-[.backward]/transition:htmx-added:opacity-0 group-[.backward]/transition:htmx-added:scale-75 group-[.backward]/transition:htmx-added:-translate-x-1/4 group-[.backward]/transition:htmx-added:ease-out opacity-100 translate-x-0 scale-100" (when is-last? "last-modal-step") " transition duration-150 ") #_#_":class" (hiccup/raw "{ \"htmx-added:opacity-0 opacity-100\": $data.transitionType=='forward', \"htmx-swapping:translate-x-2/3 htmx-swapping:opacity-0 htmx-swapping:scale-0 htmx-added:-translate-x-2/3 htmx-added:opacity-0 htmx-added:scale-0 scale-100 translate-x-0 opacity-100\": $data.transitionType=='backward' } ") "x-data" ""} (com/modal-header {} head) #_(com/modal-header-attachment {}) [:div.flex.shrink.overflow-auto.grow (when side-panel [:div.grow-0.w-64.bg-gray-50.border-r.hidden.md:block.overflow-y-auto {:class "max-h-full"} side-panel]) (when (:render-timeline? linear-wizard) [:div.grow-0.pr-6.pt-2.bg-gray-100.self-stretch.hidden.md:block #_{:style "margin-left:-20px"} (render-timeline linear-wizard step validation-route)]) (com/modal-body {} body)] (com/modal-footer {} footer)))) (defn wrap-ensure-step [handler] (-> (fn [{:keys [wizard multi-form-state] :as request}] (assert-schema (step-schema (get-current-step wizard)) (:step-params multi-form-state)) (handler request)) (wrap-form-4xx-2 (fn [{:keys [wizard] :as request}] ;; THIS MAY BE BETTER TO JUST MAKE THE LINEAR WIZARD POPULATE FROM THE REQUEST (html-response (render-wizard wizard request) :headers {"x-transition-type" "none" "HX-reswap" "outerHTML"}))))) (defn get-transition-type [wizard from-step-key to-step-key] (let [to-step-index (.indexOf (steps wizard) to-step-key) from-step-index (.indexOf (steps wizard) from-step-key)] (cond (= -1 to-step-index) nil (= -1 from-step-index) nil (= from-step-index to-step-index) nil (> from-step-index to-step-index) "backward" :else "forward"))) (defn navigate-handler [{{:keys [wizard] :as request} :request to-step :to-step oob :oob}] (let [current-step (get-current-step wizard) wizard (navigate wizard to-step) new-step (get-current-step wizard) transition-type (get-transition-type wizard (step-key current-step) to-step)] (html-response (render-wizard wizard (-> request (assoc :multi-form-state (-> (:multi-form-state request) (merge-multi-form-state) (select-state (edit-path new-step request) {}) (#(cond-> % (satisfies? Initializable new-step) (assoc :step-params (init-step-params new-step % request)))))))) :headers {"HX-reswap" (when transition-type "outerHTML swap:0.16s") "x-transition-type" (or transition-type "none")} :oob (or oob [])))) (def next-handler (-> (fn [{:keys [wizard] :as request}] (let [current-step (get-current-step wizard)] (if (satisfies? CustomNext current-step) (custom-next-handler current-step request) (navigate-handler {:request request :to-step (:to (:query-params request))})))) (wrap-ensure-step) (wrap-schema-enforce :query-schema [:map [:to {:optional true} [:maybe step-key-schema]]]))) (def discard-handler (-> (fn [{:keys [wizard multi-form-state] :as request}] (let [current-step (get-current-step wizard) to-step (:to (:query-params request)) wizard (navigate wizard to-step) transition-type (get-transition-type wizard (step-key current-step) to-step)] (html-response (render-wizard wizard (-> request (assoc :multi-form-state (discard-changes current-step multi-form-state)))) :headers {"HX-reswap" (when transition-type "outerHTML swap:0.16s") "x-transition-type" (or transition-type "none")}))) (wrap-schema-enforce :query-schema [:map [:to step-key-schema]]))) (def submit-handler (-> (fn [{:keys [wizard multi-form-state] :as request}] (submit wizard (-> request (assoc :multi-form-state (merge-multi-form-state multi-form-state))))) (wrap-ensure-step))) (defn default-render-wizard [linear-wizard {:keys [multi-form-state form-errors snapshot current-step] :as request} & {:keys [form-params render-timeline?] :or {render-timeline? true}}] (let [current-step (get-current-step (assoc linear-wizard :render-timeline? render-timeline?)) edit-path (edit-path current-step request)] [:form#wizard-form form-params (fc/start-form multi-form-state (when form-errors {:step-params form-errors}) (list (fc/with-field :snapshot (com/hidden {:name (fc/field-name) :value (pr-str (fc/field-value))})) (fc/with-field :edit-path (com/hidden {:name (fc/field-name) :value (pr-str (or edit-path []))})) (com/hidden {:name "current-step" :value (pr-str (step-key current-step))}) (fc/with-field :step-params (com/modal {:id "wizardmodal"} (render-step current-step request)))))])) (defn wrap-wizard [handler linear-wizard] (fn [request] (let [current-step-key (if-let [current-step (get (:form-params request) "current-step")] (mc/decode step-key-schema current-step main-transformer) (first (steps linear-wizard))) current-step (get-step linear-wizard current-step-key) multi-form-state (-> (:multi-form-state request) (update :snapshot (fn [snapshot] (mc/decode (form-schema linear-wizard) snapshot main-transformer))) (update :step-params (fn [step-params] (or (mc/decode (step-schema current-step) step-params main-transformer) {} ;; Todo add a defaultable )))) request (-> request (assoc :multi-form-state multi-form-state)) linear-wizard (navigate linear-wizard current-step-key)] (handler (assoc request :wizard (hydrate-from-request linear-wizard request)))))) (defn open-wizard-handler [{:keys [wizard current-step query-params] :as request}] (cond-> (modal-response [:div#transitioner.flex-1 {:x-data (hx/json {"transitionType" "none"}) :x-ref "transitioner" :class "" "@htmx:after-request" "if(event.detail.xhr.getResponseHeader('x-transition-type')) { $refs.transitioner.classList.remove('forward') $refs.transitioner.classList.remove('backward'); $refs.transitioner.classList.add('group/transition') $refs.transitioner.classList.add(event.detail.xhr.getResponseHeader('x-transition-type')); } else { $refs.transitioner.classList.remove('group/transition') } "} (render-wizard wizard request)]) (get query-params :replace-modal) (assoc-in [:headers "hx-trigger"] "modalswap"))) (defn wrap-init-multi-form-state [handler get-multi-form-state] (-> (fn init-multi-form [request] (handler (assoc request :multi-form-state (get-multi-form-state request)))) (wrap-nested-form-params))) (defn wrap-decode-multi-form-state [handler] (wrap-init-multi-form-state handler (fn parse-multi-form-state [request] (map->MultiStepFormState (mc/decode [:map [:snapshot {:optional true :decode/arbitrary #(clojure.edn/read-string {:readers clj-time.coerce/data-readers :eof nil} %)} [:maybe :any]] [:edit-path {:optional true :decode/arbitrary (fn [z] (clojure.edn/read-string z))} [:maybe [:sequential {:min 0} any?]]] [:step-params {:optional true} [:maybe :any]]] (:form-params request) main-transformer))))) #_(comment (def f {"snapshot" "{:invoices [{:invoice_id 17592297837035, :amount 23.0, :invoice {:db/id 17592297837035, :invoice/vendor {:db/id 17592186045722, :vendor/name \"Sysco\"}, :invoice/client {:db/id 17592232555238}, :invoice/outstanding-balance 23.0, :invoice/invoice-number \"702,34\"}} {:invoice_id 17592297837049, :amount 23.0, :invoice {:db/id 17592297837049, :invoice/vendor {:db/id 17592186045722, :vendor/name \"Sysco\"}, :invoice/client {:db/id 17592232555238}, :invoice/outstanding-balance 23.0, :invoice/invoice-number \"80[234234\"}}], :client 17592232555238}", "edit-path" "[]", "current-step" ":payment-details", "mode" "advanced", "step-params" {"invoices" {"0" {"invoice_id" "17592297837035", "amount" "1"}, "1" {"invoice_id" "17592297837049", "amount" "23.00"}}}}) (mc/decode [:map [:step-params {:optional true} [:maybe :any]]] f main-transformer))