path: root/forms.fnl

(import-macros {:compile-html HTML} :macros)
(local lib (require :lib))

(local required-marker
  (HTML [:span {:class "form-required-marker"} " (обяз.)"]))

(fn textarea-input [name label required? minlength maxlength help]
  (local minlength (or minlength 0))
  (local maxlength (or maxlength 1000))

  {: name : label : required? : help
   :validate
    (fn [value]
      (if (<= minlength (# value) maxlength)
        nil
        "Некорректная длина текста."))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:label {:class "form-label" :for name}
        label (if required? required-marker "")]
       [:textarea (fn [] {:name name :id name :class "form-input"
                          :minlength (tostring minlength)
                          :maxlength (tostring maxlength)
                          :required required?})
         (or value "")]
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn text-input [name label required? minlength maxlength help]
  (local minlength (or minlength 0))
  (local maxlength (or maxlength 200))

  {: name : label : required? : help
   :validate
    (fn [value]
      (if (<= minlength (# value) maxlength)
        nil
        "Некорректная длина текста."))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:label {:class "form-label" :for name}
        label (if required? required-marker "")]
       [:input (fn [] {:type "text" :name name :id name :class "form-input"
                       :minlength (tostring minlength)
                       :maxlength (tostring maxlength)
                       :required required?
                       :value value})]
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn password-input [name label required? minlength maxlength help]
  (local minlength (or minlength 0))
  (local maxlength (or maxlength 200))

  {: name : label : required? : help
   :validate
    (fn [value]
      (if (<= minlength (# value) maxlength)
        nil
        "Некорректная длина текста."))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:label {:class "form-label" :for name}
        label (if required? required-marker "")]
       [:input (fn [] {:type "password" :name name :id name :class "form-input"
                       :minlength (tostring minlength)
                       :maxlength (tostring maxlength)
                       :required required?
                       :value value})]
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn url-input [name label required? help]
  {: name : label : required? : help
   :validate
    (fn [value]
      (if (<= 0 (# value) 1000)
        nil
        "Некорректная длина ссылки."))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:label {:class "form-label" :for name}
        label (if required? required-marker "")]
       [:input (fn [] {:type "url" :name name :id name :class "form-input"
                       :required required? :value value})]
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn number-input [name label required? min max help]
  (local min (or min 0))
  (local max (or max 100))

  {: name : label : required? : help
   :validate
    (fn [value]
      (if (<= min (tonumber value) max)
        nil
        "Некорректное число."))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:label {:class "form-label" :for name} label (if required? required-marker "")]
       [:input (fn [] {:type "number" :name name :id name :class "form-input"
                       :required required?
                       :min (tostring min) :max (tostring max)
                       :value (tostring value)})]
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn checkbox-input [name label required? help]
  {: name : label : required? : help
   :value-from-html
    (fn [value] (= value "on"))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:input (fn [] {:type "checkbox" :name name :id name :class "form-input"
                       :required required?
                       :checked (or (= value "on") (= value true))})]
       [:label {:class "form-label" :for name} label (if required? required-marker "")]
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn file-input [name label required? accept thumbnail-width help]
  {:type "file" : name : label : required? : help
   :value-from-html
    (fn [value {: data : db}]
      (if (= (type value) "table")
        (lib.handle-upload db value nil thumbnail-width)
       (not (lib.empty? value))
        value
       (. data (.. name "_previous"))))
   :html
    (fn [value error]
     (local empty-value? (lib.empty? value))
     (local required? (and empty-value? required?))

     (HTML
      [:div {:class "form-row"}
       [:div {:class "d-flex gap-1"}
        (if (and value (lib.ends-with? value ".jpg"))
          (HTML [:img {:class "form-file-img" :src (.. "/static/files/" value)}])
          "")
        [:div {}
         [:label {:class "form-label" :for name} label (if required? required-marker "")]
         [:input (fn [] {:type "file" :name name :id name :class "form-input"
                         :required required? :accept accept})]]]
       (if (not empty-value?)
        (HTML [:input {:type "hidden" :name (.. name "_previous") :value value}])
        "")
       (if error (HTML [:div {:class "form-error"} error]) "")
       (if help (HTML [:div {:class "form-help"} help]) "")]))})

(fn select-input [name label required? options help]
  {: name : label : required? : options : help
   :validate
    (fn [value]
      (var exists? false)
      (each [_ option (ipairs options)]
        (when (= option.value value)
          (set exists? true)))
      (if exists? nil "Некорректное значение."))
   :html
    (fn [value error]
     (HTML
      [:div {:class "form-row"}
       [:label {:class "form-label" :for name} label (if required? required-marker "")]
       [:select (fn [] {:name name :id name
                        :required required?})
        [:option [:selected "selected"] ""]
        (table.concat
         (icollect [_ option (ipairs options)]
           (HTML
             [:option
              (fn [] {:value option.value :selected (= value option.value)})
              option.label])))]
       (if error [:div {:class "form-error"} error] "")
       (if help [:div {:class "form-help"} help] "")]))})

(fn render-form [form data errors]
  (HTML
   [:form {:class "form" :enctype "multipart/form-data" :method "POST"}
    (table.concat
     (lib.append
      (icollect [_ group (ipairs form)]
        (HTML
          [:div {:class "form-group"}
           [:h3 {:class "form-subheader"} group.title]
           (table.concat
            (icollect [_ field (ipairs group.fields)]
              (field.html (. data field.name) (. errors field.name))))]))
      (HTML [:button {:type "submit"} "Сохранить"])))]))

(fn convert-values-from-html [form data db]
  (each [_ group (ipairs form)]
   (each [_ field (ipairs group.fields)]
    (local value (. data field.name))
    (when field.value-from-html
      (tset data field.name (field.value-from-html value {: data : db})))))
  data)

(fn validate-form [form data]
  (var errors [])
  (each [_ group (ipairs form)]
   (each [_ field (ipairs group.fields)]
    (local value (. data field.name))
    (local empty-value? (lib.empty? value))
    (when (and field.required? empty-value?)
      (tset errors field.name "Поле должно быть заполнено."))
    (when (and value (not empty-value?) field.validate)
      (local err (field.validate value))
      (when err (tset errors field.name err)))))
  errors)

(fn form-insert-sql-statement [table-name form data extra-data]
  (var columns [])
  (var args [])

  (each [_ group (ipairs form)]
   (each [_ field (ipairs group.fields)]
    (local value (. data field.name))
    (when (not (lib.empty? value))
      (table.insert columns field.name)
      (table.insert args value))))

  (when extra-data
    (each [key value (pairs extra-data)]
      (table.insert columns key)
      (table.insert args value)))

  (if (< 0 (# columns))
    [(.. "INSERT INTO " table-name " (" (table.concat columns ", ") ") VALUES "
         "(" (table.concat (icollect [_ _ (ipairs columns)] "?") ", ") ")")
     args]
    nil))

(fn form-update-sql-statement [table-name form data extra-data where]
  (var columns [])
  (var args [])

  (each [_ group (ipairs form)]
   (each [_ field (ipairs group.fields)]
    (local value (. data field.name))
    (when (not (lib.empty? value))
      (table.insert columns field.name)
      (table.insert args value))))

  (when extra-data
    (each [key value (pairs extra-data)]
      (table.insert columns key)
      (table.insert args value)))

  (var where-columns [])

  (when where
   (each [key value (pairs where)]
     (table.insert where-columns key)
     (table.insert args value)))

  (if (< 0 (# columns))
    [(.. "UPDATE " table-name " SET " (table.concat columns " = ?, ") " = ? "
         "WHERE " (table.concat where-columns " = ?, ") " = ?")
     args]
    nil))

{: textarea-input
 : text-input
 : password-input
 : number-input
 : checkbox-input
 : url-input
 : file-input
 : select-input
 : render-form
 : convert-values-from-html
 : validate-form
 : form-insert-sql-statement
 : form-update-sql-statement}