(import-macros {:compile-html <>} :macros)
(local lib (require :lib))
(local required-marker
(<> [: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]
(<>
[: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 (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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]
(<>
[: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 (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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]
(<>
[: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 (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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]
(<>
[: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 (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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]
(<>
[: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 (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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]
(<>
[: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 (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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?))
(<>
[:div {:class "form-row"}
[:div {:class "d-flex gap-1"}
(if (and value (lib.ends-with? value ".jpg"))
(<> [: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?)
(<> [:input {:type "hidden" :name (.. name "_previous") :value value}])
"")
(if error (<> [:div {:class "form-error"} error]) "")
(if help (<> [: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]
(<>
[: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)]
(<>
[: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]
(<>
[:form {:class "form" :enctype "multipart/form-data" :method "POST"}
(table.concat
(lib.append
(icollect [_ group (ipairs form)]
(<>
[: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))))]))
(<> [: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}