(ns reagent.impl.template
  (:require [clojure.string :as string]
            [clojure.walk :refer [prewalk]]
            [reagent.impl.util :as util :refer [is-client]]
            [reagent.impl.component :as comp]
            [reagent.impl.batching :as batch]
            [reagent.ratom :as ratom]
            [reagent.interop :refer-macros [$ $!]]
            [reagent.debug :refer-macros [dbg prn println log dev?
                                          warn warn-unless]]))

;; From Weavejester's Hiccup, via pump:
(def ^{:doc "Regular expression that parses a CSS-style id and class
             from a tag name."}
  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

(deftype NativeWrapper [])


;;; Common utilities

(defn ^boolean named? [x]
  (or (keyword? x)
      (symbol? x)))

(defn ^boolean hiccup-tag? [x]
  (or (named? x)
      (string? x)))

(defn ^boolean valid-tag? [x]
  (or (hiccup-tag? x)
      (ifn? x)
      (instance? NativeWrapper x)))


;;; Props conversion

(def prop-name-cache #js{:class "className"
                         :for "htmlFor"
                         :charset "charSet"})

(defn cache-get [o k]
  (when ^boolean (.hasOwnProperty o k)
    (aget o k)))

(defn cached-prop-name [k]
  (if (named? k)
    (if-some [k' (cache-get prop-name-cache (name k))]
      k'
      (aset prop-name-cache (name k)
            (util/dash-to-camel k)))
    k))

(defn ^boolean js-val? [x]
  (not (identical? "object" (goog/typeOf x))))

(declare convert-prop-value)

(defn kv-conv [o k v]
  (doto o
    (aset (cached-prop-name k)
          (convert-prop-value v))))

(defn convert-prop-value [x]
  (cond (js-val? x) x
        (named? x) (name x)
        (map? x) (reduce-kv kv-conv #js{} x)
        (coll? x) (clj->js x)
        (ifn? x) (fn [& args]
                   (apply x args))
        :else (clj->js x)))

(defn oset [o k v]
  (doto (if (nil? o) #js{} o)
    (aset k v)))

(defn oget [o k]
  (if (nil? o) nil (aget o k)))

(defn set-id-class [p id-class]
  (let [id ($ id-class :id)
        p (if (and (some? id)
                   (nil? (oget p "id")))
            (oset p "id" id)
            p)]
    (if-some [class ($ id-class :className)]
      (let [old (oget p "className")]
        (oset p "className" (if (nil? old)
                              class
                              (str class " " old))))
      p)))

(defn convert-props [props id-class]
  (-> props
      convert-prop-value
      (set-id-class id-class)))


;;; Specialization for input components

;; <input type="??" >
;; The properites 'selectionStart' and 'selectionEnd' only exist on some inputs
;; See: https://html.spec.whatwg.org/multipage/forms.html#do-not-apply
(def these-inputs-have-selection-api #{"text" "textarea" "password" "search"
                                       "tel" "url"})

(defn ^boolean has-selection-api?
  [input-type]
  (contains? these-inputs-have-selection-api input-type))

(defn input-set-value [this]
  (when-some [node ($ this :cljsInputElement)]
    ($! this :cljsInputDirty false)
    (let [rendered-value ($ this :cljsRenderedValue)
          dom-value ($ this :cljsDOMValue)]
      (when (not= rendered-value dom-value)
        (if-not (and (identical? node ($ js/document :activeElement))
                     (has-selection-api? ($ node :type))
                     (string? rendered-value)
                     (string? dom-value))
          ;; just set the value, no need to worry about a cursor
          (do
            ($! this :cljsDOMValue rendered-value)
            ($! node :value rendered-value))

          ;; Setting "value" (below) moves the cursor position to the
          ;; end which gives the user a jarring experience.
          ;;
          ;; But repositioning the cursor within the text, turns out to
          ;; be quite a challenge because changes in the text can be
          ;; triggered by various events like:
          ;; - a validation function rejecting a user inputted char
          ;; - the user enters a lower case char, but is transformed to
          ;;   upper.
          ;; - the user selects multiple chars and deletes text
          ;; - the user pastes in multiple chars, and some of them are
          ;;   rejected by a validator.
          ;; - the user selects multiple chars and then types in a
          ;;   single new char to repalce them all.
          ;; Coming up with a sane cursor repositioning strategy hasn't
          ;; been easy ALTHOUGH in the end, it kinda fell out nicely,
          ;; and it appears to sanely handle all the cases we could
          ;; think of.
          ;; So this is just a warning. The code below is simple
          ;; enough, but if you are tempted to change it, be aware of
          ;; all the scenarios you have handle.
          (let [node-value ($ node :value)]
            (if (not= node-value dom-value)
              ;; IE has not notified us of the change yet, so check again later
              (batch/do-after-render #(input-set-value this))
              (let [existing-offset-from-end (- (count node-value)
                                                ($ node :selectionStart))
                    new-cursor-offset        (- (count rendered-value)
                                                existing-offset-from-end)]
                ($! this :cljsDOMValue rendered-value)
                ($! node :value rendered-value)
                ($! node :selectionStart new-cursor-offset)
                ($! node :selectionEnd new-cursor-offset)))))))))

(defn input-handle-change [this on-change e]
  ($! this :cljsDOMValue (-> e .-target .-value))
  ;; Make sure the input is re-rendered, in case on-change
  ;; wants to keep the value unchanged
  (when-not ($ this :cljsInputDirty)
    ($! this :cljsInputDirty true)
    (batch/do-after-render #(input-set-value this)))
  (on-change e))

(defn input-render-setup [this jsprops]
  ;; Don't rely on React for updating "controlled inputs", since it
  ;; doesn't play well with async rendering (misses keystrokes).
  (when (and (some? jsprops)
             (.hasOwnProperty jsprops "onChange")
             (.hasOwnProperty jsprops "value"))
    (let [v ($ jsprops :value)
          value (if (nil? v) "" v)
          on-change ($ jsprops :onChange)]
      (when (nil? ($ this :cljsInputElement))
        ;; set initial value
        ($! this :cljsDOMValue value))
      ($! this :cljsRenderedValue value)
      (js-delete jsprops "value")
      (doto jsprops
        ($! :defaultValue value)
        ($! :onChange #(input-handle-change this on-change %))
        ($! :ref #($! this :cljsInputElement %1))))))

(defn ^boolean input-component? [x]
  (case x
    ("input" "textarea") true
    false))

(def reagent-input-class nil)

(declare make-element)

(def input-spec
  {:display-name "ReagentInput"
   :component-did-update input-set-value
   :reagent-render
   (fn [argv comp jsprops first-child]
     (let [this comp/*current-component*]
       (input-render-setup this jsprops)
       (make-element argv comp jsprops first-child)))})

(defn reagent-input []
  (when (nil? reagent-input-class)
    (set! reagent-input-class (comp/create-class input-spec)))
  reagent-input-class)


;;; Conversion from Hiccup forms

(defn parse-tag [hiccup-tag]
  (let [[tag id class] (->> hiccup-tag name (re-matches re-tag) next)
        class (when-not (nil? class)
                (string/replace class #"\." " "))]
    (assert tag (str "Invalid tag: '" hiccup-tag "'"
                     (comp/comp-name)))
    #js{:name tag
        :id id
        :className class}))

(defn try-get-key [x]
  ;; try catch to avoid clojurescript peculiarity with
  ;; sorted-maps with keys that are numbers
  (try (get x :key)
       (catch :default e)))

(defn get-key [x]
  (when (map? x)
    (try-get-key x)))

(defn key-from-vec [v]
  (if-some [k (-> (meta v) get-key)]
    k
    (-> v (nth 1 nil) get-key)))

(defn reag-element [tag v]
  (let [c (comp/as-class tag)
        jsprops #js{:argv v}]
    (when-some [key (key-from-vec v)]
      ($! jsprops :key key))
    ($ util/react createElement c jsprops)))

(defn adapt-react-class [c]
  (doto (NativeWrapper.)
    ($! :name c)
    ($! :id nil)
    ($! :class nil)))

(def tag-name-cache #js{})

(defn cached-parse [x]
  (if-some [s (cache-get tag-name-cache x)]
    s
    (aset tag-name-cache x (parse-tag x))))

(declare as-element)

(defn native-element [parsed argv first]
  (let [comp ($ parsed :name)]
    (let [props (nth argv first nil)
          hasprops (or (nil? props) (map? props))
          jsprops (convert-props (if hasprops props) parsed)
          first-child (+ first (if hasprops 1 0))]
      (if (input-component? comp)
        (-> [(reagent-input) argv comp jsprops first-child]
            (with-meta (meta argv))
            as-element)
        (let [key (-> (meta argv) get-key)
              p (if (nil? key)
                  jsprops
                  (oset jsprops "key" key))]
          (make-element argv comp p first-child))))))

(defn str-coll [coll]
  (if (dev?)
    (str (prewalk (fn [x]
                    (if (fn? x)
                      (let [n (util/fun-name x)]
                        (case n "" x (symbol n)))
                      x)) coll))
    (str coll)))

(defn hiccup-err [v & msg]
  (str (apply str msg) ": " (str-coll v) "\n" (comp/comp-name)))

(defn vec-to-elem [v]
  (assert (pos? (count v)) (hiccup-err v "Hiccup form should not be empty"))
  (let [tag (nth v 0 nil)]
    (assert (valid-tag? tag) (hiccup-err v "Invalid Hiccup form"))
    (cond
      (hiccup-tag? tag)
      (let [n (name tag)
            pos (.indexOf n ">")]
        (case pos
          -1 (native-element (cached-parse n) v 1)
          0 (let [comp (nth v 1 nil)]
              ;; Support [:> comp ...]
              (assert (= ">" n) (hiccup-err v "Invalid Hiccup tag"))
              (assert (or (string? comp) (fn? comp))
                      (hiccup-err v "Expected React component in"))
              (native-element #js{:name comp} v 2))
          ;; Support extended hiccup syntax, i.e :div.bar>a.foo
          (recur [(subs n 0 pos)
                  (assoc v 0 (subs n (inc pos)))])))

      (instance? NativeWrapper tag)
      (native-element tag v 1)

      :else (reag-element tag v))))

(declare expand-seq)
(declare expand-seq-check)

(defn as-element [x]
  (cond (js-val? x) x
        (vector? x) (vec-to-elem x)
        (seq? x) (if (dev?)
                   (expand-seq-check x)
                   (expand-seq x))
        (named? x) (name x)
        (satisfies? IPrintWithWriter x) (pr-str x)
        :else x))

(set! comp/as-element as-element)

(defn expand-seq [s]
  (let [a (into-array s)]
    (dotimes [i (alength a)]
      (aset a i (as-element (aget a i))))
    a))

(defn expand-seq-dev [s o]
  (let [a (into-array s)]
    (dotimes [i (alength a)]
      (let [val (aget a i)]
        (when (and (vector? val)
                   (nil? (key-from-vec val)))
          ($! o :no-key true))
        (aset a i (as-element val))))
    a))

(defn expand-seq-check [x]
  (let [ctx #js{}
        [res derefed] (ratom/check-derefs #(expand-seq-dev x ctx))]
    (when derefed
      (warn (hiccup-err x "Reactive deref not supported in lazy seq, "
                        "it should be wrapped in doall")))
    (when ($ ctx :no-key)
      (warn (hiccup-err x "Every element in a seq should have a unique :key")))
    res))

;; From https://github.com/babel/babel/commit/1d0e68f5a19d721fe8799b1ea331041d8bf9120e
;; (def react-element-type (or (and (exists? js/Symbol)
;;                                  ($ js/Symbol :for)
;;                                  ($ js/Symbol for "react.element"))
;;                             60103))

;; (defn make-element-fast [argv comp jsprops first-child]
;;   (let [key (some-> jsprops ($ :key))
;;         ref (some-> jsprops ($ :ref))
;;         props (if (nil? jsprops) (js-obj) jsprops)]
;;     ($! props :children
;;         (case (- (count argv) first-child)
;;           0 nil
;;           1 (as-element (nth argv first-child))
;;           (reduce-kv (fn [a k v]
;;                        (when (>= k first-child)
;;                          (.push a (as-element v)))
;;                        a)
;;                      #js[] argv)))
;;     (js-obj "key" key
;;             "ref" ref
;;             "props" props
;;             "$$typeof" react-element-type
;;             "type" comp
;;             ;; "_store" (js-obj)
;;             )))

(defn make-element [argv comp jsprops first-child]
  (case (- (count argv) first-child)
    ;; Optimize cases of zero or one child
    0 ($ util/react createElement comp jsprops)

    1 ($ util/react createElement comp jsprops
          (as-element (nth argv first-child nil)))

    (.apply ($ util/react :createElement) nil
            (reduce-kv (fn [a k v]
                         (when (>= k first-child)
                           (.push a (as-element v)))
                         a)
                       #js[comp jsprops] argv))))