1 files changed, 288 insertions, 0 deletions
diff --git a/forms.fnl b/forms.fnl
new file mode 100644
index 0000000..0d75afb
--- /dev/null
+++ b/forms.fnl
@@ -0,0 +1,288 @@
+(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}