;; This Source Code Form is subject to the terms of the Mozilla Public ;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; ;; Copyright (c) KALEIDOS INC (ns app.main.ui.components.forms (:require-macros [app.main.style :as stl]) (:require [app.common.data :as d] [app.common.data.macros :as dm] [app.main.ui.components.select :as cs] [app.main.ui.hooks :as hooks] [app.main.ui.icons :as i] [app.util.dom :as dom] [app.util.forms :as fm] [app.util.i18n :as i18n :refer [tr]] [app.util.keyboard :as kbd] [app.util.object :as obj] [cljs.core :as c] [clojure.string] [cuerdas.core :as str] [rumext.v2 :as mf])) (def form-ctx (mf/create-context nil)) (def use-form fm/use-form) (mf/defc input [{:keys [label help-icon disabled form hint trim children data-testid on-change-value placeholder show-success?] :as props}] (let [input-type (get props :type "text") input-name (get props :name) more-classes (get props :class) auto-focus? (get props :auto-focus? false) form (or form (mf/use-ctx form-ctx)) type' (mf/use-state input-type) focus? (mf/use-state false) is-checkbox? (= @type' "checkbox") is-radio? (= @type' "radio") is-text? (or (= @type' "password") (= @type' "text") (= @type' "email")) placeholder (when is-text? (or placeholder label)) touched? (get-in @form [:touched input-name]) error (get-in @form [:errors input-name]) value (get-in @form [:data input-name] "") help-icon' (cond (and (= input-type "password") (= @type' "password")) i/shown (and (= input-type "password") (= @type' "text")) i/hide :else help-icon) on-change-value (or on-change-value (constantly nil)) swap-text-password (fn [] (swap! type' (fn [input-type] (if (= "password" input-type) "text" "password")))) on-focus #(reset! focus? true) on-change (fn [event] (let [value (-> event dom/get-target dom/get-input-value)] (swap! form assoc-in [:touched input-name] true) (fm/on-input-change form input-name value trim) (on-change-value name value))) on-blur (fn [_] (reset! focus? false)) on-click (fn [_] (when-not (get-in @form [:touched input-name]) (swap! form assoc-in [:touched input-name] true))) props (-> props (dissoc :help-icon :form :trim :children :show-success? :auto-focus? :label) (assoc :id (name input-name) :value value :auto-focus auto-focus? :on-click (when (or is-radio? is-checkbox?) on-click) :on-focus on-focus :on-blur on-blur :placeholder placeholder :on-change on-change :type @type' :tab-index "0") (cond-> (and value is-checkbox?) (assoc :default-checked value)) (cond-> (and touched? (:message error)) (assoc "aria-invalid" "true" "aria-describedby" (dm/str "error-" input-name))) (obj/map->obj obj/prop-key-fn)) checked? (and is-checkbox? (= value true)) show-valid? (and show-success? touched? (not error)) show-invalid? (and touched? error)] [:div {:class (dm/str more-classes " " (stl/css-case :input-wrapper true :valid show-valid? :invalid show-invalid? :checkbox is-checkbox? :disabled disabled))} [:* (cond (some? label) [:label {:class (stl/css-case :input-with-label-form (not is-checkbox?) :input-label is-text? :radio-label is-radio? :checkbox-label is-checkbox?) :tab-index "-1" :for (name input-name)} label (when is-checkbox? [:span {:class (stl/css-case :global/checked checked?)} (when checked? i/status-tick)]) (if is-checkbox? [:> :input props] [:div {:class (stl/css :input-and-icon)} [:> :input props] (when help-icon' [:span {:class (stl/css :help-icon) :on-click (when (= "password" input-type) swap-text-password)} help-icon']) (when show-valid? [:span {:class (stl/css :valid-icon)} i/tick]) (when show-invalid? [:span {:class (stl/css :invalid-icon)} i/close])])] (some? children) [:label {:for (name input-name)} [:> :input props] children]) (cond (and touched? (:message error)) [:div {:id (dm/str "error-" input-name) :class (stl/css :error) :data-testid (clojure.string/join [data-testid "-error"])} (tr (:message error))] (string? hint) [:div {:class (stl/css :hint)} hint])]])) (mf/defc textarea [{:keys [label disabled form hint trim] :as props}] (let [input-name (get props :name) form (or form (mf/use-ctx form-ctx)) focus? (mf/use-state false) touched? (get-in @form [:touched input-name]) error (get-in @form [:errors input-name]) value (get-in @form [:data input-name] "") klass (dom/classnames :focus @focus? :valid (and touched? (not error)) :invalid (and touched? error) :disabled disabled) ;; :empty (str/empty? value) on-focus #(reset! focus? true) on-change (fn [event] (let [target (dom/get-target event) value (dom/get-value target)] (fm/on-input-change form input-name value trim))) on-blur (fn [_] (reset! focus? false) (when-not (get-in @form [:touched input-name]) (swap! form assoc-in [:touched input-name] true))) props (-> props (dissoc :help-icon :form :trim) (assoc :value value :on-focus on-focus :on-blur on-blur ;; :placeholder label :on-change on-change) (obj/map->obj obj/prop-key-fn))] [:div {:class (dm/str klass " " (stl/css :textarea-wrapper))} [:label {:class (stl/css :textarea-label)} label] [:> :textarea props] (cond (and touched? (:message error)) [:span {:class (stl/css :error)} (tr (:message error))] (string? hint) [:span {:class (stl/css :hint)} hint])])) (mf/defc select [{:keys [options disabled form default dropdown-class select-class] :as props :or {default ""}}] (let [input-name (get props :name) form (or form (mf/use-ctx form-ctx)) value (or (get-in @form [:data input-name]) default) handle-change (fn [event] (let [value (if (string? event) event (dom/get-target-val event))] (fm/on-input-change form input-name value)))] [:div {:class (stl/css :select-wrapper)} [:& cs/select {:default-value value :disabled disabled :options options :class select-class :dropdown-class dropdown-class :on-change handle-change}]])) (mf/defc radio-buttons {::mf/wrap-props false} [props] (let [form (or (unchecked-get props "form") (mf/use-ctx form-ctx)) name (unchecked-get props "name") image (unchecked-get props "image") current-value (or (dm/get-in @form [:data name] "") (unchecked-get props "value")) on-change (unchecked-get props "on-change") options (unchecked-get props "options") trim? (unchecked-get props "trim") class (unchecked-get props "class") encode-fn (d/nilv (unchecked-get props "encode-fn") identity) decode-fn (d/nilv (unchecked-get props "decode-fn") identity) on-change' (mf/use-fn (mf/deps on-change form name) (fn [event] (let [value (-> event dom/get-target dom/get-value decode-fn)] (when (some? form) (swap! form assoc-in [:touched name] true) (fm/on-input-change form name value trim?)) (when (fn? on-change) (on-change name value)))))] [:div {:class (if image class (dm/str class " " (stl/css :custom-radio)))} (for [{:keys [image icon value label area]} options] (let [image? (some? image) icon? (some? icon) value' (encode-fn value) checked? (= value current-value) key (str/ffmt "%-%" (d/name name) (d/name value'))] [:label {:for key :key key :style {:grid-area area} :class (stl/css-case :radio-label true :global/checked checked? :with-image (or image? icon?))} (cond image? [:span {:style {:background-image (str/ffmt "url(%)" image)} :class (stl/css :image-inside)}] icon? [:span {:class (stl/css :icon-inside)} icon] :else [:span {:class (stl/css-case :radio-icon true :global/checked checked?)} (when checked? [:span {:class (stl/css :radio-dot)}])]) label [:input {:on-change on-change' :type "radio" :class (stl/css :radio-input) :id key :name name :value value' :checked checked?}]]))])) (mf/defc image-radio-buttons {::mf/wrap-props false} [props] (let [form (or (unchecked-get props "form") (mf/use-ctx form-ctx)) name (unchecked-get props "name") image (unchecked-get props "image") img-height (unchecked-get props "img-height") img-width (unchecked-get props "img-width") current-value (or (dm/get-in @form [:data name] "") (unchecked-get props "value")) on-change (unchecked-get props "on-change") options (unchecked-get props "options") trim? (unchecked-get props "trim") class (unchecked-get props "class") encode-fn (d/nilv (unchecked-get props "encode-fn") identity) decode-fn (d/nilv (unchecked-get props "decode-fn") identity) on-change' (mf/use-fn (mf/deps on-change form name) (fn [event] (let [value (-> event dom/get-target dom/get-value decode-fn)] (when (some? form) (swap! form assoc-in [:touched name] true) (fm/on-input-change form name value trim?)) (when (fn? on-change) (on-change name value)))))] [:div {:class (if image class (dm/str class " " (stl/css :custom-radio)))} (for [{:keys [image icon value label area]} options] (let [icon? (some? icon) value' (encode-fn value) checked? (= value current-value) key (str/ffmt "%-%" (d/name name) (d/name value'))] [:label {:for key :key key :style {:grid-area area} :class (stl/css-case :radio-label-image true :global/checked checked?)} (cond icon? [:span {:class (stl/css :icon-inside) :style {:height img-height :width img-width}} icon] :else [:span {:style {:background-image (str/ffmt "url(%)" image) :height img-height :width img-width} :class (stl/css :image-inside)}]) [:span {:class (stl/css :image-text)} label] [:input {:on-change on-change' :type "radio" :class (stl/css :radio-input) :id key :name name :value value' :checked checked?}]]))])) (mf/defc submit-button* {::mf/wrap-props false} [{:keys [on-click children label form class name disabled] :as props}] (let [form (or form (mf/use-ctx form-ctx)) disabled? (or (and (some? form) (not (:valid @form))) (true? disabled)) class (d/nilv class (stl/css :button-submit)) name (d/nilv name "submit") on-key-down (mf/use-fn (mf/deps on-click) (fn [event] (when (and (kbd/enter? event) (fn? on-click)) (on-click event)))) props (mf/spread-props props {:children mf/undefined :disabled disabled? :on-key-down on-key-down :name name :labek mf/undefined :class class :type "submit"})] [:> "button" props (if (some? children) children [:span label])])) (mf/defc form {::mf/wrap-props false} [{:keys [on-submit form children class]}] (let [on-submit' (mf/use-fn (mf/deps on-submit) (fn [event] (dom/prevent-default event) (when (fn? on-submit) (on-submit form event))))] [:& (mf/provider form-ctx) {:value form} [:form {:class class :on-submit on-submit'} children]])) (defn- conj-dedup "A helper that adds item into a vector and removes possible duplicates. This is not very efficient implementation but is ok for handling form input that will have a small number of items." [coll item] (into [] (distinct) (conj coll item))) (mf/defc multi-input [{:keys [form label class name trim valid-item-fn caution-item-fn on-submit] :as props}] (let [form (or form (mf/use-ctx form-ctx)) input-name (get props :name) touched? (get-in @form [:touched input-name]) error (get-in @form [:errors input-name]) focus? (mf/use-state false) items (mf/use-state []) value (mf/use-state "") result (hooks/use-equal-memo @items) empty? (and (str/empty? @value) (zero? (count @items))) klass (str (get props :class) " " (stl/css-case :focus @focus? :valid (and touched? (not error)) :invalid (and touched? error) :empty empty? :custom-multi-input true)) in-klass (str class " " (stl/css-case :inside-input true :no-padding (pos? (count @items)) :invalid (and (some? valid-item-fn) touched? (not (str/empty? @value)) (not (valid-item-fn @value))))) on-focus (mf/use-fn #(reset! focus? true)) on-change (mf/use-fn (fn [event] (let [content (-> event dom/get-target dom/get-input-value)] (reset! value content)))) update-form! (mf/use-fn (mf/deps form) (fn [items] (let [value (str/join " " (map :text items))] (fm/update-input-value! form input-name value)))) on-key-down (mf/use-fn (mf/deps @value) (fn [event] (let [val (cond-> @value trim str/trim)] (cond (or (kbd/enter? event) (kbd/comma? event) (kbd/space? event)) (do (dom/prevent-default event) (dom/stop-propagation event) ;; Once enter/comma is pressed we mark it as touched (swap! form assoc-in [:touched input-name] true) ;; Empty values means "submit" the form (whent some items have been added (when (and (kbd/enter? event) (str/empty? @value) (not-empty @items)) (on-submit form)) ;; If we have a string in the input we add it only if valid (when (and (valid-item-fn val) (not (str/empty? @value))) (reset! value "") ;; Once added the form is back as "untouched" (swap! form assoc-in [:touched input-name] false) ;; This split will allow users to copy comma/space separated values of emails (doseq [val (str/split val #",|\s+")] (swap! items conj-dedup {:text (str/trim val) :valid (valid-item-fn val) :caution (caution-item-fn val)})))) (and (kbd/backspace? event) (str/empty? @value)) (do (dom/prevent-default event) (dom/stop-propagation event) (swap! items (fn [items] (if (c/empty? items) items (pop items))))))))) on-blur (mf/use-fn (fn [_] (reset! focus? false) (when-not (get-in @form [:touched input-name]) (swap! form assoc-in [:touched input-name] true)))) remove-item! (mf/use-fn (fn [item] (swap! items #(into [] (remove (fn [x] (= x item))) %)))) manage-key-down (mf/use-fn (fn [item event] (when (kbd/enter? event) (remove-item! item))))] (mf/with-effect [result @value] (let [val (cond-> @value trim str/trim) values (conj-dedup result {:text val :valid (valid-item-fn val)}) values (filterv #(:valid %) values)] (update-form! values))) [:div {:class klass} [:input {:id (name input-name) :class in-klass :type "text" :auto-focus true :on-focus on-focus :on-blur on-blur :on-key-down on-key-down :value @value :on-change on-change :placeholder (when empty? label)}] [:label {:for (name input-name)} label] (when-let [items (seq @items)] [:div {:class (stl/css :selected-items)} (for [item items] [:div {:class (stl/css :selected-item) :key (:text item) :tab-index "0" :on-key-down (partial manage-key-down item)} [:span {:class (stl/css-case :around true :invalid (not (:valid item)) :caution (:caution item))} [:span {:class (stl/css :text)} (:text item)] [:button {:class (stl/css :icon) :on-click #(remove-item! item)} i/close]]])])])) ;; --- Validators (defn all-spaces? [value] (let [trimmed (str/trim value)] (str/empty? trimmed))) (def max-length-allowed 250) (def max-uri-length-allowed 2048) (defn max-length? [value length] (> (count value) length)) (defn validate-length [field length errors-msg] (fn [errors data] (cond-> errors (max-length? (get data field) length) (assoc field {:message errors-msg})))) (defn validate-not-empty [field error-msg] (fn [errors data] (cond-> errors (all-spaces? (get data field)) (assoc field {:message error-msg})))) (defn validate-not-all-spaces [field error-msg] (fn [errors data] (let [value (get data field)] (cond-> errors (and (all-spaces? value) (> (count value) 0)) (assoc field {:message error-msg})))))