289 lines
15 KiB
Clojure
289 lines
15 KiB
Clojure
(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))))
|