integreat/src/clj/auto_ap/ssr/utils.clj

(ns auto-ap.ssr.utils
  (:require
   [auto-ap.datomic :refer [all-schema conn]]
   [auto-ap.logging :as alog]
   [clojure.string :as str]
   [config.core :refer [env]]
   [datomic.api :as dc]
   [hiccup2.core :as hiccup]
   [malli.core :as mc]
   [malli.error :as me]
   [malli.transform :as mt2]
   [slingshot.slingshot :refer [throw+ try+]]))

(defn html-response [hiccup & {:keys [status headers oob] :or {status 200 headers {} oob []}}]
  {:status  status
   :headers (into {"Content-Type" "text/html"}
                  headers)
   :body    (str
             (hiccup/html
              {}
              hiccup)
             "\n"
             (str/join "\n"
                       (map (fn [o]
                              (hiccup/html
                               {}
                               o))
                            oob)))})

(defn modal-response [hiccup & {:as opts}]
  (apply html-response
         (into
          [hiccup]
          (mapcat identity
                  (-> opts
                      (assoc-in [:headers "hx-trigger"]  "modalopen")
                      (assoc-in [:headers "hx-retarget"] "#modal-content")
                      (assoc-in [:headers "hx-reswap"] "innerHTML"))))))

(defn next-step-modal-response [hiccup & {:as opts}]
  (apply html-response
         (into
          [hiccup]
          (mapcat identity
                  (-> opts
                      (assoc-in [:headers "hx-retarget"] "#modal-content")
                      (assoc-in [:headers "hx-reswap"] "innerHTML"))))))



(defn form-data->map [form-data]
  (reduce-kv
   (fn [acc k v]
     (cond (and (string? v)
                (empty? v))
           acc

           :else
           (assoc-in acc (->> (str/split k #"_")
                              (mapv #(apply keyword (str/split % #"/"))))
                     v)))
   {}
   form-data))

(defn path->name [k]
  (cond (keyword? k)
        (str (namespace k) "/" (name k))

        (seq k)
        (str/join "_" (map path->name k))
        :else k))


(defn forced-vector [x]
  [:vector {:decode/json {:enter (fn [x]
                                   (if (sequential? x)
                                     x
                                     [x]))}}
   x])

(defn empty->nil [v]
  (if (and (string? v) (clojure.string/blank? v))
    nil
    v))

(defn parse-empty-as-nil []
  (mt2/transformer
   {:decoders
    {:map (fn [m]
            (if (not (seq (filter identity (vals m))))
              nil
              m))
     :string empty->nil
     :double empty->nil
     :int empty->nil
     :long empty->nil
     'nat-int? empty->nil}}))

(def entity-id (mc/schema [nat-int? {:error/message "required"
                                       :decode/arbitrary (fn [e]
                                                           (if (and (map? e) (:db/id e))
                                                             (:db/id e)
                                                             e))}]))

(def temp-id (mc/schema [:string {:min 1}]))
(def money (mc/schema [:double]))
(def percentage (mc/schema [:double {:decode/string {:enter (fn [x]
                                                              (if (and (string? x) (re-find #"^\d+(\.\d+)?$" x))
                                                                (-> x (Double/parseDouble) (* 0.01))
                                                                x))}
                                     :max           1.0
                                     :error/message "1-100"}]))

(def regex (mc/schema [:fn {:error/message "not a regex"}
                       (fn check-regx [x]
                         (try
                           (and (string? x)
                                (. java.util.regex.Pattern (compile x java.util.regex.Pattern/CASE_INSENSITIVE)))
                           true
                           (catch Exception _
                             false)))]))

(def map->db-id-decoder
  {:enter (fn [x]
            (if (sequential? x)
              x
              (into []
                    (for [[k v] (sort-by (comp #(Long/parseLong %) name first) x)]
                      v))))})

(defn many-entity [params & keys]
  (mc/schema
   [:vector (merge params {:decode/json      map->db-id-decoder
                           :decode/arbitrary (fn [x]
                                               (if (sequential? x)
                                                 x
                                                 [x]))})
    (into [:map] keys)]))

(defn str->keyword [s]
  (if (string? s)
    (let [[ns k] (str/split s #"/")]
      (if (and ns k)
        (keyword ns k)
        (keyword s)))
    s))

(defn keyword->str [k]
  (subs (str k) 1))


;; TODO make this bubble the form data automatically
(defn field-validation-error [m path & {:as data}]
  (throw+ (ex-info m (merge data {:type :field-validation
                                  :form-errors  (assoc-in {} path [m])}))))

(defn form-validation-error [m & {:as data}]
  (throw+ (ex-info m (merge data {:type                    :form-validation
                                  :form-validation-errors [m]}))))

(def main-transformer
  (mt2/transformer
   parse-empty-as-nil
   (mt2/key-transformer {:encode keyword->str :decode str->keyword})
   mt2/string-transformer
   mt2/json-transformer
   (mt2/transformer {:name :arbitrary})
   mt2/default-value-transformer))

(defn strip [s]
  (cond (and (string? s) (str/blank? s))
        nil

        (string? s)
        (str/trim s)

        :else
        s))
(defn assert-schema [schema entity]
  (when-not (mc/validate schema entity)
    (throw (ex-info #_(->> (-> (mc/explain schema entity)
                               (me/humanize {:errors (assoc me/default-errors
                                                            ::mc/missing-key {:error/message {:en "required"}})}))
                           (map (fn [[k v]]
                                  (str (if (keyword? k)
                                         (name k)
                                         k) ": " (str/join ", " v))))
                           (str/join ", "))
            "validation failed"
                    {:type    :schema-validation
                     :decoded entity
                     :error   {:explain (mc/explain schema entity)}}))))


(defn schema-enforce-request [{:keys [form-params query-params params] :as request} & {:keys [form-schema query-schema route-schema params-schema]}]
  (let [request (try
                  (cond-> request
                    (and (:params request) params-schema)
                    (assoc :params
                           (mc/coerce
                            params-schema
                            (:params request)
                            main-transformer))

                    (and (:route-params request) route-schema)
                    (assoc :route-params
                           (mc/coerce
                            route-schema
                            (:route-params request)
                            main-transformer))

                    (and form-schema form-params)
                    (assoc :form-params
                           (mc/coerce
                            form-schema
                            form-params
                            main-transformer))

                    (and query-schema query-params)
                    (assoc :query-params
                           (mc/coerce
                            query-schema
                            query-params
                            main-transformer)))

                  (catch Exception e
                    (alog/warn ::validation-error :error e)
                    (throw (ex-info (->> (-> e
                                             (ex-data)
                                             :data
                                             :explain
                                             (me/humanize {:errors (assoc me/default-errors
                                                                          ::mc/missing-key {:error/message {:en "required"}})}))
                                         (map (fn [[k v]]
                                                (str (if (keyword? k)
                                                       (name k)
                                                       k) ": " (str/join ", " v))))
                                         (str/join ", "))
                                    {:type    :schema-validation
                                     :decoded (:value (:data (ex-data e)))
                                     :error   (:data (ex-data e))}))))]
    request))

(defn wrap-schema-enforce [handler & {:keys [form-schema query-schema route-schema params-schema]}]
  (fn [request]
    (handler (schema-enforce-request request
                                     :form-schema form-schema
                                     :query-schema query-schema
                                     :route-schema route-schema
                                     :params-schema params-schema))))


(defn schema-decode-request [{:keys [form-params query-params params] :as request} & {:keys [form-schema query-schema route-schema params-schema]}]
  (let [request (cond-> request
                  (and (:params request) params-schema)
                  (assoc :params
                         (mc/decode
                          params-schema
                          (:params request)
                          main-transformer))

                  (and (:route-params request) route-schema)
                  (assoc :route-params
                         (mc/decode
                          route-schema
                          (:route-params request)
                          main-transformer))

                  (and form-schema form-params)
                  (assoc :form-params
                         (mc/decode
                          form-schema
                          form-params
                          main-transformer))

                  (and query-schema query-params)
                  (assoc :query-params
                         (mc/decode
                          query-schema
                          query-params
                          main-transformer)))]
    request))

(defn wrap-schema-decode [handler & {:keys [form-schema query-schema route-schema params-schema]}]
  (fn [request]
    (handler (schema-decode-request request
                                    :form-schema form-schema
                                    :query-schema query-schema
                                    :route-schema route-schema
                                    :params-schema params-schema))))

(defn ref->enum-schema [n]
  (into [:enum {:decode/string #(if (keyword? %)
                                  %
                                  (when (not-empty %)
                                    (keyword n %)))}]
        (for [{:db/keys [ident]} (all-schema)
              :when              (= n (namespace ident))]
          ident)))

(defn ref->select-options [n & {:keys [allow-nil?]}]
  (into (if allow-nil?
          [["" ""]]
          [])
        (for [{:db/keys [ident]} (all-schema)
              :when              (= n (namespace ident))]
          [(name ident) (str/replace (str/capitalize (name ident)) "-" " ")])))

(defn ref->radio-options [n & {:keys [allow-nil?]}]
  (into (if allow-nil?
          [{:value nil :content ""}]
          [])
        (for [{:db/keys [ident]} (all-schema)
              :when              (= n (namespace ident))]
          {:value (name ident) :content (str/replace (str/capitalize (name ident)) "-" " ")})))


(defn wrap-form-4xx-2 [handler form-handler]
  (fn [request]
    (try+
     (handler request)
     (catch [:type :schema-validation] e
       (let [humanized (-> e  :error :explain (me/humanize {:errors (assoc me/default-errors
                                                                           ::mc/missing-key {:error/message {:en "required"}})}))
             errors (map
                     (fn [e]
                       {:path    (:in e)
                        :message (get-in humanized (:in e))})
                     (:errors (:explain (:error e))))]
         (alog/warn ::form-4xx :errors errors)
         (form-handler (assoc request
                              :form-params (:decoded e)
                              :field-validation-errors errors
                              :form-errors humanized)))
       #_(html-response [:span.error-content.text-red-500 (:message &throw-context)]
                        :status 400))
     (catch [:type :field-validation] e
       (form-handler (assoc request
                            :form-params (:form e)
                            :form-errors (:form-errors e))))
     (catch [:type :form-validation] e
       (form-handler (assoc request
                            :form-params (:form e)
                            :form-validation-errors (:form-validation-errors e)
                            :form-errors {:errors (:form-validation-errors e)}))))))


(defn apply-middleware-to-all-handlers [key->handler f]
  (->> key->handler
       (reduce
        (fn [key-handler [k v]]
          (assoc key-handler k (f v)))
        key->handler)))

(defn path->name2 [k & rest]
  (let [k->n (fn [k]
               (if (keyword? k)
                 (str (when (namespace k)
                        (str (namespace k) "/"))
                      (name k))
                 k))]
    (str (k->n k)
         (str/join ""
                   (map (fn [k]
                          (str "[" (k->n k) "]"))
                        rest)))))


(defn wrap-entity [handler path read]
  (fn wrap-entity-request [request]
    (let [entity (some->>
                  (get-in request path)
                  (#(if (string? %) (Long/parseLong %) %))
                  (dc/pull (dc/db conn) read))]
      (handler (if entity
                 (assoc request
                        :entity entity)
                 request)))))