;;   Copyright (c) Nicola Mometto, Rich Hickey & contributors.
;;   The use and distribution terms for this software are covered by the
;;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;;   which can be found in the file epl-v10.html at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be bound by
;;   the terms of this license.
;;   You must not remove this notice, or any other, from this software.

(ns ^{:doc "An EDN reader in clojure"
      :author "Bronsa"}
  cljs.tools.reader.edn
  (:refer-clojure :exclude [read read-string char default-data-readers])
  (:require [cljs.tools.reader.impl.errors :as err]
            [cljs.tools.reader.reader-types :refer
             [read-char unread peek-char indexing-reader?
              get-line-number get-column-number get-file-name string-push-back-reader]]
            [cljs.tools.reader.impl.utils :refer
             [char ex-info? whitespace? numeric? desugar-meta namespace-keys second' char-code]]
            [cljs.tools.reader.impl.commons :refer
             [number-literal? read-past match-number parse-symbol read-comment throwing-reader]]
            [cljs.tools.reader :refer [default-data-readers]]
            [goog.string :as gstring])
  (:import goog.string.StringBuffer))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(declare read macros dispatch-macros)

(defn- ^boolean macro-terminating? [ch]
  (and (not (identical? \# ch))
       (not (identical? \' ch))
       (not (identical? \: ch))
       (macros ch)))

(defn- ^boolean not-constituent? [ch]
  (or (identical? \@ ch)
      (identical? \` ch)
      (identical? \~ ch)))

(defn- read-token
  ([rdr kind initch]
     (read-token rdr kind initch true))
  ([rdr kind initch validate-leading?]
     (cond
      (not initch)
      (err/throw-eof-at-start rdr kind)

      (and validate-leading?
           (not-constituent? initch))
      (err/throw-bad-char rdr kind initch)

      :else
      (loop [sb (StringBuffer.)
             ch (do (unread rdr initch) initch)]
        (if (or (whitespace? ch)
                (macro-terminating? ch)
                (nil? ch))
          (str sb)
          (if (not-constituent? ch)
            (err/throw-bad-char rdr kind ch)
            (recur (doto sb (.append (read-char rdr))) (peek-char rdr))))))))

(declare read-tagged)

(defn- read-dispatch
  [rdr _ opts]
  (if-let [ch (read-char rdr)]
    (if-let [dm (dispatch-macros ch)]
      (dm rdr ch opts)
      (if-let [obj (read-tagged (doto rdr (unread ch)) ch opts)]
        obj
        (err/throw-no-dispatch rdr ch)))
    (err/throw-eof-at-dispatch rdr)))

(defn- read-unmatched-delimiter
  [rdr ch opts]
  (err/throw-unmatch-delimiter rdr ch))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; readers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- read-unicode-char
  ([token offset length base]
     (let [l (+ offset length)]
       (when-not (== (count token) l)
         (err/throw-invalid-unicode-literal nil token))
       (loop [i offset uc 0]
         (if (== i l)
           (js/String.fromCharCode uc)
           (let [d (char-code (nth token i) base)]
             (if (== d -1)
               (err/throw-invalid-unicode-digit-in-token nil (nth token i) token)
               (recur (inc i) (+ d (* uc base)))))))))

  ([rdr initch base length exact?]
     (loop [i 1 uc (char-code initch base)]
       (if (== uc -1)
         (err/throw-invalid-unicode-digit rdr initch)
         (if-not (== i length)
           (let [ch (peek-char rdr)]
             (if (or (whitespace? ch)
                     (macros ch)
                     (nil? ch))
               (if exact?
                 (err/throw-invalid-unicode-len rdr i length)
                 (js/String.fromCharCode uc))
               (let [d (char-code ch base)]
                 (read-char rdr)
                 (if (== d -1)
                   (err/throw-invalid-unicode-digit rdr ch)
                   (recur (inc i) (+ d (* uc base)))))))
           (js/String.fromCharCode uc))))))

(def ^:private ^:const upper-limit (.charCodeAt \uD7ff 0))
(def ^:private ^:const lower-limit (.charCodeAt \uE000 0))

(defn- read-char*
  [rdr backslash opts]
  (let [ch (read-char rdr)]
    (if-not (nil? ch)
      (let [token (if (or (macro-terminating? ch)
                          (not-constituent? ch)
                          (whitespace? ch))
                    (str ch)
                    (read-token rdr :character ch false))
            token-len (count token)]
        (cond

         (== 1 token-len)  (nth token 0)

         (identical? token "newline") \newline
         (identical? token "space") \space
         (identical? token "tab") \tab
         (identical? token "backspace") \backspace
         (identical? token "formfeed") \formfeed
         (identical? token "return") \return

         (gstring/startsWith token "u")
         (let [c (read-unicode-char token 1 4 16)
               ic (.charCodeAt c)]
           (if (and (> ic upper-limit)
                    (< ic lower-limit))
             (err/throw-invalid-character-literal rdr (.toString ic 16))
             c))

         (gstring/startsWith token "o")
         (let [len (dec token-len)]
           (if (> len 3)
             (err/throw-invalid-octal-len rdr token)
             (let [uc (read-unicode-char token 1 len 8)]
               (if (> (int uc) 0377)
                 (err/throw-bad-octal-number rdr)
                 uc))))

         :else (err/throw-unsupported-character rdr token)))
      (err/throw-eof-in-character rdr))))

(defn ^:private starting-line-col-info [rdr]
  (when (indexing-reader? rdr)
    [(get-line-number rdr) (int (dec (int (get-column-number rdr))))]))

(defn- read-delimited
  [kind delim rdr opts]
  (let [[start-line start-column] (starting-line-col-info rdr)
        delim (char delim)]
    (loop [a (transient [])]
      (let [ch (read-past whitespace? rdr)]
        (when-not ch
          (err/throw-eof-delimited rdr kind start-line start-column (count a)))
        (if (= delim (char ch))
          (persistent! a)
          (if-let [macrofn (macros ch)]
            (let [mret (macrofn rdr ch opts)]
              (recur (if-not (identical? mret rdr) (conj! a mret) a)))
            (let [o (read (doto rdr (unread ch)) true nil opts)]
              (recur (if-not (identical? o rdr) (conj! a o) a)))))))))

(defn- read-list
  [rdr _ opts]
  (let [the-list (read-delimited :list \) rdr opts)]
    (if (empty? the-list)
      '()
      (apply list the-list))))

(defn- read-vector
  [rdr _ opts]
  (read-delimited :vector \] rdr opts))


(defn- read-map
  [rdr _ opts]
  (let [[start-line start-column] (starting-line-col-info rdr)
        the-map (read-delimited :map \} rdr opts)
        map-count (count the-map)
        ks (take-nth 2 the-map)
        key-set (set ks)]
    (when (odd? map-count)
      (err/throw-odd-map rdr start-line start-column the-map))
    (when-not (= (count key-set) (count ks))
      (err/throw-dup-keys rdr :map ks))
    (if (<= map-count (* 2 (.-HASHMAP-THRESHOLD cljs.core/PersistentArrayMap)))
      (.fromArray cljs.core/PersistentArrayMap (to-array the-map) true true)
      (.fromArray cljs.core/PersistentHashMap (to-array the-map) true))))

(defn- read-number
  [rdr initch opts]
  (loop [sb (doto (StringBuffer.) (.append initch))
         ch (read-char rdr)]
    (if (or (whitespace? ch) (macros ch) (nil? ch))
      (let [s (str sb)]
        (unread rdr ch)
        (or (match-number s)
            (err/throw-invalid-number rdr s)))
      (recur (doto sb (.append ch)) (read-char rdr)))))

(defn- escape-char [sb rdr]
  (let [ch (read-char rdr)]
    (case ch
      \t "\t"
      \r "\r"
      \n "\n"
      \\ "\\"
      \" "\""
      \b "\b"
      \f "\f"
      \u (let [ch (read-char rdr)]
           (if (== -1 (js/parseInt (int ch) 16))
             (err/throw-invalid-unicode-escape rdr ch)
             (read-unicode-char rdr ch 16 4 true)))
      (if (numeric? ch)
        (let [ch (read-unicode-char rdr ch 8 3 false)]
          (if (> (int ch) 0377)
            (err/throw-bad-octal-number rdr)
            ch))
        (err/throw-bad-escape-char rdr ch)))))

(defn- read-string*
  [rdr _ opts]
  (loop [sb (StringBuffer.)
         ch (read-char rdr)]
    (case ch
      nil (err/throw-eof-reading rdr :string \" sb)
      \\ (recur (doto sb (.append (escape-char sb rdr)))
                (read-char rdr))
      \" (str sb)
      (recur (doto sb (.append ch)) (read-char rdr)))))

(defn- read-symbol
  [rdr initch]
  (when-let [token (read-token rdr :symbol initch)]
    (case token

      ;; special symbols
      "nil" nil
      "true" true
      "false" false
      "/" '/

      (or (when-let [p (parse-symbol token)]
            (symbol (p 0) (p 1)))
          (err/throw-invalid rdr :symbol token)))))

(defn- read-keyword
  [reader initch opts]
  (let [ch (read-char reader)]
    (if-not (whitespace? ch)
      (let [token (read-token reader :keyword ch)
            s (parse-symbol token)]
        (if (and s (== -1 (.indexOf token "::")))
          (let [ns (s 0)
                name (s 1)]
            (if (identical? \: (nth token 0))
              (err/throw-invalid reader :keyword token) ;; no ::keyword in edn
              (keyword ns name)))
          (err/throw-invalid reader :keyword token)))
      (err/throw-single-colon reader))))

(defn- wrapping-reader
  [sym]
  (fn [rdr _ opts]
    (list sym (read rdr true nil opts))))

(defn- read-meta
  [rdr _ opts]
  (let [m (desugar-meta (read rdr true nil opts))]
    (when-not (map? m)
      (err/throw-bad-metadata rdr m))
    (let [o (read rdr true nil opts)]
      (if (implements? IMeta o)
        (with-meta o (merge (meta o) m))
        (err/throw-bad-metadata-target rdr o)))))

(defn- read-set
  [rdr _ opts]
  (let [coll (read-delimited :set \} rdr opts)
        the-set (set coll)]
      (when-not (= (count coll) (count the-set))
        (err/throw-dup-keys rdr :set coll))
      the-set))

(defn- read-discard
  [rdr _ opts]
  (doto rdr
    (read true nil true)))

(defn- read-namespaced-map
  [rdr _ opts]
  (let [token (read-token rdr :namespaced-map (read-char rdr))]
    (if-let [ns (some-> token parse-symbol second')]
      (let [ch (read-past whitespace? rdr)]
        (if (identical? ch \{)
          (let [items (read-delimited :namespaced-map \} rdr opts)]
            (when (odd? (count items))
              (err/throw-odd-map rdr nil nil items))
            (let [keys (namespace-keys (str ns) (take-nth 2 items))
                  vals (take-nth 2 (rest items))]
              (when-not (= (count (set keys)) (count keys))
                (err/throw-dup-keys rdr :namespaced-map keys))
              (zipmap keys vals)))
          (err/throw-ns-map-no-map rdr token)))
      (err/throw-bad-ns rdr token))))

(defn- read-symbolic-value
  [rdr _ opts]
  (let [sym (read rdr true nil opts)]
    (case sym

      NaN js/Number.NaN
      -Inf js/Number.NEGATIVE_INFINITY
      Inf js/Number.POSITIVE_INFINITY

      (err/reader-error rdr (str "Invalid token: ##" sym)))))

(defn- macros [ch]
  (case ch
    \" read-string*
    \: read-keyword
    \; read-comment
    \^ read-meta
    \( read-list
    \) read-unmatched-delimiter
    \[ read-vector
    \] read-unmatched-delimiter
    \{ read-map
    \} read-unmatched-delimiter
    \\ read-char*
    \# read-dispatch
    nil))

(defn- dispatch-macros [ch]
  (case ch
    \^ read-meta                ;deprecated
    \{ read-set
    \< (throwing-reader "Unreadable form")
    \! read-comment
    \_ read-discard
    \: read-namespaced-map
    \# read-symbolic-value
    nil))

(defn- read-tagged [rdr initch opts]
  (let [tag (read rdr true nil opts)
        object (read rdr true nil opts)]
    (if-not (symbol? tag)
      (err/throw-bad-reader-tag rdr "Reader tag must be a symbol"))
    (if-let [f (or (get (:readers opts) tag)
                   (default-data-readers tag))]
      (f object)
      (if-let [d (:default opts)]
        (d tag object)
        (err/throw-unknown-reader-tag rdr tag)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn read
  "Reads the first object from an IPushbackReader.
   Returns the object read. If EOF, throws if eof-error? is true otherwise returns eof.
   If no reader is provided, *in* will be used.

   Reads data in the edn format (subset of Clojure data):
   http://edn-format.org

   clojure.tools.reader.edn/read doesn't depend on dynamic Vars, all configuration
   is done by passing an opt map.

   opts is a map that can include the following keys:
   :eof - value to return on end-of-file. When not supplied, eof throws an exception.
   :readers  - a map of tag symbols to data-reader functions to be considered before default-data-readers.
              When not supplied, only the default-data-readers will be used.
   :default - A function of two args, that will, if present and no reader is found for a tag,
              be called with the tag and the value."
  ([reader] (read {} reader))
  ([{:keys [eof] :as opts} reader]
     (let [eof-error? (not (contains? opts :eof))]
       (read reader eof-error? eof opts)))
  ([reader eof-error? eof opts]
     (try
       (loop []
         (let [ch (read-char reader)]
           (cond
            (whitespace? ch) (recur)
            (nil? ch) (if eof-error? (err/throw-eof-error reader nil) eof)
            (number-literal? reader ch) (read-number reader ch opts)
            :else (let [f (macros ch)]
                    (if f
                      (let [res (f reader ch opts)]
                        (if (identical? res reader)
                          (recur)
                          res))
                      (read-symbol reader ch))))))
       (catch js/Error e
         (if (ex-info? e)
           (let [d (ex-data e)]
             (if (= :reader-exception (:type d))
               (throw e)
               (throw (ex-info (.-message e)
                               (merge {:type :reader-exception}
                                      d
                                      (if (indexing-reader? reader)
                                        {:line   (get-line-number reader)
                                         :column (get-column-number reader)
                                         :file   (get-file-name reader)}))
                               e))))
           (throw (ex-info (.-message e)
                           (merge {:type :reader-exception}
                                  (if (indexing-reader? reader)
                                    {:line   (get-line-number reader)
                                     :column (get-column-number reader)
                                     :file   (get-file-name reader)}))
                           e)))))))

(defn read-string
  "Reads one object from the string s.
   Returns nil when s is nil or empty.

   Reads data in the edn format (subset of Clojure data):
   http://edn-format.org

   opts is a map as per clojure.tools.reader.edn/read"
  ([s] (read-string {:eof nil} s))
  ([opts s]
     (when (and s (not= s ""))
       (read opts (string-push-back-reader s)))))