(ns reagent.impl.template
  (:require [clojure.string :as string]
            [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 [comp])


;;; Common utilities

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

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

(defn 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 obj-get [o k]
  (when (.hasOwnProperty o k)
    (aget o k)))

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

(defn convert-prop-value [x]
  (cond (or (string? x) (number? x) (fn? x)) x
        (named? x) (name x)
        (map? x) (reduce-kv (fn [o k v]
                              (doto o
                                (aset (cached-prop-name k)
                                      (convert-prop-value v))))
                            #js{} x)
        (coll? x) (clj->js x)
        (ifn? x) (fn [& args] (apply x args))
        true (clj->js x)))

(defn set-id-class [props id class]
  (let [p (if (nil? props) #js{} props)]
    (when (and (some? id) (nil? (.' p :id)))
      (.! p :id id))
    (when (some? class)
      (let [old (.' p :className)]
        (.! p :className (if (some? old)
                           (str class " " old)
                           class))))
    p))

(defn convert-props [props id-class]
  (let [id (.' id-class :id)
        class (.' id-class :className)
        no-id-class (and (nil? id) (nil? class))]
    (if (and no-id-class (empty? props))
      nil
      (let [objprops (convert-prop-value props)]
        (if no-id-class
          objprops
          (set-id-class objprops id class))))))


;;; Specialization for input components

(defn input-unmount [this]
  (.! this :cljsInputValue nil))

;; <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 has-selection-api?
  [input-type]
  (contains? these-inputs-have-selection-api input-type))

(defn input-set-value [this]
  (when-some [value (.' this :cljsInputValue)]
             (.! this :cljsInputDirty false)
             (let [node       (.' this getDOMNode)
                   node-value (.' node :value)]
               (when (not= value node-value)
                 (if-not (and (identical? node (.-activeElement js/document))
                              (has-selection-api? (.' node :type))
                              (string? value)
                              (string? node-value))
                   ; just set the value, no need to worry about a cursor
                   (.! node :value 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 certain 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 [existing-offset-from-end (- (count node-value) (.' node :selectionStart))
                         new-cursor-offset        (- (count value) existing-offset-from-end)]
                     (.! node :value value)
                     (.! node :selectionStart new-cursor-offset)
                     (.! node :selectionEnd   new-cursor-offset)))))))

(defn input-handle-change [this on-change e]
  (let [res (on-change e)]
    ;; 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-later #(input-set-value this)))
    res))

(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).
  (if (and (.' jsprops hasOwnProperty "onChange")
           (.' jsprops hasOwnProperty "value"))
    (let [v (.' jsprops :value)
          value (if (nil? v) "" v)
          on-change (.' jsprops :onChange)]
      (.! this :cljsInputValue value)
      (js-delete jsprops "value")
      (doto jsprops
        (.! :defaultValue value)
        (.! :onChange #(input-handle-change this on-change %))))
    (.! this :cljsInputValue nil)))

(defn input-component? [x]
  (or (identical? x "input")
      (identical? x "textarea")))

(def reagent-input-class nil)

(declare make-element)

(def input-spec
  {:display-name "ReagentInput"
   :component-did-update input-set-value
   :component-will-unmount input-unmount
   :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 class
                 (string/replace class #"\." " "))]
    (assert tag (str "Invalid tag: '" hiccup-tag "'"
                     (comp/comp-name)))
    #js{:name tag
        :id id
        :className class'}))

(defn fn-to-class [f]
  (assert (ifn? f) (str "Expected a function, not " (pr-str f)))
  (warn-unless (not (and (fn? f)
                         (some? (.' f :type))))
               "Using native React classes directly in Hiccup forms "
               "is not supported. Use create-element or "
               "adapt-react-class instead: " (.' f :type)
               (comp/comp-name))
  (let [spec (meta f)
        withrender (assoc spec :reagent-render f)
        res (comp/create-class withrender)
        wrapf (util/cached-react-class res)]
    (util/cache-react-class f wrapf)
    wrapf))

(defn as-class [tag]
  (if-some [cached-class (util/cached-react-class tag)]
    cached-class
    (fn-to-class tag)))

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

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

(defn reag-element [tag v]
  (let [c (as-class tag)
        jsprops #js{:argv v}]
    (some->> v key-from-vec (.! jsprops :key))
    (.' js/React createElement c jsprops)))

(defn adapt-react-class [c]
  (NativeWrapper. #js{:name c
                      :id nil
                      :class nil}))

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

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

(declare as-element)

(defn native-element [parsed argv]
  (let [comp (.' parsed :name)]
    (let [props (nth argv 1 nil)
          hasprops (or (nil? props) (map? props))
          jsprops (convert-props (if hasprops props) parsed)
          first-child (if hasprops 2 1)]
      (if (input-component? comp)
        (-> [(reagent-input) argv comp jsprops first-child]
            (with-meta (meta argv))
            as-element)
        (let [p (if-some [key (some-> (meta argv) get-key)]
                  (doto (if (nil? jsprops) #js{} jsprops)
                    (.! :key key))
                  jsprops)]
          (make-element argv comp p first-child))))))

(defn vec-to-elem [v]
  (assert (pos? (count v))
          (str "Hiccup form should not be empty: "
               (pr-str v) (comp/comp-name)))
  (let [tag (nth v 0)]
    (assert (valid-tag? tag)
            (str "Invalid Hiccup form: "
                 (pr-str v) (comp/comp-name)))
    (cond
      (hiccup-tag? tag)
      (let [n (name tag)
            pos (.indexOf n ">")]
        (if (== pos -1)
          (native-element (cached-parse n) v)
          ;; 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 (.-comp tag) v)

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

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

(defn as-element [x]
  (cond (string? x) x
        (vector? x) (vec-to-elem x)
        (seq? x) (if (dev?)
                   (expand-seq-check x)
                   (expand-seq x))
        true x))

(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 (if (nil? ratom/*ratom-context*)
              (expand-seq-dev x ctx)
              (ratom/capture-derefed #(expand-seq-dev x ctx)
                                     ctx))]
    (when (ratom/captured ctx)
      (warn "Reactive deref not supported in lazy seq, "
            "it should be wrapped in doall"
            (comp/comp-name) ". Value:\n" (pr-str x)))
    (when (and (not comp/*non-reactive*)
               (.' ctx :no-key))
      (warn "Every element in a seq should have a unique "
            ":key" (comp/comp-name) ". Value: " (pr-str x)))
    res))

(defn make-element [argv comp jsprops first-child]
  (case (- (count argv) first-child)
    ;; Optimize cases of zero or one child
    0 (.' js/React createElement comp jsprops)

    1 (.' js/React createElement comp jsprops
          (as-element (nth argv first-child)))

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