penpot/frontend/src/app/util/forms.cljs

;; 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 SUBSIDIARY SL

(ns app.util.forms
  (:refer-clojure :exclude [uuid])
  (:require
   [app.common.data :as d]
   [app.common.data.macros :as dm]
   [app.common.schema :as sm]
   [app.common.schema.messages :as csm]
   [cuerdas.core :as str]
   [rumext.v2 :as mf]))

(defn- use-rerender-fn
  []
  (let [state     (mf/useState 0)
        render-fn (aget state 1)]
    (mf/use-fn
     (mf/deps render-fn)
     (fn []
       (render-fn inc)))))

(defn- wrap-update-schema-fn
  [f {:keys [schema validators]}]
  (fn [& args]
    (let [state   (apply f args)
          cleaned (sm/decode schema (:data state) sm/json-transformer)
          valid?  (sm/validate schema cleaned)

          errors
          (when-not valid?
            (csm/collect-schema-errors schema validators state))

          extra-errors
          (not-empty (:extra-errors state))]

      (assoc state
             :errors errors
             :clean-data (when valid? cleaned)
             :valid (and (not errors)
                         (not extra-errors)
                         valid?)))))

(defn- make-initial-state
  [initial-data initial-errors]
  (let [initial (if (fn? initial-data) (initial-data) initial-data)
        initial (d/nilv initial {})
        initial-errors (if (fn? initial-errors) (initial-errors) initial-errors)
        initial-errors (d/nilv initial-errors {})]
    {:initial initial
     :initial-errors initial-errors
     :data initial
     :extra-errors initial-errors
     :errors {}
     :touched {}}))

(defn- create-form-mutator
  [internal-state rerender-fn wrap-update-fn opts]
  (reify
    IDeref
    (-deref [_]
      (mf/ref-val internal-state))

    IReset
    (-reset! [_ new-value]
      (if (nil? new-value)
        (let [initial (-> (mf/ref-val internal-state)
                          (get :initial))
              initial-errors (-> (mf/ref-val internal-state)
                                 (get :initial-errors))
              state (make-initial-state initial initial-errors)]
          (mf/set-ref-val! internal-state state))
        (mf/set-ref-val! internal-state new-value))
      (rerender-fn))

    ISwap
    (-swap! [_ f]
      (let [f (wrap-update-fn f opts)]
        (mf/set-ref-val! internal-state (f (mf/ref-val internal-state)))
        (rerender-fn)))

    (-swap! [_ f x]
      (let [f (wrap-update-fn f opts)]
        (mf/set-ref-val! internal-state (f (mf/ref-val internal-state) x))
        (rerender-fn)))

    (-swap! [_ f x y]
      (let [f (wrap-update-fn f opts)]
        (mf/set-ref-val! internal-state (f (mf/ref-val internal-state) x y))
        (rerender-fn)))

    (-swap! [_ f x y more]
      (let [f (wrap-update-fn f opts)]
        (mf/set-ref-val! internal-state (apply f (mf/ref-val internal-state) x y more))
        (rerender-fn)))))

(defn use-form
  [& {:keys [initial initial-errors schema validators] :as opts}]
  (let [rerender-fn (use-rerender-fn)

        initial
        (mf/with-memo [initial initial-errors]
          (make-initial-state initial initial-errors))

        internal-state
        (mf/use-ref initial)

        form-mutator
        (mf/with-memo [schema validators]
          (let [mutator (create-form-mutator internal-state rerender-fn wrap-update-schema-fn
                                             (select-keys opts [:schema :validators]))]
            (swap! mutator identity)
            mutator))]

    ;; Initialize internal state once
    (mf/with-effect []
      (mf/set-ref-val! internal-state initial))

    (mf/with-effect [initial]
      (swap! form-mutator d/deep-merge initial))

    form-mutator))

(defn on-input-change
  ([form field value]
   (on-input-change form field value false))
  ([form field value trim?]
   (letfn [(clean-errors [errors]
             (-> errors
                 (dissoc field)
                 (not-empty)))]
     (swap! form (fn [state]
                   (-> state
                       (assoc-in [:touched field] true)
                       (assoc-in [:data field] (if trim? (str/trim value) value))
                       (update :errors clean-errors)
                       (update :extra-errors clean-errors)
                       (update :extra-errors dissoc "")))))))

(defn update-input-value!
  [form field value]
  (swap! form (fn [state]
                (-> state
                    (assoc-in [:data field] value)
                    (update :errors dissoc field)
                    (update :extra-errors dissoc "")))))

(defn on-input-blur
  [form field]
  (fn [_]
    (let [touched (get @form :touched)]
      (when-not (get touched field)
        (swap! form assoc-in [:touched field] true)))))

;; --- Helper Components

(defn error-class
  [form field]
  (when (and (dm/get-in form [:errors field])
             (dm/get-in form [:touched field]))
    "invalid"))