some (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 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"}))))

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

(ns shadow.remote.runtime.cljs.js-builtins
  (:require
    [goog.object :as gobj]
    [clojure.core.protocols :as p]))

(extend-protocol p/Datafiable
  ;; FIXME: this is kind of a bad idea
  ;; can't do this for all objects, since none of the CLJS types implement this
  ;; protocol either. the protocol dispatch will end up using object
  ;; FIXME: this could detect CLJS types to some extent
  ;; or should it just implement the protocols for the types?
  object
  (datafy [o]
    (if-not (identical? (.-__proto__ o) js/Object.prototype)
      o
      (with-meta
        (->> (gobj/getKeys o)
             (reduce
               (fn [m key]
                 (assoc! m key (gobj/get o key)))
               (transient {}))
             (persistent!))

  js/Error
  (datafy [e]
    (let [data (ex-data e)
          file (.-fileName e)
          line (.-lineNumber e)
          column (.-columnNumber e)]
      (-> {:message (.-message e)
           :name (.-name e)
           :stack (.-stack e)}
          (cond->
            (some? data)
            (assoc :data data)

(ns example.handler
  "Asynchronous compojure-api application."
  (:require [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer :all]
            [manifold.deferred :as d]
            [clojure.core.async :as async]
            compojure.api.async))

(def app
  (api
   {:swagger
    {:ui "/"
     :spec "/swagger.json"
     :data {:info {:title "Simple"
                   :description "Compojure Api example"}
            :tags [{:name "api", :description "some apis"}]}}}

(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."})}

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

(defun upcase (obj)
  "Convert argument to upper case and return that.
  The argument may be a character or string.  The result has the same type.
  The argument object is not altered--the value is a copy.
  See also `capitalize', `downcase' and `upcase-initials'."
  (if ((some-fn char? integer?) obj)
    (int (Character/toUpperCase (int obj)))
    (s/upper-case obj)))

(defun downcase (obj)
  "Convert argument to lower case and return that.
  The argument may be a character or string.  The result has the same type.
  The argument object is not altered--the value is a copy."
  (if ((some-fn char? integer?) obj)
    (int (Character/toLowerCase (int obj)))
    (s/lower-case obj)))

(ns deuce.emacs.textprop
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

(defun next-char-property-change (position &optional limit)
  "Return the position of next text property or overlay change.
  This scans characters forward in the current buffer from POSITION till
  it finds a change in some text property, or the beginning or end of an
  overlay, and returns the position of that.
  If none is found up to (point-max), the function returns (point-max).

(defun remove-list-of-text-properties (start end list-of-properties &optional object)
  "Remove some properties from text from START to END.
  The third argument LIST-OF-PROPERTIES is a list of property names to remove.
  If the optional fourth argument OBJECT is a buffer (or nil, which means
  the current buffer), START and END are buffer positions (integers or
  markers).  If OBJECT is a string, START and END are 0-based indices into it.
  Return t if any property was actually removed, nil otherwise."
  )

(defun next-property-change (position &optional object limit)
  "Return the position of next property change.
  Scans characters forward from POSITION in OBJECT till it finds
  a change in some text property, then returns the position of the change.
  If the optional second argument OBJECT is a buffer (or nil, which means
  the current buffer), POSITION is a buffer position (integer or marker).
  If OBJECT is a string, POSITION is a 0-based index into it.
  Return nil if the property is constant all the way to the end of OBJECT.
  If the value is non-nil, it is a position greater than POSITION, never equal.

(defun previous-char-property-change (position &optional limit)
  "Return the position of previous text property or overlay change.
  Scans characters backward in the current buffer from POSITION till it
  finds a change in some text property, or the beginning or end of an
  overlay, and returns the position of that.
  If none is found since (point-min), the function returns (point-min).

(defun remove-text-properties (start end properties &optional object)
  "Remove some properties from text from START to END.
  The third argument PROPERTIES is a property list
  whose property names specify the properties to remove.
  (The values stored in PROPERTIES are ignored.)
  If the optional fourth argument OBJECT is a buffer (or nil, which means
  the current buffer), START and END are buffer positions (integers or
  markers).  If OBJECT is a string, START and END are 0-based indices into it.
  Return t if any property was actually removed, nil otherwise.

(defun previous-property-change (position &optional object limit)
  "Return the position of previous property change.
  Scans characters backwards from POSITION in OBJECT till it finds
  a change in some text property, then returns the position of the change.
  If the optional second argument OBJECT is a buffer (or nil, which means
  the current buffer), POSITION is a buffer position (integer or marker).
  If OBJECT is a string, POSITION is a 0-based index into it.
  Return nil if the property is constant all the way to the start of OBJECT.
  If the value is non-nil, it is a position less than POSITION, never equal.