read-string (clj)

(ns clojure.test-clojure.reader
  (:use clojure.test)
  (:use [clojure.instant :only [read-instant-date
                                read-instant-calendar
                                read-instant-timestamp]])
  (:require clojure.walk
            [clojure.edn :as edn]
            [clojure.test.generative :refer (defspec)]
            [clojure.test-clojure.generators :as cgen]
            [clojure.edn :as edn])
  (:import [clojure.lang BigInt Ratio]
           java.io.File
           java.util.TimeZone))

(defn read-from
  [source file form]
  (if (= :string source)
    (read-string form)
    (do
      (spit file form)
      (load-file (str file)))))

(deftest reading-keywords
  (are [x y] (= x (binding [*ns* (the-ns 'user)] (read-string y)))
       :foo ":foo"
       :foo/bar ":foo/bar"
       :user/foo "::foo")
  (are [err msg form] (thrown-with-msg? err msg (read-string form))
       Exception #"Invalid token: foo:" "foo:"
       Exception #"Invalid token: :bar/" ":bar/"
       Exception #"Invalid token: ::does.not/exist" "::does.not/exist"))
;; Lists

(deftest Instants
  (testing "Instants are read as java.util.Date by default"
    (is (= java.util.Date (class #inst "2010-11-12T13:14:15.666"))))
  (let [s "#inst \"2010-11-12T13:14:15.666-06:00\""]
    (binding [*data-readers* {'inst read-instant-date}]
      (testing "read-instant-date produces java.util.Date"
        (is (= java.util.Date (class (read-string s)))))
      (testing "java.util.Date instants round-trips"
        (is (= (-> s read-string)
               (-> s read-string pr-str read-string))))
      (testing "java.util.Date instants round-trip throughout the year"
        (doseq [month (range 1 13) day (range 1 29) hour (range 1 23)]
          (let [s (format "#inst \"2010-%02d-%02dT%02d:14:15.666-06:00\"" month day hour)]
            (is (= (-> s read-string)
                   (-> s read-string pr-str read-string))))))
      (testing "java.util.Date handling DST in time zones"
        (let [dtz (TimeZone/getDefault)]
          (try
            ;; A timezone with DST in effect during 2010-11-12
            (TimeZone/setDefault (TimeZone/getTimeZone "Australia/Sydney"))
            (is (= (-> s read-string)
                   (-> s read-string pr-str read-string)))
            (finally (TimeZone/setDefault dtz)))))
      (testing "java.util.Date should always print in UTC"
        (let [d (read-string s)
              pstr (print-str d)
              len (.length pstr)]
          (is (= (subs pstr (- len 7)) "-00:00\"")))))
    (binding [*data-readers* {'inst read-instant-calendar}]
      (testing "read-instant-calendar produces java.util.Calendar"
        (is (instance? java.util.Calendar (read-string s))))
      (testing "java.util.Calendar round-trips"
        (is (= (-> s read-string)
               (-> s read-string pr-str read-string))))
      (testing "java.util.Calendar remembers timezone in literal"
        (is (= "#inst \"2010-11-12T13:14:15.666-06:00\""
               (-> s read-string pr-str)))
        (is (= (-> s read-string)
               (-> s read-string pr-str read-string))))
      (testing "java.util.Calendar preserves milliseconds"
        (is (= 666 (-> s read-string
                       (.get java.util.Calendar/MILLISECOND)))))))
  (let [s "#inst \"2010-11-12T13:14:15.123456789\""
        s2 "#inst \"2010-11-12T13:14:15.123\""
        s3 "#inst \"2010-11-12T13:14:15.123456789123\""]
    (binding [*data-readers* {'inst read-instant-timestamp}]
      (testing "read-instant-timestamp produces java.sql.Timestamp"
        (is (= java.sql.Timestamp (class (read-string s)))))
      (testing "java.sql.Timestamp preserves nanoseconds"
        (is (= 123456789 (-> s read-string .getNanos)))
        (is (= 123456789 (-> s read-string pr-str read-string .getNanos)))
        ;; truncate at nanos for s3
        (is (= 123456789 (-> s3 read-string pr-str read-string .getNanos))))
      (testing "java.sql.Timestamp should compare nanos"
        (is (= (read-string s) (read-string s3)))
        (is (not= (read-string s) (read-string s2)))))
    (binding [*data-readers* {'inst read-instant-date}]
      (testing "read-instant-date should truncate at milliseconds"
        (is (= (read-string s) (read-string s2) (read-string s3))))))
  (let [s "#inst \"2010-11-12T03:14:15.123+05:00\""
        s2 "#inst \"2010-11-11T22:14:15.123Z\""]
    (binding [*data-readers* {'inst read-instant-date}]
      (testing "read-instant-date should convert to UTC"
        (is (= (read-string s) (read-string s2)))))
    (binding [*data-readers* {'inst read-instant-timestamp}]
      (testing "read-instant-timestamp should convert to UTC"
        (is (= (read-string s) (read-string s2)))))
    (binding [*data-readers* {'inst read-instant-calendar}]
      (testing "read-instant-calendar should preserve timezone"
        (is (not= (read-string s) (read-string s2)))))))

(deftest unknown-tag
  (let [my-unknown (fn [tag val] {:unknown-tag tag :value val})
        throw-on-unknown (fn [tag val] (throw (RuntimeException. (str "No data reader function for tag " tag))))
        my-uuid (partial my-unknown 'uuid)
        u "#uuid \"550e8400-e29b-41d4-a716-446655440000\""
        s "#never.heard.of/some-tag [1 2]" ]
    (binding [*data-readers* {'uuid my-uuid}
              *default-data-reader-fn* my-unknown]
      (testing "Unknown tag"
        (is (= (read-string s)
               {:unknown-tag 'never.heard.of/some-tag
                :value [1 2]})))
      (testing "Override uuid tag"
        (is (= (read-string u)
               {:unknown-tag 'uuid
                :value "550e8400-e29b-41d4-a716-446655440000"}))))

    (binding [*default-data-reader-fn* throw-on-unknown]
      (testing "Unknown tag with custom throw-on-unknown"
        (are [err msg form] (thrown-with-msg? err msg (read-string form))
             Exception #"No data reader function for tag foo" "#foo [1 2]"
             Exception #"No data reader function for tag bar/foo" "#bar/foo [1 2]"
             Exception #"No data reader function for tag bar.baz/foo" "#bar.baz/foo [1 2]")))

    (testing "Unknown tag out-of-the-box behavior (like Clojure 1.4)"
      (are [err msg form] (thrown-with-msg? err msg (read-string form))
           Exception #"No reader function for tag foo" "#foo [1 2]"
           Exception #"No reader function for tag bar/foo" "#bar/foo [1 2]"
           Exception #"No reader function for tag bar.baz/foo" "#bar.baz/foo [1 2]"))))


(defn roundtrip
  "Print an object and read it back. Returns rather than throws
   any exceptions."
  [o]
  (binding [*print-length* nil
            *print-dup* nil
            *print-level* nil]
    (try
     (-> o pr-str read-string)
     (catch Throwable t t))))

(defn roundtrip-dup
  "Print an object with print-dup and read it back.
   Returns rather than throws any exceptions."
  [o]
  (binding [*print-length* nil
            *print-dup* true
            *print-level* nil]
    (try
     (-> o pr-str read-string)
     (catch Throwable t t))))

(deftest preserve-read-cond-test
  (let [x (read-string {:read-cond :preserve} "#?(:clj foo :cljs bar)" )]
       (is (reader-conditional? x))
       (is (not (:splicing? x)))
       (is (= :foo (get x :no-such-key :foo)))
       (is (= (:form x) '(:clj foo :cljs bar)))
       (is (= x (reader-conditional '(:clj foo :cljs bar) false))))
  (let [x (read-string {:read-cond :preserve} "#?@(:clj [foo])" )]
       (is (reader-conditional? x))
       (is (:splicing? x))
       (is (= :foo (get x :no-such-key :foo)))
       (is (= (:form x) '(:clj [foo])))
       (is (= x (reader-conditional '(:clj [foo]) true))))
  (is (thrown-with-msg? RuntimeException #"No reader function for tag"
                        (read-string {:read-cond :preserve} "#js {:x 1 :y 2}" )))
  (let [x (read-string {:read-cond :preserve} "#?(:cljs #js {:x 1 :y 2})")
        [platform tl] (:form x)]
       (is (reader-conditional? x))
       (is (tagged-literal? tl))
       (is (= 'js (:tag tl)))
       (is (= {:x 1 :y 2} (:form tl)))
       (is (= :foo (get tl :no-such-key :foo)))
       (is (= tl (tagged-literal 'js {:x 1 :y 2}))))
  (testing "print form roundtrips"
           (doseq [s ["#?(:clj foo :cljs bar)"
                      "#?(:cljs #js {:x 1, :y 2})"
                      "#?(:clj #clojure.test_clojure.reader.TestRecord [42 85])"]]
                  (is (= s (pr-str (read-string {:read-cond :preserve} s)))))))

(deftest reader-conditionals
  (testing "basic read-cond"
    (is (= '[foo-form]
           (read-string {:read-cond :allow :features #{:foo}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[bar-form]
           (read-string {:read-cond :allow :features #{:bar}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[foo-form]
           (read-string {:read-cond :allow :features #{:foo :bar}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[]
           (read-string {:read-cond :allow :features #{:baz}} "[#?( :foo foo-form :bar bar-form)]"))))
  (testing "environmental features"
    (is (= "clojure" #?(:clj "clojure" :cljs "clojurescript" :default "default"))))
  (testing "default features"
    (is (= "default" #?(:clj-clr "clr" :cljs "cljs" :default "default"))))
  (testing "splicing"
    (is (= [] [#?@(:clj [])]))
    (is (= [:a] [#?@(:clj [:a])]))
    (is (= [:a :b] [#?@(:clj [:a :b])]))
    (is (= [:a :b :c] [#?@(:clj [:a :b :c])]))
    (is (= [:a :b :c] [#?@(:clj [:a :b :c])])))
  (testing "nested splicing"
    (is (= [:a :b :c :d :e]
           [#?@(:clj [:a #?@(:clj [:b #?@(:clj [:c]) :d]):e])]))
    (is (= '(+ 1 (+ 2 3))
           '(+ #?@(:clj [1 (+ #?@(:clj [2 3]))]))))
    (is (= '(+ (+ 2 3) 1)
           '(+ #?@(:clj [(+ #?@(:clj [2 3])) 1]))))
    (is (= [:a [:b [:c] :d] :e]
           [#?@(:clj [:a [#?@(:clj [:b #?@(:clj [[:c]]) :d])] :e])])))
  (testing "bypass unknown tagged literals"
    (is (= [1 2 3] #?(:cljs #js [1 2 3] :clj [1 2 3])))
    (is (= :clojure #?(:foo #some.nonexistent.Record {:x 1} :clj :clojure))))
  (testing "error cases"
    (is (thrown-with-msg? RuntimeException #"Feature should be a keyword" (read-string {:read-cond :allow} "#?((+ 1 2) :a)")))
    (is (thrown-with-msg? RuntimeException #"even number of forms" (read-string {:read-cond :allow} "#?(:cljs :a :clj)")))
    (is (thrown-with-msg? RuntimeException #"read-cond-splicing must implement" (read-string {:read-cond :allow} "#?@(:clj :a)")))
    (is (thrown-with-msg? RuntimeException #"is reserved" (read-string {:read-cond :allow} "#?@(:foo :a :else :b)")))
    (is (thrown-with-msg? RuntimeException #"must be a list" (read-string {:read-cond :allow} "#?[:foo :a :else :b]")))
    (is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string {:read-cond :BOGUS} "#?[:clj :a :default nil]")))
    (is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string "#?[:clj :a :default nil]")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1 2])")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1])")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj []) 1"))))
  (testing "clj-1698-regression"
    (let [opts {:features #{:clj} :read-cond :allow}]
      (is (= 1 (read-string opts "#?(:cljs {'a 1 'b 2} :clj 1)")))
      (is (= 1 (read-string opts "#?(:cljs (let [{{b :b} :a {d :d} :c} {}]) :clj 1)")))
      (is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj  ^{:a :b} {}))")))
      (is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj ^{:a :b} {}))")))
      (is (= 1 (read-string opts "#?(:cljs {:a #_:b :c} :clj 1)")))))
  (testing "nil expressions"
    (is (nil? #?(:default nil)))
    (is (nil? #?(:foo :bar :clj nil)))
    (is (nil? #?(:clj nil :foo :bar)))
    (is (nil? #?(:foo :bar :default nil)))))

(deftest eof-option
  (is (= 23 (read-string {:eof 23} "")))
  (is (= 23 (read {:eof 23} (clojure.lang.LineNumberingPushbackReader.
                             (java.io.StringReader. ""))))))

(require '[clojure.string :as s])
(deftest namespaced-maps
  (is (= #:a{1 nil, :b nil, :b/c nil, :_/d nil}
         #:a {1 nil, :b nil, :b/c nil, :_/d nil}
         {1 nil, :a/b nil, :b/c nil, :d nil}))
  (is (= #::{1 nil, :a nil, :a/b nil, :_/d nil}
         #::  {1 nil, :a nil, :a/b nil, :_/d nil}
         {1 nil, :clojure.test-clojure.reader/a nil, :a/b nil, :d nil} ))
  (is (= #::s{1 nil, :a nil, :a/b nil, :_/d nil}
         #::s  {1 nil, :a nil, :a/b nil, :_/d nil}
         {1 nil, :clojure.string/a nil, :a/b nil, :d nil}))
  (is (= (read-string "#:a{b 1 b/c 2}") {'a/b 1, 'b/c 2}))
  (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::{b 1, b/c 2, _/d 3}")) {'clojure.test-clojure.reader/b 1, 'b/c 2, 'd 3}))
  (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3})))

(deftest namespaced-map-errors
  (are [err msg form] (thrown-with-msg? err msg (read-string form))
                      Exception #"Invalid token" "#:::"
                      Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}"
                      Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}"
                      Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}"
                      Exception #"Namespaced map must specify a namespace" "#: s{:a 1}"
                      Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}"
                      Exception #"Duplicate key: user/a" "#::{a 1 a 2}"))

(deftest namespaced-map-edn
  (is (= {1 1, :a/b 2, :b/c 3, :d 4}
         (edn/read-string "#:a{1 1, :b 2, :b/c 3, :_/d 4}")
         (edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}"))))

(deftest invalid-symbol-value
  (is (thrown-with-msg? Exception #"Invalid token" (read-string "##5")))
  (is (thrown-with-msg? Exception #"Invalid token" (edn/read-string "##5")))
  (is (thrown-with-msg? Exception #"Unknown symbolic value" (read-string "##Foo")))
  (is (thrown-with-msg? Exception #"Unknown symbolic value" (edn/read-string "##Foo"))))

(deftest t-Explicit-line-column-numbers
  (is (= {:line 42 :column 99}
         (-> "^{:line 42 :column 99} (1 2)" read-string meta (select-keys [:line :column]))))

(ns clojure.test-clojure.edn
  (:require [clojure.test.generative :refer (defspec)]
            [clojure.test-clojure.generators :as cgen]
            [clojure.edn :as edn]))

(defn roundtrip
  "Print an object and read it back as edn. Returns rather than throws
   any exceptions."
  [o]
  (binding [*print-length* nil
            *print-dup* nil
            *print-level* nil]
    (try
     (-> o pr-str edn/read-string)
     (catch Throwable t t))))

(require '[clojure.edn :as edn]
         '[clojure.string :as str])

(def edn (edn/read-string (slurp "deps.edn")))

(require '[selmer.parser :as p])
(require '[clojure.java.io :as io])
(require '[clojure.string :as str])
(require '[clojure.edn :as edn])

(def versions (edn/read-string (slurp "script/versions.edn")))

(def deps-edn (edn/read-string (slurp "deps.edn")))

(ns contrib.datomic-cloud-contrib
  (:require clojure.edn
            [hyperfiddle.rcf :refer [tests]])
  (:import [goog.math Long]))

(tests
  (cljs.reader/read-string "#goog.math/Long \"9007199254740996\"")
  :throws js/Error ; No reader function for tag long.

  (def x (cljs.reader/read-string {:readers {'goog.math/Long goog.math.Long/fromString}} "#goog.math/Long \"9007199254740996\""))
  x := (goog.math.Long/fromString "9007199254740996")

  "you can inject something like this over a region (to avoid global state)"
  ; yes we know bindings are pretty busted in clojure, but it beats mutable global state
  (def ^:dynamic *read-str* nil)
  (binding [*read-str* (partial cljs.reader/read-string {:readers {'goog.math/Long goog.math.Long/fromString}})]
    (*read-str* "#goog.math/Long \"9007199254740996\"")) := x)

(tests
  "edn reader"
  (cljs.reader/read-string "#goog.math/Long \"9007199254740996\"")
  :throws js/Error ; No reader function for tag long.

  (clojure.edn/read-string {:readers {'goog.math/Long goog.math.Long/fromString}} "#goog.math/Long \"9007199254740996\"")
  := x

  (def ^:dynamic *read-str* nil)
  (binding [*read-str* (partial clojure.edn/read-string {:readers {'goog.math/Long goog.math.Long/fromString}})]
    (*read-str* "#goog.math/Long \"9007199254740996\"")) := x)

(ns example
  (:require
   ["chalk$default" :as chalk]
   [another-namespace :as another]
   [from-classpath :as fc]
   [goog.string :as gstring]
   [promesa.core :as p]
   [clojure.edn :as edn]
   [utils :as u]))

(log (chalk/blue "hello"))
(prn (fc/from-classpath))
(prn (another/cool-fn))
(prn (gstring/format "Awesome formatted: (%s)" "Yes!"))
(p/-> (p/delay 1000 (u/util-fn))
      prn)
(prn (edn/read-string "[1 2 3]"))

(ns nbb.macros
  (:refer-clojure :exclude [time])
  (:require
   [clojure.data.json :as json]
   [clojure.edn :as edn]))

(defmacro feature-requires []
  (let [;; all nbb_features.edn files on the classpath:
        configs (enumeration-seq
                 (.getResources (.getContextClassLoader (Thread/currentThread))
                                "nbb_features.edn"))
        m (->> configs
               (mapcat (comp edn/read-string slurp str))
               (mapcat (fn [{:keys [namespaces js]}]
                         (mapv (fn [n] [n js]) namespaces)))
               (into '{promesa.core "./nbb_promesa.js"
                       applied-science.js-interop "./nbb_js_interop.js"
                       cljs-bean.core "./nbb_cljs_bean.js"
                       cljs.pprint "./nbb_pprint.js"
                       clojure.pprint "./nbb_pprint.js"
                       cljs.test "./nbb_test.js"
                       clojure.test "./nbb_test.js"
                       nbb.repl "./nbb_repl.js"
                       clojure.tools.cli "./nbb_tools_cli.js"
                       goog.string "./nbb_goog_string.js"
                       goog.string.format "./nbb_goog_string.js"
                       goog.crypt "./nbb_goog_crypt.js"
                       cognitect.transit "./nbb_transit.js"
                       clojure.data "./nbb_data.js"
                       cljs.math "./nbb_math.js"
                       clojure.math "./nbb_math.js"
                       clojure.zip "./nbb_zip.js"
                       nbb.nrepl-server "./nbb_nrepl_server.js"}))]
    (list 'quote m)))