(ns auto-ap.forms.builder (:require [re-frame.core :as re-frame] [react :as react] [reagent.core :as r] [auto-ap.forms :as forms] [auto-ap.status :as status] [malli.core :as m] [malli.error :as me])) (defonce ^js/React.Context form-context (react/createContext "default")) (def ^js/React.Provider Provider (. form-context -Provider)) (def ^js/React.Consumer Consumer (. form-context -Consumer)) (defonce ^js/React.Context form-scope-context (react/createContext [])) (def ^js/React.Provider FormScopeProvider (. form-scope-context -Provider)) (def ^js/React.Consumer FormScopeConsumer (. form-scope-context -Consumer)) (defn valid-field? [problems field-path] (not (get-in (me/humanize problems) field-path))) (defn spec-error-message [problems field-path error-messages] (-> (me/humanize problems {:errors (merge (-> me/default-errors (assoc ::m/missing-key {:error/message "Required"} ::m/invalid-type {:error/fn (fn [a _] (if (nil? (:value a)) "Required" "Invalid"))})) error-messages)}) (get-in field-path) first)) (defn consume [consumer-component fields f] [:> consumer-component {} (fn [consumed] (r/as-element (apply f (for [field fields] (aget consumed field)))))]) (re-frame/reg-event-fx ::blurred (fn [_ [_ schema id field]] {:dispatch-n [[::forms/check-problems id schema] [::forms/visited id field]]})) (defn builder [{:keys [value on-change can-submit data-sub error-messages change-event submit-event id fullwidth? schema validation-error-string]}] (when (and change-event on-change) (throw (js/Error. "Either the form is to be managed by ::forms, or it should have value and on-change passed in"))) (let [data-sub (or data-sub [::forms/form id]) change-event (when-not on-change (or change-event [::forms/change id])) {:keys [data visited attempted-submit? problems error] form-key :id} @(re-frame/subscribe data-sub) data (or value data) status @(re-frame/subscribe [::status/single id]) can-submit (if can-submit @(re-frame/subscribe can-submit) true)] (r/create-element Provider #js {:value #js {:can-submit can-submit :error-messages (or error-messages nil) :on-change on-change :change-event change-event :blur-event [::blurred schema id] :visited visited :submit-event submit-event :problems problems :attempted-submit? attempted-submit? :error (or error (-> status :error first :message)) :status status :id id :data data :fullwidth? fullwidth?}} (r/as-element ^{:key form-key} [:form {:on-submit (fn [e] (when (.-stopPropagation e) (.stopPropagation e) (.preventDefault e)) (if (and schema (not (m/validate schema data))) (do (re-frame/dispatch-sync [::status/dispose-single id]) (re-frame/dispatch [::status/error id [{:message (or validation-error-string "Please fix the errors and try again.")}]]) (re-frame/dispatch [::forms/attempted-submit id])) (when can-submit (re-frame/dispatch-sync (vec (conj submit-event {}))))))} (into [:fieldset {:disabled (boolean (= :loading (:state status)))}] (r/children (r/current-component)))] )))) ;; TODO make virtual builder operate as a cursor and an input instead of a whole new thing ;; make it inherit the outer form, avoiding creating new forms (defn virtual-builder [] (let [starting-key (random-uuid) key (r/atom starting-key)] (re-frame/dispatch [::forms/start-form starting-key []]) (fn [{:keys [value on-change can-submit error-messages fullwidth? schema attempted-submit?]}] (let [data-sub [::forms/form @key] {:keys [data error problems visited]} @(re-frame/subscribe data-sub) data (or value data)] (r/create-element Provider #js {:value #js {:can-submit can-submit :error-messages (or error-messages nil) ;; wrap to make sure raw form updates too :on-change (fn [v o] (re-frame/dispatch-sync [::forms/reset @key v]) (on-change v o)) :blur-event [::blurred schema @key ] :problems problems :attempted-submit? attempted-submit? :visited visited :error error :id @key :data data :fullwidth? fullwidth?}} (r/as-element ^{:key @key} (into [:<>] (r/children (r/current-component))))))))) (defn change-handler [path re-frame-change-event event-or-value] (re-frame/dispatch (-> re-frame-change-event (conj path) (conj (if-let [target (some-> event-or-value (aget "target"))] (aget target "value") event-or-value))))) (defn form-change-handler [data path on-change event-or-value] (on-change (assoc-in data path (if-let [target (some-> event-or-value (aget "target"))] (aget target "value") event-or-value)) data)) (defn blur-handler [path re-frame-blur-event original-on-blur e] (when original-on-blur (original-on-blur e)) (re-frame/dispatch (-> re-frame-blur-event (conj path)))) (defn raw-error-v2 [{:keys [field]}] (consume Consumer ["visited" "attempted-submit?" "problems" "error-messages"] (fn [visited attempted-submit? problems error-messages] (consume FormScopeConsumer ["scope"] (fn [scope] (let [scope (or scope []) full-field-path (cond (sequential? field) (into scope field) field (conj scope field) :else nil) visited? (get visited full-field-path)] (when-let [error-message (and (or visited? attempted-submit?) (spec-error-message problems full-field-path error-messages))] [:div [:p.help.has-text-danger error-message]]))))))) (defn raw-field-v2 [{:keys [field] :as props}] (when-not field (throw (ex-info (str "Missing field") (clj->js {:props props})))) (let [[child] (r/children (r/current-component))] (consume Consumer ["visited" "attempted-submit?" "data" "on-change" "change-event" "blur-event" "problems"] (fn [visited attempted-submit? data on-change change-event blur-event problems] (consume FormScopeConsumer ["scope"] (fn [scope] (update child 1 (fn [child-props] (let [scope (or scope []) full-field-path (cond (sequential? field) (into scope field) field (conj scope field) :else nil) visited? (get visited full-field-path) value (get-in data full-field-path)] (-> child-props (assoc :on-change (if on-change (partial form-change-handler data full-field-path on-change) (partial change-handler full-field-path change-event)) :on-blur (partial blur-handler full-field-path blur-event (:on-blur child-props)) :value value) (update :class (fn [class] (str class (cond (and (not visited?) (not attempted-submit?)) "" (not (valid-field? problems full-field-path)) " is-danger" value " is-success" :else "")))))))))))))) (defn with-scope [{:keys [scope]}] (r/create-element FormScopeProvider #js {:value #js {:scope scope}} (r/as-element (into [:<>] (r/children (r/current-component)))))) (defn vertical-control [{:keys [required?]}] (let [[label & children] (r/children (r/current-component))] (consume Consumer ["fullwidth?"] (fn [fullwidth?] [:div.field (if fullwidth? [:p.help label] [:label.label (if required? [:span label [:span.has-text-danger " *"]] label)]) (into [:div.control ] children)])))) (defn field-v2 [] (let [props (r/props (r/current-component)) [label child] (r/children (r/current-component))] (consume Consumer ["fullwidth?"] (fn [fullwidth?] [:div.field (when label (if fullwidth? [:p.help label] [:label.label (if (:required? props) [:span label [:span.has-text-danger " *"]] label)])) [:div.control [raw-field-v2 props child]] [:div [raw-error-v2 {:field (:field props)}]]])))) (defn section [{:keys [title]}] [:<> [:h4.is-4.title title] [:hr] (into [:div {:style {:margin-bottom "5em"}}] (r/children (r/current-component)))]) (defn submit-button [{:keys [class]}] (let [[child] (r/children (r/current-component))] (consume Consumer ["status" "can-submit" "fullwidth?"] (fn [status can-submit fullwidth?] [:button.button.is-primary {:disabled (or (status/disabled-for status) (not can-submit)) :class (cond-> (or class []) (status/class-for status) (into (status/class-for status)) fullwidth? (conj "is-fullwidth") (not= "is-small" class) (conj "is-medium")) } child])))) (defn hidden-submit-button [] (consume Consumer ["status" "can-submit"] (fn [status can-submit] [:div {:style {:display "none"}} [:button.button.is-medium.is-primary {:disabled (or (status/disabled-for status) (not can-submit))}]]))) (defn error-notification [] (consume Consumer ["error" "status"] (fn [error status] (println status) (cond error ^{:key error} [:div.has-text-danger.animated.fadeInUp {} error] (-> status :error first :message) [:div.has-text-danger.animated.fadeInUp {} (-> status :error first :message)] (-> status :error) [:div.has-text-danger.animated.fadeInUp {} (-> status :error str)] :else nil))))