pr-str (clj)

(deftest division
  (is (= clojure.core// /))
  (binding [*ns* *ns*]
    (eval '(do (ns foo
                 (:require [clojure.core :as bar])
                 (:use [clojure.test]))
               (is (= clojure.core// bar//))))))

(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)))))))


(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)))))))

#_:clj-kondo/ignore
(ns app.common.data.macros
  "Data retrieval & manipulation specific macros."
  (:refer-clojure :exclude [get-in select-keys str with-open min max])
  #?(:cljs (:require-macros [app.common.data.macros]))
  (:require
   #?(:clj [clojure.core :as c]
      :cljs [cljs.core :as c])
   [app.common.data :as d]
   [cljs.analyzer.api :as aapi]
   [cuerdas.core :as str]))

                :else
                (str "expr assert: " (pr-str expr)))]
     (when *assert*
       `(binding [*assert-context* ~hint]
          (when-not ~expr
            (let [hint#   ~hint
                  params# {:type :assertion
                           :code :expr-validation
                           :hint hint#}]
              (throw (ex-info hint# params#)))))))))

                :else
                (str "expr assert: " (pr-str expr)))]
     `(binding [*assert-context* ~hint]
        (when-not ~expr
          (let [hint#   ~hint
                params# {:type :assertion
                         :code :expr-validation
                         :hint hint#}]
            (throw (ex-info hint# params#))))))))

(ns pc.http.routes.api
  (:require [cemerick.url :as url]
            [cheshire.core :as json]
            [clojure.core.memoize :as memo]
            [clojure.string :as str]
            [clojure.tools.reader.edn :as edn]
            [crypto.equality :as crypto]
            [defpage.core :as defpage :refer (defpage)]
            [pc.auth :as auth]
            [pc.crm :as crm]
            [pc.datomic :as pcd]
            [pc.early-access]
            [pc.http.doc :as doc-http]
            [pc.http.team :as team-http]
            [pc.http.handlers.custom-domain :as custom-domain]
            [pc.models.chat-bot :as chat-bot-model]
            [pc.models.doc :as doc-model]
            [pc.models.flag :as flag-model]
            [pc.models.team :as team-model]
            [pc.profile :as profile]
            [ring.middleware.anti-forgery :as csrf]
            [slingshot.slingshot :refer (try+ throw+)]))

(defpage new [:post "/api/v1/document/new"] [req]
  (let [params (some-> req :body slurp edn/read-string)
        read-only? (:read-only params)
        doc-name (:document/name params)]
    (if-not (:subdomain req)
      (let [cust-uuid (get-in req [:auth :cust :cust/uuid])
            intro-layers? (:intro-layers? params)
            doc (doc-model/create-public-doc!
                 (merge {:document/chat-bot (rand-nth chat-bot-model/chat-bots)}
                        (when cust-uuid {:document/creator cust-uuid})
                        (when read-only? {:document/privacy :document.privacy/read-only})
                        (when doc-name {:document/name doc-name})))]
        (when intro-layers?
          (doc-http/add-intro-layers doc))
        {:status 200 :body (pr-str {:document (doc-model/read-api doc)})})
      (if (and (:team req)
               (auth/logged-in? req)
               (auth/has-team-permission? (pcd/default-db) (:team req) (:auth req) :admin))
        (let [doc (doc-model/create-team-doc!
                   (:team req)
                   (merge {:document/chat-bot (rand-nth chat-bot-model/chat-bots)}
                          (when-let [cust-uuid (get-in req [:cust :cust/uuid])]
                            {:document/creator cust-uuid})
                          (when read-only?
                            {:document/privacy :document.privacy/read-only})
                          (when doc-name
                            {:document/name doc-name})))]
          {:status 200 :body (pr-str {:document (doc-model/read-api doc)})})
        {:status 400 :body (pr-str {:error :unauthorized-to-team
                                    :redirect-url (str (url/map->URL {:host (profile/hostname)
                                                                      :protocol (if (profile/force-ssl?)
                                                                                  "https"
                                                                                  (name (:scheme req)))
                                                                      :port (if (profile/force-ssl?)
                                                                              (profile/https-port)
                                                                              (profile/http-port))
                                                                      :path "/new"
                                                                      :query (:query-string req)}))
                                    :msg "You're unauthorized to make documents in this subdomain. Please request access."})}))))

(defpage create-team [:post "/api/v1/create-team"] [req]
  (let [params (some-> req :body slurp edn/read-string)
        subdomain (some-> params :subdomain str/lower-case str/trim)
        coupon-code (some-> params :coupon-code)
        cust (get-in req [:auth :cust])]
    (cond (empty? cust)
          {:status 400 :body (pr-str {:error :not-logged-in
                                      :msg "You must log in first."})}

          (empty? subdomain)
          {:status 400 :body (pr-str {:error :missing-subdomain
                                      :msg "Subdomain is missing."})}

          (not (custom-domain/valid-subdomain? subdomain))
          {:status 400 :body (pr-str {:error :subdomain-exists
                                      :msg "Sorry, that subdomain is taken. Please try another."})}

          (seq (team-model/find-by-subdomain (pcd/default-db) subdomain))
          {:status 400 :body (pr-str {:error :subdomain-exists
                                      :msg "Sorry, that subdomain is taken. Please try another."})}

          :else
          (try+
           (let [team (team-http/setup-new-team subdomain cust coupon-code)]
             {:status 200 :body (pr-str {:team (team-model/read-api team)})})
           (catch [:error :subdomain-exists] e
             {:status 400 :body (pr-str {:error :subdomain-exists
                                         :msg "Sorry, that subdomain is taken. Please try another."})})))))

(defpage early-access [:post "/api/v1/early-access"] [req]
  (if-let [cust (get-in req [:auth :cust])]
    (do
      (pc.early-access/create-request cust (edn/read-string (slurp (:body req))))
      (pc.early-access/approve-request cust)
      {:status 200 :body (pr-str {:msg "Thanks!" :access-request-granted? true})})
    {:status 401 :body (pr-str {:error :not-logged-in
                                :msg "Please log in to request early access."})}))

(defpage create-solo-trial [:post "/api/v1/create-solo-trial"] [req]
  (if-let [cust (get-in req [:auth :cust])]
    (do
      (flag-model/add-flag cust :flags/private-docs)
      {:status 200 :body (pr-str {:msg "Thanks!" :solo-plan-created? true})})
    {:status 401 :body (pr-str {:error :not-logged-in
                                :msg "Please log in to request early access."})}))

(ns deuce.emacs.print
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.fns :as fns])
  (:refer-clojure :exclude [print]))

(defun error-message-string (obj)
  "Convert an error value (ERROR-SYMBOL . DATA) to an error message.
  See Info anchor `(elisp)Definition of signal' for some details on how this
  error message is constructed."
  (let [error-symbol (data/car obj)
        data (data/cdr obj)]
    (str (or (fns/get error-symbol 'error-message)
             (s/capitalize (s/join " " (s/split (str error-symbol) #"-"))))
         (when (and (data/listp data) (not (nil? data)))
           (str ": " (s/join ", " (map pr-str data)))))))

  A pqrinted representation of an object is text which describes that object."
  (pr-str object))

(ns typed.clojure.jvm
  "JVM-specific annotations and operations.
  See typed.clojure for cross-platform ops."
  (:require clojure.core.typed
            [clojure.core.typed.current-impl :as impl]
            [clojure.core.typed.internal :refer [take-when]]
            [typed.cljc.runtime.env-utils :refer [delay-type]]
            [clojure.core.typed.macros :as macros]))

(defmacro override-class [& args]
  (let [[binder args] (take-when vector? args)
        [nme args] (take-when symbol? args)
        _ (assert (symbol? nme) (str "Missing name in override-class" [nme args]))
        [opts args] (take-when map? args)
        opts (if opts
               (do (assert (empty? args) (str "Trailing args to override-class: " (pr-str args)))
                   opts)
               (apply hash-map args))
        this-ns (ns-name *ns*)]
    `(clojure.core.typed/tc-ignore
       (let [nme# (or (when-some [^Class c# (ns-resolve '~this-ns '~nme)]
                        (when (class? c#)
                          (-> c# .getName symbol)))
                      (throw (ex-info (str "Could not resolve class: " '~nme) {:class-name '~nme})))]
          ;; TODO runtime env
         #_
         (impl/add-rclass-env nme# {:op :RClass})
         ;; type env
         ;inline when-bindable-defining-ns
         (macros/when-bindable-defining-ns '~this-ns
           (impl/with-clojure-impl
             (impl/add-rclass nme# (delay-type
                                     ((requiring-resolve 'typed.clj.checker.parse-unparse/with-parse-ns*)
                                      '~this-ns
                                      #((requiring-resolve 'typed.cljc.checker.base-env-helper/make-RClass)
                                        nme#
                                        '~binder
                                        '~opts))))))))))

(ns json-ld
  (:require [fluree.db.method.ipfs.core :as ipfs]
            [fluree.db.db.json-ld :as jld-db]
            [fluree.db.json-ld.transact :as jld-tx]
            [clojure.core.async :as async]
            [fluree.db.flake :as flake]
            [fluree.db.json-ld.api :as fluree]
            [fluree.db.util.async :refer [<?? go-try channel?]]
            [fluree.db.query.range :as query-range]
            [fluree.db.constants :as const]
            [fluree.db.dbproto :as dbproto]
            [fluree.db.did :as did]
            [fluree.db.conn.proto :as conn-proto]
            [fluree.db.util.json :as json]
            [fluree.json-ld :as json-ld]
            [fluree.db.util.log :as log]))

  (-> (fluree/connect-ipfs
        {:server nil         ;; use default
         :ipns {:key "self"} ;; publish to ipns by default using the provided key/profile
         :context {"id" "@id"
                   "type" "@type"
                   "schema" "http://schema.org/"
                   "rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
                   "rdfs" "http://www.w3.org/2000/01/rdf-schema#"
                   "wiki" "https://www.wikidata.org/wiki/"
                   "skos" "http://www.w3.org/2008/05/skos#"
                   "f" "https://ns.flur.ee/ledger#"}
         :did (did/private->did-map "8ce4eca704d653dec594703c81a84c403c39f262e54ed014ed857438933a2e1c")})
      (.then (fn [conn]
               (println "conn" (pr-str conn))
               (-> (fluree/create conn "test/dan1")
                   (.then (fn [ledger]
                            (println "ledger" (pr-str ledger))
                            (-> (fluree/query (fluree/db ledger)
                                              {:select {'?s [:* {:f/role [:*]}]}
                                               :where [['?s :type :f/DID]]})
                                (.then (fn [q0] (println "q0" q0))))

                            (-> (fluree/stage
                                  ledger
                                  {"@context" "https://schema.org",
                                   "@id" "https://www.wikidata.org/wiki/Q836821",
                                   "@type" ["Movie"],
                                   "name" "The Hitchhiker's Guide to the Galaxy",
                                   "disambiguatingDescription" "2005 British-American comic science fiction film directed by Garth Jennings",
                                   "titleEIDR" "10.5240/B752-5B47-DBBE-E5D4-5A3F-N",
                                   "isBasedOn" {"@id" "https://www.wikidata.org/wiki/Q3107329",
                                                "@type" "Book",
                                                "name" "The Hitchhiker's Guide to the Galaxy",
                                                "isbn" "0-330-25864-8",
                                                "author" {"@id" "https://www.wikidata.org/wiki/Q42"
                                                          "@type" "Person"
                                                          "name" "Douglas Adams"}}})
                                (.then (fn [ledger]
                                         (fluree/query ledger
                                                       {:select [:* {:schema/isBasedOn [:*]}]
                                                        :from :wiki/Q836821})))
                                (.then (fn [q1] (println "q1" (pr-str q1)))))

                            #_ (fluree/commit! ledger {:message "Another commit!!"
                                                       :push? false})))
                   #_(.catch (fn [err] (println "ERR" (pr-str err))))))))