(ns auto-ap.ssr.utils
  (:require
   [auto-ap.datomic :refer [all-schema conn pull-attr]]
   [auto-ap.logging :as alog]
   [auto-ap.time :as atime]
   [clj-time.coerce :as coerce]
   [clj-time.core :as time]
   [clojure.string :as str]
   [datomic.api :as dc]
   [hiccup.compiler :refer [HtmlRenderer render-html]]
   [hiccup2.core :as hiccup]
   [malli.core :as mc]
   [malli.core :as m]
   [malli.error :as me]
   [malli.registry :as mr]
   [malli.transform :as mt2]
   [slingshot.slingshot :refer [throw+ try+]]
   [taoensso.encore :refer [filter-vals]]))

(defrecord OOBElements [elements]
  HtmlRenderer
  (render-html [this]
    (str/join "\n" (map render-html elements))))

(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
                      (update-in [:headers "hx-trigger"]  (fn [ht] (str/join ", " (filter identity [ht "modalopen"]))))
                      (assoc-in [:headers "hx-retarget"] "#modal-content")
                      (assoc-in [:headers "hx-reswap"] "innerHTML"))))))

(defn modal-replace-response [hiccup & {:as opts}]
  (apply html-response
         (into
          [hiccup]
          (mapcat identity
                  (-> opts
                      (assoc-in [:headers "hx-trigger"]  "modalswap")
                      (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 (and (map? m) (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 raw-entity-id [nat-int? {:error/message "required"
                              :decode/arbitrary (fn [e]
                                                  (if (and (map? e) (:db/id e))
                                                    (:db/id e)
                                                    e))}])

(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 %) 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 many-entity-custom [params schema]
  (mc/schema
   [:vector (merge params {:decode/json      map->db-id-decoder
                           :decode/arbitrary (fn [x]
                                               (if (sequential? x)
                                                 x
                                                 [x]))})
    schema]))


(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]
  (cond (keyword? k)
        (subs (str k) 1)
        (string? k)
        k
        :else 
        k))


;; 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}]
  (alog/warn ::form-validaiton-error :data data)
  (throw+ (ex-info m (merge data {:type                    :form-validation
                                  :form-validation-errors [m]}))))

(def clj-date-schema
  (mc/schema [:and [inst? {:date-format atime/normal-date 
                           }]
              [:fn
               {:error/message "Invalid date"}
               (fn [d]
                 (if d 
                   (time/after? (coerce/to-date-time d)
                                (coerce/to-date-time #inst "2000-01-01"))
                   true))]
              [:fn
               {:error/message "Can not look more than four years into the future."}
               (fn [d]
                 (if d 
                   (time/before? (coerce/to-date-time d)
                                 (time/plus (time/now) (time/years 4)))
                   true))]]))

(def date-transformer
  (mt2/transformer
   {:decoders
    {'inst? {:compile (fn [schema _]
                        (let [properties (mc/properties schema)
                              format (:format properties atime/normal-date)]
                          (fn [m]
                            (if (string? m)
                              (coerce/to-date-time (atime/parse m format))

                              m))))}}
    :encoders
    {'inst?
     {:compile (fn [schema _]
                 (let [properties (mc/properties schema)
                       format (:format properties atime/normal-date)]
                   (fn [m]
                     (cond
                       (inst? m)
                       (atime/unparse-local (coerce/to-date-time m) format)

                       (instance? org.joda.time.DateTime m)
                       (atime/unparse-local m format)

                       :else
                       m))))}}}))

(def date-range-transformer
  (mt2/transformer {:decoders
                    {:map {:compile (fn [schema _]
                                      (let [properties (mc/properties schema)]
                                        (fn [m]
                                          (if (:date-range properties)
                                            (let [[date-range-key start-date-key end-date-key] (:date-range properties)
                                                  date-range-value (get m date-range-key)]
                                              (if date-range-value
                                                (-> (condp = date-range-value
                                                      "week"
                                                      (let [last-monday (atime/as-local-time (coerce/to-date-time (atime/last-monday)))]
                                                        (assoc m
                                                               start-date-key (time/plus last-monday (time/days -7))
                                                               end-date-key (time/plus last-monday (time/days -1))))

                                                      "month"
                                                      (let [end-of-month (atime/as-local-time (coerce/to-date-time (time/plus (time/first-day-of-the-month (atime/local-today)) (time/days -1))))]
                                                        (assoc m
                                                               start-date-key (time/first-day-of-the-month end-of-month)
                                                               end-date-key end-of-month))

                                                      "year"
                                                      (assoc m
                                                             start-date-key (atime/as-local-time (time/date-time (time/year (atime/local-today))
                                                                                                                 1 
                                                                                                                 1))
                                                             end-date-key nil)

                                                      "all"
                                                      (assoc m start-date-key (time/plus (time/now) (time/years -6))
                                                             end-date-key nil)

                                                      m)
                                                    (dissoc date-range-key))
                                                m))
                                            m))))}}}))

(defn ->db-id [m]
  (cond
    (map? m)
    (:db/id m)
    (nat-int? m)
    m
    (and (string? m) (not-empty m))
    (Long/parseLong m)

    :else
    m))

(def pull-transformer
  (mt2/transformer {:decoders
                    {:entity-map
                     {:compile (fn [schema g]
                                 (let [pull-expr  (:pull (mc/properties schema))]
                                   (if pull-expr
                                     (fn pull-data [m]
                                       (cond
                                         (nat-int? m)
                                         (dc/pull (dc/db conn) pull-expr m)
                                         (and (string? m) (not-empty m))
                                         (dc/pull (dc/db conn) pull-expr (Long/parseLong m))
                                         :else
                                         nil))
                                     identity)))}}
                    :encoders
                    {:entity-map
                     {:compile (fn [schema _]
                                 (let [pull-expr  (:pull (mc/properties schema))]
                                   (if pull-expr
                                     (fn pull-data [m]
                                       (cond
                                         (map? m)
                                         (:db/id m)
                                         (nat-int? m)
                                         m
                                         (and (string? m) (not-empty m))
                                         (Long/parseLong m)

                                         :else
                                         m))
                                     identity)))}}}))

(def coerce-vector
  (mt2/transformer {:decoders {:vector {:compile (fn [schema _]
                                                   (when (:coerce? (m/properties schema))
                                                     (fn [data]
                                                       (cond
                                                   (vector? data)
                                                         data
                                                         (sequential? data)
                                                         data
                                                         (and (map? data)
                                                              (every? #(try  (Long/parseLong %) true (catch Exception _ false)) (keys data)))
                                                         (into [] (->> (keys data)
                                                                       sort
                                                                       (map  data)))
                                                         (nil? data)
                                                         nil
                                                         :else
                                                         [data]))))}}}))

(defn wrap-merge-prior-hx [handler]
  (fn [{:keys [headers] :as request}]
    (let [is-htmx-that-should-inherit-url-parameters? (and (not (get headers "hx-boosted"))
                                                           (get headers "hx-request"))]
      (alog/peek ::check {:enabled? is-htmx-that-should-inherit-url-parameters?
                          :params (:query-params request)})

      (if is-htmx-that-should-inherit-url-parameters?
        (handler (update request :query-params (fn [qp]
                                                 (->> (concat (:hx-query-params request) qp)
                                                      (into {})))))
        (handler request)))))


(def dissoc-nil-transformer
  (let [e {:map {:compile (fn [schema _]
                            (fn [data]
                              (if (map? data)
                                (filter-vals
                                 (fn [x]
                                   (not (nil? x)))
                                 data)
                                data)))}}]
    (mt2/transformer {:encoders e
                      :decoders e})))

(def unspecified-transformer
  (mt2/transformer 
    {:decoders {:map {:compile (fn [x g]
                                 (fn [value]
                                   (if (or (nil? value)
                                           (map? value))
                                     (let [ specified-keys (set (keys value))]
                                       (reduce
                                        (fn [value [k params]]
                                          (cond (and (:unspecified/fn params)
                                                     (not (get specified-keys k)))
                                                (assoc value k ((:unspecified/fn params)))
                                                (and (:unspecified/value params)
                                                     (not (get specified-keys k)))
                                                (assoc value k (:unspecified/value params))
                                                :else
                                                value
                                                ))
                                        value 
                                        (m/children x)))
                                     value)))}}}))

(def main-transformer
  (mt2/transformer
   date-transformer
   (mt2/key-transformer {:encode keyword->str :decode str->keyword})
   mt2/string-transformer
   mt2/json-transformer
   parse-empty-as-nil
   unspecified-transformer
   (mt2/transformer {:name :arbitrary})
   coerce-vector
   date-range-transformer
   pull-transformer
   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 hx-query-params multipart-params params] :as request} & {:keys [form-schema multipart-schema hx-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 (:multipart-params request) multipart-schema)
                    (assoc :multipart-params
                           (mc/coerce
                            multipart-schema
                            (:multipart-params request)
                            main-transformer))

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

                    (and hx-schema hx-query-params)
                    (assoc :hx-query-params
                           (mc/coerce
                            hx-schema
                            hx-query-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
                               ::errors (-> e
                                             (ex-data)
                                             :data
                                             :explain
                                             (me/humanize {:errors (assoc me/default-errors
                                                                          ::mc/missing-key {:error/message {:en "required"}})})))
                    (throw (ex-info (->> (-> e
                                             (ex-data)
                                             :data
                                             :explain
                                             (me/humanize {:errors (assoc me/default-errors
                                                                          ::mc/missing-key {:error/message {:en "required"}})}))
                                         (map (fn [x]
                                                (if (and (sequential? x)
                                                         (= (count x) 2))
                                                  (let [[k v] x]
                                                    (str (if (keyword? k)
                                                           (name k)
                                                           k) ": " (str/join ", " v))
                                                    (str x)))))
                                         (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 hx-schema multipart-schema]}]
  (fn [request]
    (handler (schema-enforce-request request
                                     :hx-schema hx-schema
                                     :multipart-schema multipart-schema
                                     :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 %)))
                :encode/string #(if (keyword? %)
                                  (name %)
                                  %)}]
        (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
                    :data e)
         (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 (or (:form e) ;; TODO is :form actually used?
                                             (:form-params e)
                                             (:form-params request)
                                             )
                            :form-errors (:form-errors e))))
     (catch [:type :form-validation] e
       (form-handler (assoc request
                            :form-params (or (:form e) ;; TODO is :form actually used?
                                             (:form-params e)
                                             (:form-params request))
                            :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)))))

(mr/set-default-registry!
 (mr/composite-registry
  (mc/default-schemas)
  {:entity-id entity-id
   :entity-map
   (mc/-simple-schema {:type :entity-map
                       :pred map?
                       :type-properties { :error/message "required"}})
   #_[:map {:name :entity-map} [:db/id nat-int?]]}))

(comment

  (mc/coerce [:map [:x {:optional true} [:maybe [:entity-map {:pull '[:db/id]}]]]]
             {:x nil :g 1}
             main-transformer)

  (mc/decode [:map [:x   [:entity-map {:pull '[:db/id :db/ident]}]]]
             {:x 87}
             main-transformer))

(defn round-money [d]
  (with-precision 2
    (double (.setScale (bigdec d) 2 java.math.RoundingMode/HALF_UP))))



(defn wrap-implied-route-param [handler & {:as route-params}]
  (fn [request]
    (handler (update-in request [:route-params] merge route-params))))

(defn check-allowance [account-id allowance-key]
  (let [account-id (if (map? account-id)
                     (:db/id account-id)
                     account-id)
        allowance (allowance-key (dc/pull (dc/db conn) '[{[:account/invoice-allowance :xform iol-ion.query/ident] [:db/ident]
                                                          [:account/vendor-allowance :xform iol-ion.query/ident] [:db/ident]
                                                          [:account/default-allowance :xform iol-ion.query/ident] [:db/ident]}]
                                      account-id))]
    (not= :allowance/denied
          allowance)))

(defn check-location-belongs [location account-id]
  (let [account (if (map? account-id)
                  (:db/id account-id)
                  account-id)
        account-location (pull-attr (dc/db conn) :account/location account)]
    (when (and (seq account-location)
               (not= location
                     account-location))
      (throw (ex-info "Exception." {:type (str "expected " account-location)})))
    (when (and (empty? account-location)
               (= "A" location))

      (throw (ex-info "Exception." {:type "'A' not allowed"})))
    true))

(def default-grid-fields-schema 
  [
   [:sort {:optional true} [:maybe [:any]]]
   [:per-page {:optional true :default 25} [:maybe :int]]
   [:start {:optional true :default 0} [:maybe :int]]
   [:exact-match-id {:optional true} [:maybe entity-id]]])