Public Vars

Back

read (clj)

(source)

function

(read) (read stream) (read stream eof-error? eof-value) (read stream eof-error? eof-value recursive?) (read opts stream)
Reads the next object from stream, which must be an instance of java.io.PushbackReader or some derivee. stream defaults to the current value of *in*. Opts is a persistent map with valid keys: :read-cond - :allow to process reader conditionals, or :preserve to keep all branches :features - persistent set of feature keywords for reader conditionals :eof - on eof, return value unless :eofthrow, then throw. if not specified, will throw Note that read can execute code (controlled by *read-eval*), and as such should be used only with trusted sources. For data structure interop use clojure.edn/read

Examples

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

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

(defspec types-that-should-roundtrip
  roundtrip
  [^{:tag cgen/ednable} o]
  (when-not (= o %)
    (throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))

(defspec types-that-need-dup-to-roundtrip
  roundtrip-dup
  [^{:tag cgen/dup-readable} o]
  (when-not (= o %)
    (throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))

(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 test-read+string
  (let [[r s] (read+string (str->lnpr "[:foo  100]"))]
    (is (= [:foo 100] r))
    (is (= "[:foo  100]" s)))

  (let [[r s] (read+string {:read-cond :allow :features #{:y}} (str->lnpr "#?(:x :foo :y :bar)"))]
    (is (= :bar r))
    (is (= "#?(:x :foo :y :bar)" s))))

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

  (are [l c s] (= {:line l :column c} (-> s str->lnpr read meta (select-keys [:line :column])))
    42 99 "^{:line 42 :column 99} (1 2)"
    1 99 "^{:column 99} (1 2)")

  (eval (-> "^{:line 42 :column 99} (defn explicit-line-numbering [])" str->lnpr read))
  (is (= {:line 42 :column 99}
         (-> 'explicit-line-numbering resolve meta (select-keys [:line :column])))))
clojure
(ns clojure.test-clojure.server
    (:import java.util.Random)
    (:require [clojure.test :refer :all])
    (:require [clojure.core.server :as s]))

(defn create-random-thread
  []
  (Thread.
    (fn []
      (let [random (new Random)]
      (while (not (.isInterrupted (Thread/currentThread)))
        (System/setProperty (Integer/toString (.nextInt random)) (Integer/toString (.nextInt random))))))))

(deftest test-parse-props
  (let [thread (create-random-thread)]
    (.start thread)
    (Thread/sleep 1000)
    (try
      (is (>= (count
        (#'s/parse-props (System/getProperties))) 0))
      (finally (.interrupt thread)))))
clojure/core.async
;; The clojure.core.async namespace contains the public API.
(require '[clojure.core.async :as async :refer :all])

;; In ordinary threads, we use `>!!` (blocking put) and `<!!`
;; (blocking take) to communicate via channels.

;; Because these are blocking calls, if we try to put on an
;; unbuffered channel, we will block the main thread. We can use
;; `thread` (like `future`) to execute a body in a pool thread and
;; return a channel with the result. Here we launch a background task
;; to put "hello" on a channel, then read that value in the current thread.

(let [c (chan)]
  (thread (>!! c "hello"))
  (assert (= "hello" (<!! c)))
  (close! c))

;; The `go` macro asynchronously executes its body in a special pool
;; of threads. Channel operations that would block will pause
;; execution instead, blocking no threads. This mechanism encapsulates
;; the inversion of control that is external in event/callback
;; systems. Inside `go` blocks, we use `>!` (put) and `<!` (take).

;; Instead of the explicit thread and blocking call, we use a go block
;; for the producer. The consumer uses a go block to take, then
;; returns a result channel, from which we do a blocking take.

;; One killer feature for channels over queues is the ability to wait
;; on many channels at the same time (like a socket select). This is
;; done with `alts!!` (ordinary threads) or `alts!` in go blocks.

;; We can create a background thread with alts that combines inputs on
;; either of two channels. `alts!!` takes a set of operations
;; to perform - either a channel to take from or a [channel value] to put
;; and returns the value (nil for put) and channel that succeeded:

(let [c1 (chan)
      c2 (chan)]
  (thread (while true
            (let [[v ch] (alts!! [c1 c2])]
              (println "Read" v "from" ch))))
  (>!! c1 "hi")
  (>!! c2 "there"))

;; Since go blocks are lightweight processes not bound to threads, we
;; can have LOTS of them! Here we create 1000 go blocks that say hi on
;; 1000 channels. We use alts!! to read them as they're ready.
cognitect-labs/aws-api
(ns dynamodb-examples
  (:require [clojure.core.async :as a]
            [clojure.java.io :as io]
            [clojure.data.json :as json]
            [cognitect.aws.client.api :as aws]))

  (aws/invoke ddb
              {:op      :CreateTable
               :request {:TableName             "Thread"
                         :AttributeDefinitions  [{:AttributeName "ForumName"
                                                  :AttributeType "S"}
                                                 {:AttributeName "Subject"
                                                  :AttributeType "S"}]
                         :KeySchema             [{:AttributeName "ForumName"
                                                  :KeyType       "HASH"}
                                                 {:AttributeName "Subject"
                                                  :KeyType       "RANGE"}]
                         :ProvisionedThroughput {:ReadCapacityUnits  1
                                                 :WriteCapacityUnits 1}}})

  (->> ["Forum" "Reply" "Thread"]
       (map #(aws/invoke ddb {:op      :DescribeTable
                              :request {:TableName %}
                              :ch      (a/promise-chan (comp
                                                        (map :Table)
                                                        (map :TableStatus)))}))
       (into #{}))

  ;; when ^^ returns #{"ACTIVE"}, the tables are all ready

  (let [ ;; The aws-supplied example data are all json. We can use them
        ;; as/is, but we need keys defined the input specs to be
        ;; keywords if we want to validate the structure first!
        xform-specified-keys
        (fn [k]
          (get (reduce (fn [a v] (assoc a v (keyword v)))
                       {}
                       ["B" "BOOL" "BS" "Item" "L" "M" "N" "NS" "NULL" "PutRequest" "S" "SS"])
               k
               k))]
    (->> ["Forum.json"
          "Reply.json"
          "Thread.json"]
         (map #(-> (io/file "examples" "resources" "dynamodb" %)
                   slurp
                   (json/read-str :key-fn xform-specified-keys)))
         (map #(aws/invoke ddb {:op      :BatchWriteItem
                                :request {:RequestItems %}}))))

  (aws/invoke ddb
              {:op      :Query
               :request {:TableName                 "Reply"
                         :KeyConditionExpression    "Id = :id"
                         :ExpressionAttributeValues {":id" {:S "Amazon DynamoDB#DynamoDB Thread 1"}}}})

  (->> ["Forum" "Reply" "Thread"]
       (map #(aws/invoke ddb {:op      :DeleteTable
                              :request {:TableName %}}))
       (into []))
PrecursorApp/precursor
(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."})}

          :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."})}))
hraberg/deuce
(ns deuce.emacs.ccl
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

  If optional 4th arg CONTINUE is non-nil, keep IC on read operation
  when read buffer is exhausted, else, IC is always set to the end of
  CCL-PROGRAM on exit.
hraberg/deuce
(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]))

(defvar print-gensym nil
  "Non-nil means print uninterned symbols so they will read as uninterned.
  I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
  When the uninterned symbol appears within a recursive data structure,
  and the symbol appears more than once, in addition use the #N# and #N=
  constructs as needed, so that multiple references to the same symbol are
  shared once again when the text is read back.")

(defvar print-quoted nil
  "Non-nil means print quoted forms with reader syntax.
  I.e., (quote foo) prints as 'foo, (function foo) as #'foo.")

(defun print (object &optional printcharfun)
  "Output the printed representation of OBJECT, with newlines around it.
  Quoting characters are printed when needed to make output that `read'
  can handle, whenever this is possible.  For complex objects, the behavior
  is controlled by `print-level' and `print-length', which see.

(defun prin1-to-string (object &optional noescape)
  "Return a string containing the printed representation of OBJECT.
  OBJECT can be any Lisp object.  This function outputs quoting characters
  when necessary to make output that `read' can handle, whenever possible,
  unless the optional second argument NOESCAPE is non-nil.  For complex objects,
  the behavior is controlled by `print-level' and `print-length', which see.

(defun prin1 (object &optional printcharfun)
  "Output the printed representation of OBJECT, any Lisp object.
  Quoting characters are printed when needed to make output that `read'
  can handle, whenever this is possible.  For complex objects, the behavior
  is controlled by `print-level' and `print-length', which see.