;; Copyright (c) 2014-2015, Andrey Antukh <niwi@niwi.be>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are met:
;;
;; * Redistributions of source code must retain the above copyright notice, this
;;   list of conditions and the following disclaimer.
;;
;; * Redistributions in binary form must reproduce the above copyright notice,
;;   this list of conditions and the following disclaimer in the documentation
;;   and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns suricatta.core
  "High level sql toolkit for Clojure"
  (:require [suricatta.types :as types]
            [suricatta.proto :as proto]
            [suricatta.impl :as impl]
            jdbc.core
            jdbc.proto)
  (:import org.jooq.DSLContext
           org.jooq.SQLDialect
           org.jooq.TransactionContext
           org.jooq.TransactionProvider
           org.jooq.exception.DataAccessException;
           org.jooq.impl.DefaultTransactionContext
           org.jooq.Configuration
           org.jooq.impl.DefaultConfiguration
           org.jooq.tools.jdbc.JDBCUtils
           java.sql.Connection))

(defn context
  "Context constructor."
  ([dbspec] (context dbspec {}))
  ([dbspec opts]
   (let [^Connection connection (-> (jdbc.core/connection dbspec opts)
                                    (jdbc.proto/connection))
         ^SQLDialect dialect (if (:dialect dbspec)
                               (impl/translate-dialect (:dialect dbspec))
                               (JDBCUtils/dialect connection))
         ^Configuration conf (doto (DefaultConfiguration.)
                               (.set dialect)
                               (.set connection))]
      (types/->context conf))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SQL Executor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn execute
  "Execute a query and return a number of rows affected."
  ([q] (proto/execute q nil))
  ([ctx q] (proto/execute q ctx)))

(defn fetch
  "Fetch eagerly results executing a query.

  This function returns a vector of records (default) or
  rows (depending on specified opts). Resources are relased
  inmediatelly without specific explicit action for it."
  ([q] (proto/fetch q nil {}))
  ([ctx q] (proto/fetch q ctx {}))
  ([ctx q opts] (proto/fetch q ctx opts)))

(def fetch-one (comp first fetch))

(defn query
  "Mark a query for reuse the prepared statement.

  This function should be used with precaution and
  close method should be called when query is not
  longer needed. In almost all cases you should not
  need use this function."
  [ctx querylike]
  (proto/query querylike ctx))

(defn fetch-lazy
  "Fetch lazily results executing a query.

  This function returns a cursor instead of result.
  You should explicitly close the cursor at the end of
  iteration for release resources."
  ([ctx q] (proto/fetch-lazy q ctx {}))
  ([ctx q opts] (proto/fetch-lazy q ctx {})))

(defn cursor->lazyseq
  "Transform a cursor in a lazyseq.

  The returned lazyseq will return values until a cursor
  is closed or all values are fetched."
  ([cursor] (impl/cursor->lazyseq cursor {}))
  ([cursor opts] (impl/cursor->lazyseq cursor opts)))

(defn load-into
  "Load data into a table. Supports csv and json formats."
  ([ctx tablename data] (load-into ctx tablename data {}))
  ([ctx tablename data opts]
   (impl/load-into ctx tablename data opts)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- transaction-context
  [^Configuration conf]
  (let [transaction (atom nil)
        cause       (atom nil)]
    (reify org.jooq.TransactionContext
      (configuration [_] conf)
      ;; jOOQ 3.5.x
      ;; (settings [_] (.settings conf))
      ;; (dialect [_] (.dialect conf))
      ;; (family [_] (.family (.dialect conf)))
      (transaction [_] @transaction)
      (transaction [self t] (reset! transaction t) self)
      (cause [_] @cause)
      (cause [self c] (reset! cause c) self))))

(defn atomic-apply
  "Execute a function in one transaction
  or subtransaction."
  [ctx func & args]
  (let [^Configuration conf (.derive (proto/get-configuration ctx))
        ^TransactionContext txctx (transaction-context conf)
        ^TransactionProvider provider (.transactionProvider conf)]
    (doto conf
      (.data "suricatta.rollback" false)
      (.data "suricatta.transaction" true))
    (try
      (.begin provider txctx)
      (let [result (apply func (types/->context conf) args)
            rollback? (.data conf "suricatta.rollback")]
        (if rollback?
          (.rollback provider txctx)
          (.commit provider txctx))
        result)
      (catch Exception cause
        (.rollback provider (.cause txctx cause))
        (if (instance? RuntimeException cause)
          (throw cause)
          (throw (DataAccessException. "Rollback caused" cause)))))))

(defmacro atomic
  "Convenience macro for execute a computation
  in a transaction or subtransaction."
  [ctx & body]
  `(atomic-apply ~ctx (fn [~ctx] ~@body)))

(defn set-rollback!
  "Mark current transaction for rollback.

  This function is not safe and it not aborts
  the execution of current function, it only
  marks the current transaction for rollback."
  [ctx]
  (let [^Configuration conf (proto/get-configuration ctx)]
    (.data conf "suricatta.rollback" true)
    ctx))

;; Copyright (c) 2014-2015, Andrey Antukh <niwi@niwi.nz>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are met:
;;
;; * Redistributions of source code must retain the above copyright notice, this
;;   list of conditions and the following disclaimer.
;;
;; * Redistributions in binary form must reproduce the above copyright notice,
;;   this list of conditions and the following disclaimer in the documentation
;;   and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns suricatta.core
  "High level sql toolkit for Clojure"
  (:require [suricatta.types :as types]
            [suricatta.proto :as proto]
            [suricatta.impl :as impl]
            jdbc.core
            jdbc.proto)
  (:import org.jooq.DSLContext
           org.jooq.SQLDialect
           org.jooq.TransactionContext
           org.jooq.TransactionProvider
           org.jooq.exception.DataAccessException;
           org.jooq.impl.DefaultTransactionContext
           org.jooq.Configuration
           org.jooq.impl.DefaultConfiguration
           org.jooq.tools.jdbc.JDBCUtils
           java.sql.Connection))

(defn context
  "Context constructor."
  ([dbspec] (context dbspec {}))
  ([dbspec opts]
   (let [^Connection connection (-> (jdbc.core/connection dbspec opts)
                                    (jdbc.proto/connection))
         ^SQLDialect dialect (if (:dialect dbspec)
                               (impl/translate-dialect (:dialect dbspec))
                               (JDBCUtils/dialect connection))
         ^Configuration conf (doto (DefaultConfiguration.)
                               (.set dialect)
                               (.set connection))]
      (types/->context conf))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SQL Executor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn execute
  "Execute a query and return a number of rows affected."
  ([q] (proto/execute q nil))
  ([ctx q] (proto/execute q ctx)))

(defn fetch
  "Fetch eagerly results executing a query.

  This function returns a vector of records (default) or
  rows (depending on specified opts). Resources are relased
  inmediatelly without specific explicit action for it."
  ([q] (proto/fetch q nil {}))
  ([ctx q] (proto/fetch q ctx {}))
  ([ctx q opts] (proto/fetch q ctx opts)))

(def fetch-one (comp first fetch))

(defn query
  "Mark a query for reuse the prepared statement.

  This function should be used with precaution and
  close method should be called when query is not
  longer needed. In almost all cases you should not
  need use this function."
  [ctx querylike]
  (proto/query querylike ctx))

(defn fetch-lazy
  "Fetch lazily results executing a query.

  This function returns a cursor instead of result.
  You should explicitly close the cursor at the end of
  iteration for release resources."
  ([ctx q] (proto/fetch-lazy q ctx {}))
  ([ctx q opts] (proto/fetch-lazy q ctx {})))

(defn cursor->lazyseq
  "Transform a cursor in a lazyseq.

  The returned lazyseq will return values until a cursor
  is closed or all values are fetched."
  ([cursor] (impl/cursor->lazyseq cursor {}))
  ([cursor opts] (impl/cursor->lazyseq cursor opts)))

(defn load-into
  "Load data into a table. Supports csv and json formats."
  ([ctx tablename data] (load-into ctx tablename data {}))
  ([ctx tablename data opts]
   (impl/load-into ctx tablename data opts)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- transaction-context
  [^Configuration conf]
  (let [transaction (atom nil)
        cause       (atom nil)]
    (reify org.jooq.TransactionContext
      (configuration [_] conf)
      ;; jOOQ 3.5.x
      ;; (settings [_] (.settings conf))
      ;; (dialect [_] (.dialect conf))
      ;; (family [_] (.family (.dialect conf)))
      (transaction [_] @transaction)
      (transaction [self t] (reset! transaction t) self)
      (cause [_] @cause)
      (cause [self c] (reset! cause c) self))))

(defn atomic-apply
  "Execute a function in one transaction
  or subtransaction."
  [ctx func & args]
  (let [^Configuration conf (.derive (proto/get-configuration ctx))
        ^TransactionContext txctx (transaction-context conf)
        ^TransactionProvider provider (.transactionProvider conf)]
    (doto conf
      (.data "suricatta.rollback" false)
      (.data "suricatta.transaction" true))
    (try
      (.begin provider txctx)
      (let [result (apply func (types/->context conf) args)
            rollback? (.data conf "suricatta.rollback")]
        (if rollback?
          (.rollback provider txctx)
          (.commit provider txctx))
        result)
      (catch Exception cause
        (.rollback provider (.cause txctx cause))
        (if (instance? RuntimeException cause)
          (throw cause)
          (throw (DataAccessException. "Rollback caused" cause)))))))

(defmacro atomic
  "Convenience macro for execute a computation
  in a transaction or subtransaction."
  [ctx & body]
  `(atomic-apply ~ctx (fn [~ctx] ~@body)))

(defn set-rollback!
  "Mark current transaction for rollback.

  This function is not safe and it not aborts
  the execution of current function, it only
  marks the current transaction for rollback."
  [ctx]
  (let [^Configuration conf (proto/get-configuration ctx)]
    (.data conf "suricatta.rollback" true)
    ctx))

Change copyright email on core ns.

Change copyright email on core ns.


(ns push-ups.utils
  (:use [clojure.string :only (join)]))

(defn domain
  "Get domain of app"
  ([]
   (or (System/getenv "URL")
       "http://localhost:3000"))
  ([& pathcomponents]
     (join "/" (cons (domain) pathcomponents))))

(ns push-ups.utils
  (:use [clojure.string :only (join)]))

(defn domain
  "Get domain of app"
  ([]
   (or (System/getenv "HOST")
       "http://localhost:3000"))
  ([& pathcomponents]
     (join "/" (cons (domain) pathcomponents))))

use HOST env vars

use HOST env vars


;; Copyright (c) 2012-2014 Michael S. Klishin, Alex Petrov, and the ClojureWerkz Team
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns clojurewerkz.cassaforte.cql
  "Main namespace for working with CQL, prepared statements. Convenience functions
   for key operations built on top of CQL."
  (:refer-clojure :exclude [update])
  (:require [clojurewerkz.cassaforte.query  :as q]
            [qbits.hayt.cql                 :as hayt]
            [clojurewerkz.cassaforte.client :as cc])
  (:import com.datastax.driver.core.Session))

(defn ^:private compile-query-
  "Compiles query from given `builder` and `query-params`"
  [query-params builder]
  (apply builder (flatten query-params)))

(defn ^:private render-query-
  "Renders compiled query"
  [query-params]
  (let [renderer (if hayt/*prepared-statement*
                   hayt/->prepared
                   hayt/->raw)]
    (renderer query-params)))

(defn ^:private execute-
  [^Session session query-params builder]
  (let [rendered-query (render-query- (compile-query- query-params builder))]
    (cc/execute rendered-query session)
    ))

(defn ^:private execute-async-
  [^Session session query-params builder]
  (comment ;;; doesnt work yet
    (let [rendered-query (render-query- (compile-query- query-params builder))]
      (cc/execute-async rendered-query session))))

;;
;; Schema operations
;;

(defn drop-keyspace
  "Drops a keyspace: results in immediate, irreversible removal of an existing keyspace,
   including all column families in it, and all data contained in those column families."
  [^Session session ks & query-params]
  (execute- session (cons ks query-params) q/drop-keyspace-query))

(defn create-keyspace
  "Creates a new top-level keyspace. A keyspace is a namespace that
   defines a replication strategy and some options for a set of tables,
   similar to a database in relational databases.

   Example:

     (create-keyspace conn :new_cql_keyspace
                   (with {:replication
                          {:class \"SimpleStrategy\"
                           :replication_factor 1}}))"
  [^Session session & query-params]
  (execute- session query-params q/create-keyspace-query))

(defn create-index
  "Creates a new (automatic) secondary index for a given (existing)
   column in a given table.If data already exists for the column, it will be indexed during the execution
   of this statement. After the index is created, new data for the column is indexed automatically at
   insertion time.

   Example, creates an index on `users` table, `city` column:

      (create-index conn :users :city
                    (index-name :users_city)
                    (if-not-exists))"
  [^Session session & query-params]
  (execute- session query-params q/create-index-query))

(defn drop-index
  "Drop an existing secondary index. The argument of the statement
   is the index name.

   Example, drops an index on `users` table, `city` column:

       (drop-index th/session :users_city)"
  [^Session session & query-params]
  (execute- session query-params q/drop-index-query))

(defn create-table
  "Creates a new table. A table is a set of rows (usually
   representing related entities) for which it defines a number of properties.

   A table is defined by a name, it defines the columns composing rows
   of the table and have a number of options.

   Example:

     (create-table :users
                (column-definitions {:name :varchar
                                     :age  :int
                                     :city :varchar
                                     :primary-key [:name]}))"
  [^Session session & query-params]
  (execute- session query-params q/create-table-query))

(def create-column-family create-table)

(defn drop-table
  "Drops a table: this results in the immediate, irreversible removal of a table, including
   all data in it."
  [^Session session ks]
  (execute- session [ks] q/drop-table-query))

(defn use-keyspace
  "Takes an existing keyspace name as argument and set it as the per-session current working keyspace.
   All subsequent keyspace-specific actions will be performed in the context of the selected keyspace,
   unless otherwise specified, until another USE statement is issued or the connection terminates."
  [^Session session ks]
  (execute- session [ks] q/use-keyspace-query))

(defn alter-table
  "Alters a table definition. Use it to add new
   columns, drop existing ones, change the type of existing columns, or update the table options."
  [^Session session & query-params]
  (execute- session query-params q/alter-table-query))

(defn alter-keyspace
  "Alters properties of an existing keyspace. The
   supported properties are the same that for `create-keyspace`"
  [^Session session & query-params]
  (execute- session query-params q/alter-keyspace-query))

;;
;; DB Operations
;;

(defn insert
  "Inserts a row in a table.

   Note that since a row is identified by its primary key, the columns that compose it must be
   specified. Also, since a row only exists when it contains one value for a column not part of
   the primary key, one such value must be specified too."
  [^Session session & query-params]
  (execute- session query-params q/insert-query))

(defn insert-async
  "Same as insert but returns a future"
  [^Session session & query-params]
  (execute-async- session query-params q/insert-query))

(defn ^{:private true} batch-query-from
  [table records]
  (->> records
       (map (comp (partial apply (partial q/insert-query table)) flatten vector))
       (apply q/queries)
       q/batch-query
       render-query-))

(defn insert-batch
  "Performs a batch insert (inserts multiple records into a table at the same time).
  To specify additional clauses for a record (such as where or using), wrap that record
  and the clauses in a vector"
  [^Session session table records]
  (let [query (batch-query-from table records)]
    (execute- session query)))

(defn insert-batch-async
  "Same as insert-batch but returns a future"
  [^Session session table records]
  (let [query (batch-query-from table records)]
    (execute-async- session query)))

(defn atomic-batch
  "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
  [^Session session & clauses]
  (let [q (render-query- (compile-query- clauses q/batch-query))]
    (execute- session q)))

(defn update
  "Updates one or more columns for a given row in a table. The `where` clause
   is used to select the row to update and must include all columns composing the PRIMARY KEY.
   Other columns values are specified through assignment within the `set` clause."
  [^Session session & query-params]
  (execute- session query-params q/update-query))

(defn update-async
  "Same as update but returns a future"
  [^Session session & query-params]
  (execute-async- session query-params q/update-query))

(defn delete
  "Deletes columns and rows. If the `columns` clause is provided,
   only those columns are deleted from the row indicated by the `where` clause, please refer to
   doc guide (http://clojurecassandra.info/articles/kv.html) for more details. Otherwise whole rows
   are removed. The `where` allows to specify the key for the row(s) to delete. First argument
   for this function should always be table name."
  [^Session session table & query-params]
  (execute- session (cons table query-params) q/delete-query))

(defn delete-async
  "Same as delete but returns a future"
  [^Session session table & query-params]
  (execute-async- session (cons table query-params) q/delete-query))

(defn select
  "Retrieves one or more columns for one or more rows in a table.
   It returns a result set, where every row is a collection of columns returned by the query."
  [^Session session & query-params]
  (execute- session query-params q/select-query))

(defn select-async
  "Same as select but returns a future"
  [^Session session & query-params]
  (execute-async- session query-params q/select-query))

(defn truncate
  "Truncates a table: permanently and irreversably removes all rows from the table,
   not removing the table itself."
  [^Session session table]
  (execute- session [table] q/truncate-query))

(defn create-user
  [^Session session & query-params]
  (execute- session query-params q/create-user-query))

(defn alter-user
  [^Session session & query-params]
  (execute- session query-params q/alter-user-query))

(defn drop-user
  [^Session session & query-params]
  (execute- session query-params q/drop-user-query))

(defn grant
  [^Session session & query-params]
  (execute- session query-params q/grant-query))

(defn revoke
  [^Session session & query-params]
  (execute- session query-params q/revoke-query))

(defn list-users
  [^Session session & query-params]
  (execute- session query-params q/list-users-query))

(defn list-permissions
  [^Session session & query-params]
  (execute- session query-params q/list-perm-query))

;;
;; Higher level DB functions
;;

(defn get-one
  "Executes query to get exactly one result. Does not add `limit` clause to the query, this is
   a convenience function only. Please use `limit` clause if you execute queries that potentially
   return more than a single result."
  [^Session session & query-params]
  (first (execute- session query-params q/select-query)))

(defn perform-count
  "Helper function to perform count on a table with given query. Count queries are slow in Cassandra,
   in order to get a rough idea of how many items you have in certain table, use `nodetool cfstats`,
   for more complex cases, you can wither do a full table scan or perform a count with this function,
   please note that it does not have any performance guarantees and is potentially expensive."
  [^Session session table & query-params]
  (:count
   (first
    (select session table
            (cons
             (q/columns (q/count*))
             query-params)))))

;;
;; Higher-level helper functions for schema
;;

(defn describe-keyspace
  "Returns a keyspace description, taken from `system.schema_keyspaces`."
  [^Session session ks]
  (first
   (select session :system.schema_keyspaces
           (q/where {:keyspace_name (name ks)}))))

(defn describe-table
  "Returns a table description, taken from `system.schema_columnfamilies`."
  [^Session session ks table]
  (first
   (select session :system.schema_columnfamilies
           (q/where {:keyspace_name (name ks)
                     :columnfamily_name (name table)}))))

(defn describe-columns
  "Returns table columns description, taken from `system.schema_columns`."
  [^Session session ks table]
  (select session :system.schema_columns
          (q/where {:keyspace_name (name ks)
                    :columnfamily_name (name table)})))

;;
;; Higher-level collection manipulation
;;

(defn- load-chunk
  "Returns next chunk for the lazy table iteration"
  [^Session session table partition-key chunk-size last-pk]
  (if (nil? (first last-pk))
    (select session table
            (q/limit chunk-size))
    (select session table
            (q/where [[> (apply q/token partition-key) (apply q/token last-pk)]])
            (q/limit chunk-size))))

(defn iterate-table
  "Lazily iterates through a table, returning chunks of chunk-size."
  ([^Session session table partition-key chunk-size]
     (iterate-table session table (if (sequential? partition-key)
                                    partition-key
                                    [partition-key])
                    chunk-size []))
  ([^Session session table partition-key chunk-size c]
     (lazy-cat c
               (let [last-pk    (map #(get (last c) %) partition-key)
                     next-chunk (load-chunk session table partition-key chunk-size last-pk)]
                 (if (empty? next-chunk)
                   []
                   (iterate-table session table partition-key chunk-size next-chunk))))))

;; Copyright (c) 2012-2014 Michael S. Klishin, Alex Petrov, and the ClojureWerkz Team
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns clojurewerkz.cassaforte.cql
  "Main namespace for working with CQL, prepared statements. Convenience functions
   for key operations built on top of CQL."
  (:refer-clojure :exclude [update])
  (:require [clojurewerkz.cassaforte.query  :as q]
            [qbits.hayt.cql                 :as hayt]
            [clojurewerkz.cassaforte.client :as cc])
  (:import com.datastax.driver.core.Session))

(defn ^:private compile-query-
  "Compiles query from given `builder` and `query-params`"
  [query-params builder]
  (apply builder (flatten query-params)))

(defn ^:private execute-
  [^Session session query-params builder]
  (let [compiled-query (compile-query- query-params builder)]
    (cc/execute session compiled-query)
    ))

(defn ^:private execute-async-
  [^Session session query-params builder]
  (comment ;;; doesnt work yet
    (let [rendered-query (render-query- (compile-query- query-params builder))]
      (cc/execute-async rendered-query session))))

;;
;; Schema operations
;;

(defn drop-keyspace
  "Drops a keyspace: results in immediate, irreversible removal of an existing keyspace,
   including all column families in it, and all data contained in those column families."
  [^Session session ks & query-params]
  (execute- session (cons ks query-params) q/drop-keyspace-query))

(defn create-keyspace
  "Creates a new top-level keyspace. A keyspace is a namespace that
   defines a replication strategy and some options for a set of tables,
   similar to a database in relational databases.

   Example:

     (create-keyspace conn :new_cql_keyspace
                   (with {:replication
                          {:class \"SimpleStrategy\"
                           :replication_factor 1}}))"
  [^Session session & query-params]
  (execute- session query-params q/create-keyspace-query))

(defn create-index
  "Creates a new (automatic) secondary index for a given (existing)
   column in a given table.If data already exists for the column, it will be indexed during the execution
   of this statement. After the index is created, new data for the column is indexed automatically at
   insertion time.

   Example, creates an index on `users` table, `city` column:

      (create-index conn :users :city
                    (index-name :users_city)
                    (if-not-exists))"
  [^Session session & query-params]
  (execute- session query-params q/create-index-query))

(defn drop-index
  "Drop an existing secondary index. The argument of the statement
   is the index name.

   Example, drops an index on `users` table, `city` column:

       (drop-index th/session :users_city)"
  [^Session session & query-params]
  (execute- session query-params q/drop-index-query))

(defn create-table
  "Creates a new table. A table is a set of rows (usually
   representing related entities) for which it defines a number of properties.

   A table is defined by a name, it defines the columns composing rows
   of the table and have a number of options.

   Example:

     (create-table :users
                (column-definitions {:name :varchar
                                     :age  :int
                                     :city :varchar
                                     :primary-key [:name]}))"
  [^Session session & query-params]
  (execute- session query-params q/create-table-query))

(def create-column-family create-table)

(defn drop-table
  "Drops a table: this results in the immediate, irreversible removal of a table, including
   all data in it."
  [^Session session ks]
  (execute- session [ks] q/drop-table-query))

(defn use-keyspace
  "Takes an existing keyspace name as argument and set it as the per-session current working keyspace.
   All subsequent keyspace-specific actions will be performed in the context of the selected keyspace,
   unless otherwise specified, until another USE statement is issued or the connection terminates."
  [^Session session ks]
  (execute- session [ks] q/use-keyspace-query))

(defn alter-table
  "Alters a table definition. Use it to add new
   columns, drop existing ones, change the type of existing columns, or update the table options."
  [^Session session & query-params]
  (execute- session query-params q/alter-table-query))

(defn alter-keyspace
  "Alters properties of an existing keyspace. The
   supported properties are the same that for `create-keyspace`"
  [^Session session & query-params]
  (execute- session query-params q/alter-keyspace-query))

;;
;; DB Operations
;;

(defn insert
  "Inserts a row in a table.

   Note that since a row is identified by its primary key, the columns that compose it must be
   specified. Also, since a row only exists when it contains one value for a column not part of
   the primary key, one such value must be specified too."
  [^Session session & query-params]
  (execute- session query-params q/insert-query))

(defn insert-async
  "Same as insert but returns a future"
  [^Session session & query-params]
  (execute-async- session query-params q/insert-query))

(defn ^{:private true} batch-query-from
  [table records]
  (->> records
       (map (comp (partial apply (partial q/insert-query table)) flatten vector))
       (apply q/queries)
       q/batch-query))

(defn insert-batch
  "Performs a batch insert (inserts multiple records into a table at the same time).
  To specify additional clauses for a record (such as where or using), wrap that record
  and the clauses in a vector"
  [^Session session table records]
  (let [query (batch-query-from table records)]
    (execute- session query)))

(defn insert-batch-async
  "Same as insert-batch but returns a future"
  [^Session session table records]
  (let [query (batch-query-from table records)]
    (execute-async- session query)))

(defn atomic-batch
  "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
  [^Session session & clauses]
  (let [q (compile-query- clauses q/batch-query)]
    (execute- session q)))

(defn update
  "Updates one or more columns for a given row in a table. The `where` clause
   is used to select the row to update and must include all columns composing the PRIMARY KEY.
   Other columns values are specified through assignment within the `set` clause."
  [^Session session & query-params]
  (execute- session query-params q/update-query))

(defn update-async
  "Same as update but returns a future"
  [^Session session & query-params]
  (execute-async- session query-params q/update-query))

(defn delete
  "Deletes columns and rows. If the `columns` clause is provided,
   only those columns are deleted from the row indicated by the `where` clause, please refer to
   doc guide (http://clojurecassandra.info/articles/kv.html) for more details. Otherwise whole rows
   are removed. The `where` allows to specify the key for the row(s) to delete. First argument
   for this function should always be table name."
  [^Session session table & query-params]
  (execute- session (cons table query-params) q/delete-query))

(defn delete-async
  "Same as delete but returns a future"
  [^Session session table & query-params]
  (execute-async- session (cons table query-params) q/delete-query))

(defn select
  "Retrieves one or more columns for one or more rows in a table.
   It returns a result set, where every row is a collection of columns returned by the query."
  [^Session session & query-params]
  (execute- session query-params q/select-query))

(defn select-async
  "Same as select but returns a future"
  [^Session session & query-params]
  (execute-async- session query-params q/select-query))

(defn truncate
  "Truncates a table: permanently and irreversably removes all rows from the table,
   not removing the table itself."
  [^Session session table]
  (execute- session [table] q/truncate-query))

(defn create-user
  [^Session session & query-params]
  (execute- session query-params q/create-user-query))

(defn alter-user
  [^Session session & query-params]
  (execute- session query-params q/alter-user-query))

(defn drop-user
  [^Session session & query-params]
  (execute- session query-params q/drop-user-query))

(defn grant
  [^Session session & query-params]
  (execute- session query-params q/grant-query))

(defn revoke
  [^Session session & query-params]
  (execute- session query-params q/revoke-query))

(defn list-users
  [^Session session & query-params]
  (execute- session query-params q/list-users-query))

(defn list-permissions
  [^Session session & query-params]
  (execute- session query-params q/list-perm-query))

;;
;; Higher level DB functions
;;

(defn get-one
  "Executes query to get exactly one result. Does not add `limit` clause to the query, this is
   a convenience function only. Please use `limit` clause if you execute queries that potentially
   return more than a single result."
  [^Session session & query-params]
  (first (execute- session query-params q/select-query)))

(defn perform-count
  "Helper function to perform count on a table with given query. Count queries are slow in Cassandra,
   in order to get a rough idea of how many items you have in certain table, use `nodetool cfstats`,
   for more complex cases, you can wither do a full table scan or perform a count with this function,
   please note that it does not have any performance guarantees and is potentially expensive."
  [^Session session table & query-params]
  (:count
   (first
    (select session table
            (cons
             (q/columns (q/count*))
             query-params)))))

;;
;; Higher-level helper functions for schema
;;

(defn describe-keyspace
  "Returns a keyspace description, taken from `system.schema_keyspaces`."
  [^Session session ks]
  (first
   (select session :system.schema_keyspaces
           (q/where {:keyspace_name (name ks)}))))

(defn describe-table
  "Returns a table description, taken from `system.schema_columnfamilies`."
  [^Session session ks table]
  (first
   (select session :system.schema_columnfamilies
           (q/where {:keyspace_name (name ks)
                     :columnfamily_name (name table)}))))

(defn describe-columns
  "Returns table columns description, taken from `system.schema_columns`."
  [^Session session ks table]
  (select session :system.schema_columns
          (q/where {:keyspace_name (name ks)
                    :columnfamily_name (name table)})))

;;
;; Higher-level collection manipulation
;;

(defn- load-chunk
  "Returns next chunk for the lazy table iteration"
  [^Session session table partition-key chunk-size last-pk]
  (if (nil? (first last-pk))
    (select session table
            (q/limit chunk-size))
    (select session table
            (q/where [[> (apply q/token partition-key) (apply q/token last-pk)]])
            (q/limit chunk-size))))

(defn iterate-table
  "Lazily iterates through a table, returning chunks of chunk-size."
  ([^Session session table partition-key chunk-size]
     (iterate-table session table (if (sequential? partition-key)
                                    partition-key
                                    [partition-key])
                    chunk-size []))
  ([^Session session table partition-key chunk-size c]
     (lazy-cat c
               (let [last-pk    (map #(get (last c) %) partition-key)
                     next-chunk (load-chunk session table partition-key chunk-size last-pk)]
                 (if (empty? next-chunk)
                   []
                   (iterate-table session table partition-key chunk-size next-chunk))))))

Move rendering to client

Move rendering to client


;; Copyright (c) 2012-2014 Michael S. Klishin, Alex Petrov, and the ClojureWerkz Team
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns clojurewerkz.cassaforte.cql
  "Main namespace for working with CQL, prepared statements. Convenience functions
   for key operations built on top of CQL."
  (:refer-clojure :exclude [update])
  (:require [clojurewerkz.cassaforte.query  :as q]
            [qbits.hayt.cql                 :as hayt]
            [clojurewerkz.cassaforte.client :as cc])
  (:import com.datastax.driver.core.Session))

(defn ^:private compile-query-
  "Compiles query from given `builder` and `query-params`"
  [builder query-params]
  ;; TODO: mapcat identity here?
  (apply builder (flatten query-params)))

;;
;; Schema operations
;;

(defn drop-keyspace
  "Drops a keyspace: results in immediate, irreversible removal of an existing keyspace,
   including all column families in it, and all data contained in those column families."
  [^Session session ks & query-params]
  (cc/execute session
              (compile-query- q/drop-keyspace-query (cons ks query-params))))

(defn create-keyspace
  "Creates a new top-level keyspace. A keyspace is a namespace that
   defines a replication strategy and some options for a set of tables,
   similar to a database in relational databases.

   Example:

     (create-keyspace conn :new_cql_keyspace
                   (with {:replication
                          {:class \"SimpleStrategy\"
                           :replication_factor 1}}))"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-keyspace-query query-params)))

(defn create-index
  "Creates a new (automatic) secondary index for a given (existing)
   column in a given table.If data already exists for the column, it will be indexed during the execution
   of this statement. After the index is created, new data for the column is indexed automatically at
   insertion time.

   Example, creates an index on `users` table, `city` column:

      (create-index conn :users :city
                    (index-name :users_city)
                    (if-not-exists))"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-index-query query-params )))

(defn drop-index
  "Drop an existing secondary index. The argument of the statement
   is the index name.

   Example, drops an index on `users` table, `city` column:

       (drop-index th/session :users_city)"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/drop-index-query query-params) ))

(defn create-table
  "Creates a new table. A table is a set of rows (usually
   representing related entities) for which it defines a number of properties.

   A table is defined by a name, it defines the columns composing rows
   of the table and have a number of options.

   Example:

     (create-table :users
                (column-definitions {:name :varchar
                                     :age  :int
                                     :city :varchar
                                     :primary-key [:name]}))"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-table-query query-params)))

(def create-column-family create-table)

(defn drop-table
  "Drops a table: this results in the immediate, irreversible removal of a table, including
   all data in it."
  [^Session session ks]
  (cc/execute session
              (q/drop-table-query ks)))

(defn use-keyspace
  "Takes an existing keyspace name as argument and set it as the per-session current working keyspace.
   All subsequent keyspace-specific actions will be performed in the context of the selected keyspace,
   unless otherwise specified, until another USE statement is issued or the connection terminates."
  [^Session session ks]
  (cc/execute session
              (q/use-keyspace-query ks)))

(defn alter-table
  "Alters a table definition. Use it to add new
   columns, drop existing ones, change the type of existing columns, or update the table options."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/alter-table-query query-params)))

(defn alter-keyspace
  "Alters properties of an existing keyspace. The
   supported properties are the same that for `create-keyspace`"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/alter-keyspace-query query-params)))

;;
;; DB Operations
;;

(defn insert
  "Inserts a row in a table.

   Note that since a row is identified by its primary key, the columns that compose it must be
   specified. Also, since a row only exists when it contains one value for a column not part of
   the primary key, one such value must be specified too."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/insert-query query-params)))

(defn insert-async
  "Same as insert but returns a future"
  [^Session session & query-params]
  (comment
    (cc/executeasync- session query-params q/insert-query)))

(defn ^:private batch-query-from-
  [table records]
  (->> records
       (map (comp (partial apply (partial q/insert-query table)) flatten vector))
       (apply q/queries)
       ))

(defn insert-batch
  "Performs a batch insert (inserts multiple records into a table at the same time).
  To specify additional clauses for a record (such as where or using), wrap that record
  and the clauses in a vector"
  [^Session session table records]
  (let [query-params (batch-query-from- table records)]
    (cc/execute session (q/batch-query query-params))))

(defn insert-batch-async
  "Same as insert-batch but returns a future"
  [^Session session table records]
  (let [query (batch-query-from- table records)]
    (comment
      (cc/executeasync- session query))))

(defn atomic-batch
  "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
  [^Session session & clauses]
  (cc/execute session
              (compile-query- q/batch-query clauses)))

(defn update
  "Updates one or more columns for a given row in a table. The `where` clause
   is used to select the row to update and must include all columns composing the PRIMARY KEY.
   Other columns values are specified through assignment within the `set` clause."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/update-query query-params)))

(defn update-async
  "Same as update but returns a future"
  [^Session session & query-params]
  (comment
    (cc/executeasync- session query-params q/update-query)))

(defn delete
  "Deletes columns and rows. If the `columns` clause is provided,
   only those columns are deleted from the row indicated by the `where` clause, please refer to
   doc guide (http://clojurecassandra.info/articles/kv.html) for more details. Otherwise whole rows
   are removed. The `where` allows to specify the key for the row(s) to delete. First argument
   for this function should always be table name."
  [^Session session table & query-params]
  (cc/execute session
              (compile-query- q/delete-query (cons table query-params))))

(defn delete-async
  "Same as delete but returns a future"
  [^Session session table & query-params]
  (comment
    (cc/executeasync- session (cons table query-params) q/delete-query)))

(defn select
  "Retrieves one or more columns for one or more rows in a table.
   It returns a result set, where every row is a collection of columns returned by the query."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/select-query query-params)))

(defn select-async
  "Same as select but returns a future"
  [^Session session & query-params]
  (comment
    (cc/executeasync- session query-params q/select-query)))

(defn truncate
  "Truncates a table: permanently and irreversably removes all rows from the table,
   not removing the table itself."
  [^Session session table]
  (cc/execute session
              (q/truncate-query table)))

(defn create-user
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-user-query query-params)))

(defn alter-user
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/alter-user-query query-params)))

(defn drop-user
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/drop-user-query query-params)))

(defn grant
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/grant-query query-params)))

(defn revoke
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/revoke-query query-params)))

(defn list-users
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/list-users-query query-params)))

(defn list-permissions
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/list-perm-query query-params)))

;;
;; Higher level DB functions
;;

(defn get-one
  "Executes query to get exactly one result. Does not add `limit` clause to the query, this is
   a convenience function only. Please use `limit` clause if you execute queries that potentially
   return more than a single result."
  [^Session session & query-params]
  (first (execute- session query-params q/select-query)))

(defn perform-count
  "Helper function to perform count on a table with given query. Count queries are slow in Cassandra,
   in order to get a rough idea of how many items you have in certain table, use `nodetool cfstats`,
   for more complex cases, you can wither do a full table scan or perform a count with this function,
   please note that it does not have any performance guarantees and is potentially expensive."
  [^Session session table & query-params]
  (:count
   (first
    (select session table
            (cons
             (q/columns (q/count*))
             query-params)))))

;;
;; Higher-level helper functions for schema
;;

(defn describe-keyspace
  "Returns a keyspace description, taken from `system.schema_keyspaces`."
  [^Session session ks]
  (first
   (select session :system.schema_keyspaces
           (q/where {:keyspace_name (name ks)}))))

(defn describe-table
  "Returns a table description, taken from `system.schema_columnfamilies`."
  [^Session session ks table]
  (first
   (select session :system.schema_columnfamilies
           (q/where {:keyspace_name (name ks)
                     :columnfamily_name (name table)}))))

(defn describe-columns
  "Returns table columns description, taken from `system.schema_columns`."
  [^Session session ks table]
  (select session :system.schema_columns
          (q/where {:keyspace_name (name ks)
                    :columnfamily_name (name table)})))

;;
;; Higher-level collection manipulation
;;

(defn- load-chunk
  "Returns next chunk for the lazy table iteration"
  [^Session session table partition-key chunk-size last-pk]
  (if (nil? (first last-pk))
    (select session table
            (q/limit chunk-size))
    (select session table
            (q/where [[> (apply q/token partition-key) (apply q/token last-pk)]])
            (q/limit chunk-size))))

(defn iterate-table
  "Lazily iterates through a table, returning chunks of chunk-size."
  ([^Session session table partition-key chunk-size]
     (iterate-table session table (if (sequential? partition-key)
                                    partition-key
                                    [partition-key])
                    chunk-size []))
  ([^Session session table partition-key chunk-size c]
     (lazy-cat c
               (let [last-pk    (map #(get (last c) %) partition-key)
                     next-chunk (load-chunk session table partition-key chunk-size last-pk)]
                 (if (empty? next-chunk)
                   []
                   (iterate-table session table partition-key chunk-size next-chunk))))))

;; Copyright (c) 2012-2014 Michael S. Klishin, Alex Petrov, and the ClojureWerkz Team
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns clojurewerkz.cassaforte.cql
  "Main namespace for working with CQL, prepared statements. Convenience functions
   for key operations built on top of CQL."
  (:refer-clojure :exclude [update])
  (:require [clojurewerkz.cassaforte.query  :as q]
            [qbits.hayt.cql                 :as hayt]
            [clojurewerkz.cassaforte.client :as cc])
  (:import com.datastax.driver.core.Session))

(defn ^:private compile-query-
  "Compiles query from given `builder` and `query-params`"
  [builder query-params]
  ;; TODO: mapcat identity here?
  (apply builder (flatten query-params)))

;;
;; Schema operations
;;

(defn drop-keyspace
  "Drops a keyspace: results in immediate, irreversible removal of an existing keyspace,
   including all column families in it, and all data contained in those column families."
  [^Session session ks & query-params]
  (cc/execute session
              (compile-query- q/drop-keyspace-query (cons ks query-params))))

(defn create-keyspace
  "Creates a new top-level keyspace. A keyspace is a namespace that
   defines a replication strategy and some options for a set of tables,
   similar to a database in relational databases.

   Example:

     (create-keyspace conn :new_cql_keyspace
                   (with {:replication
                          {:class \"SimpleStrategy\"
                           :replication_factor 1}}))"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-keyspace-query query-params)))

(defn create-index
  "Creates a new (automatic) secondary index for a given (existing)
   column in a given table.If data already exists for the column, it will be indexed during the execution
   of this statement. After the index is created, new data for the column is indexed automatically at
   insertion time.

   Example, creates an index on `users` table, `city` column:

      (create-index conn :users :city
                    (index-name :users_city)
                    (if-not-exists))"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-index-query query-params )))

(defn drop-index
  "Drop an existing secondary index. The argument of the statement
   is the index name.

   Example, drops an index on `users` table, `city` column:

       (drop-index th/session :users_city)"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/drop-index-query query-params) ))

(defn create-table
  "Creates a new table. A table is a set of rows (usually
   representing related entities) for which it defines a number of properties.

   A table is defined by a name, it defines the columns composing rows
   of the table and have a number of options.

   Example:

     (create-table :users
                (column-definitions {:name :varchar
                                     :age  :int
                                     :city :varchar
                                     :primary-key [:name]}))"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-table-query query-params)))

(def create-column-family create-table)

(defn drop-table
  "Drops a table: this results in the immediate, irreversible removal of a table, including
   all data in it."
  [^Session session ks]
  (cc/execute session
              (q/drop-table-query ks)))

(defn use-keyspace
  "Takes an existing keyspace name as argument and set it as the per-session current working keyspace.
   All subsequent keyspace-specific actions will be performed in the context of the selected keyspace,
   unless otherwise specified, until another USE statement is issued or the connection terminates."
  [^Session session ks]
  (cc/execute session
              (q/use-keyspace-query ks)))

(defn alter-table
  "Alters a table definition. Use it to add new
   columns, drop existing ones, change the type of existing columns, or update the table options."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/alter-table-query query-params)))

(defn alter-keyspace
  "Alters properties of an existing keyspace. The
   supported properties are the same that for `create-keyspace`"
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/alter-keyspace-query query-params)))

;;
;; DB Operations
;;

(defn insert
  "Inserts a row in a table.

   Note that since a row is identified by its primary key, the columns that compose it must be
   specified. Also, since a row only exists when it contains one value for a column not part of
   the primary key, one such value must be specified too."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/insert-query query-params)))

(defn insert-async
  "Same as insert but returns a future"
  [^Session session & query-params]
  (comment
    (cc/executeasync- session query-params q/insert-query)))

(defn ^:private batch-query-from-
  [table records]
  (->> records
       (map (comp (partial apply (partial q/insert-query table)) flatten vector))
       (apply q/queries)
       ))

(defn insert-batch
  "Performs a batch insert (inserts multiple records into a table at the same time).
  To specify additional clauses for a record (such as where or using), wrap that record
  and the clauses in a vector"
  [^Session session table records]
  (let [query-params (batch-query-from- table records)]
    (cc/execute session (q/batch-query query-params))))

(defn insert-batch-async
  "Same as insert-batch but returns a future"
  [^Session session table records]
  (let [query (batch-query-from- table records)]
    (comment
      (cc/executeasync- session query))))

(defn atomic-batch
  "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
  [^Session session & clauses]
  (cc/execute session
              (compile-query- q/batch-query clauses)))

(defn update
  "Updates one or more columns for a given row in a table. The `where` clause
   is used to select the row to update and must include all columns composing the PRIMARY KEY.
   Other columns values are specified through assignment within the `set` clause."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/update-query query-params)))

(defn update-async
  "Same as update but returns a future"
  [^Session session & query-params]
  (comment
    (cc/executeasync- session query-params q/update-query)))

(defn delete
  "Deletes columns and rows. If the `columns` clause is provided,
   only those columns are deleted from the row indicated by the `where` clause, please refer to
   doc guide (http://clojurecassandra.info/articles/kv.html) for more details. Otherwise whole rows
   are removed. The `where` allows to specify the key for the row(s) to delete. First argument
   for this function should always be table name."
  [^Session session table & query-params]
  (cc/execute session
              (compile-query- q/delete-query (cons table query-params))))

(defn delete-async
  "Same as delete but returns a future"
  [^Session session table & query-params]
  (comment
    (cc/executeasync- session (cons table query-params) q/delete-query)))

(defn select
  "Retrieves one or more columns for one or more rows in a table.
   It returns a result set, where every row is a collection of columns returned by the query."
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/select-query query-params)))

(defn select-async
  "Same as select but returns a future"
  [^Session session & query-params]
  (comment
    (cc/executeasync- session query-params q/select-query)))

(defn truncate
  "Truncates a table: permanently and irreversably removes all rows from the table,
   not removing the table itself."
  [^Session session table]
  (cc/execute session
              (q/truncate-query table)))

(defn create-user
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/create-user-query query-params)))

(defn alter-user
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/alter-user-query query-params)))

(defn drop-user
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/drop-user-query query-params)))

(defn grant
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/grant-query query-params)))

(defn revoke
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/revoke-query query-params)))

(defn list-users
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/list-users-query query-params)))

(defn list-permissions
  [^Session session & query-params]
  (cc/execute session
              (compile-query- q/list-perm-query query-params)))

;;
;; Higher level DB functions
;;

(defn get-one
  "Executes query to get exactly one result. Does not add `limit` clause to the query, this is
   a convenience function only. Please use `limit` clause if you execute queries that potentially
   return more than a single result.

   Doesn't work as a prepared query."
  [^Session session & query-params]
  (assert (not hayt/*prepared-statement*) "get-one query can't be executed as a prepared query")
  (first
   (cc/execute session
               (compile-query- q/select-query query-params))))

(defn perform-count
  "Helper function to perform count on a table with given query. Count queries are slow in Cassandra,
   in order to get a rough idea of how many items you have in certain table, use `nodetool cfstats`,
   for more complex cases, you can wither do a full table scan or perform a count with this function,
   please note that it does not have any performance guarantees and is potentially expensive.

   Doesn't work as a prepared query."
  [^Session session table & query-params]
  (assert (not hayt/*prepared-statement*) "Count query can't be executed as a prepared query")
  (:count
   (first
    (select session table
            (cons
             (q/columns (q/count*))
             query-params)))))

;;
;; Higher-level helper functions for schema
;;

(defn describe-keyspace
  "Returns a keyspace description, taken from `system.schema_keyspaces`."
  [^Session session ks]
  (assert (not hayt/*prepared-statement*) "Describe Keyspace query can't be executed as a prepared query")
  (first
   (select session :system.schema_keyspaces
           (q/where {:keyspace_name (name ks)}))))

(defn describe-table
  "Returns a table description, taken from `system.schema_columnfamilies`."
  [^Session session ks table]
  (assert (not hayt/*prepared-statement*) "Describe Table query can't be executed as a prepared query")
  (first
   (select session :system.schema_columnfamilies
           (q/where {:keyspace_name (name ks)
                     :columnfamily_name (name table)}))))

(defn describe-columns
  "Returns table columns description, taken from `system.schema_columns`."
  [^Session session ks table]
  (assert (not hayt/*prepared-statement*) "Describe Columns query can't be executed as a prepared query")
  (select session :system.schema_columns
          (q/where {:keyspace_name (name ks)
                    :columnfamily_name (name table)})))

;;
;; Higher-level collection manipulation
;;

(defn- load-chunk
  "Returns next chunk for the lazy table iteration"
  [^Session session table partition-key chunk-size last-pk]
  (if (nil? (first last-pk))
    (select session table
            (q/limit chunk-size))
    (select session table
            (q/where [[> (apply q/token partition-key) (apply q/token last-pk)]])
            (q/limit chunk-size))))

(defn iterate-table
  "Lazily iterates through a table, returning chunks of chunk-size."
  ([^Session session table partition-key chunk-size]
     (iterate-table session table (if (sequential? partition-key)
                                    partition-key
                                    [partition-key])
                    chunk-size []))
  ([^Session session table partition-key chunk-size c]
     (lazy-cat c
               (let [last-pk    (map #(get (last c) %) partition-key)
                     next-chunk (load-chunk session table partition-key chunk-size last-pk)]
                 (if (empty? next-chunk)
                   []
                   (iterate-table session table partition-key chunk-size next-chunk))))))

Add asserts for auxilitary queries

Add asserts for auxilitary queries


(ns com.sixsq.slipstream.ssclj.resources.configuration-lifecycle-test
  (:require
    [clojure.test :refer :all]
    [clojure.data.json :as json]
    [peridot.core :refer :all]
    [com.sixsq.slipstream.ssclj.resources.configuration :refer :all]
    [com.sixsq.slipstream.ssclj.resources.configuration-template :as ct]
    [com.sixsq.slipstream.ssclj.resources.configuration-template-slipstream :as example]
    [com.sixsq.slipstream.ssclj.resources.lifecycle-test-utils :as ltu]
    [com.sixsq.slipstream.ssclj.resources.common.dynamic-load :as dyn]
    [com.sixsq.slipstream.ssclj.middleware.authn-info-header :refer [authn-info-header]]
    [com.sixsq.slipstream.ssclj.app.params :as p]
    [com.sixsq.slipstream.ssclj.app.routes :as routes]
    [com.sixsq.slipstream.ssclj.resources.common.utils :as u]
    [com.sixsq.slipstream.ssclj.resources.common.debug-utils :as du]))

(use-fixtures :each ltu/with-test-client-fixture)

(def base-uri (str p/service-context (u/de-camelcase resource-name)))

(defn ring-app []
  (ltu/make-ring-app (ltu/concat-routes [(routes/get-main-routes)])))

;; initialize must to called to pull in ConfigurationTemplate test examples
(dyn/initialize)

(defn strip-unwanted-attrs [m]
  (let [unwanted #{:id :resourceURI :acl :operations
                   :created :updated :name :description}]
    (into {} (remove #(unwanted (first %)) m))))

(deftest lifecycle

  (let [href (str ct/resource-url "/" example/service)
        template-url (str p/service-context ct/resource-url "/" example/service)
        resp (-> (session (ring-app))
                 (content-type "application/json")
                 (header authn-info-header "root ADMIN")
                 (request template-url)
                 (ltu/body->json)
                 (ltu/is-status 200))
        template (get-in resp [:response :body])
        valid-create {:configurationTemplate (strip-unwanted-attrs (assoc template :prsEnable false))}
        href-create {:configurationTemplate {:href      href
                                             :prsEnable false}}
        invalid-create (assoc-in valid-create [:configurationTemplate :invalid] "BAD")]

    ;; anonymous create should fail
    (-> (session (ring-app))
        (content-type "application/json")
        (request base-uri
                 :request-method :post
                 :body (json/write-str valid-create))
        (ltu/body->json)
        (ltu/is-status 403))

    ;; user create should also fail
    (-> (session (ring-app))
        (content-type "application/json")
        (header authn-info-header "jane USER")
        (request base-uri
                 :request-method :post
                 :body (json/write-str valid-create))
        (ltu/body->json)
        (ltu/is-status 403))

    ;; admin create with invalid template fails
    (-> (session (ring-app))
        (content-type "application/json")
        (header authn-info-header "root ADMIN")
        (request base-uri
                 :request-method :post
                 :body (json/write-str invalid-create))
        (ltu/body->json)
        (ltu/is-status 400))

    ;; full configuration lifecycle as administrator should work
    (let [uri (-> (session (ring-app))
                  (content-type "application/json")
                  (header authn-info-header "root ADMIN")
                  (request base-uri
                           :request-method :post
                           :body (json/write-str valid-create))
                  (ltu/body->json)
                  (ltu/is-status 201)
                  (ltu/location))
          abs-uri (str p/service-context (u/de-camelcase uri))]

      ;; admin get succeeds
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri)
          (ltu/body->json)
          (ltu/is-status 200))

      ;; anonymous query fails
      (-> (session (ring-app))
          (request base-uri)
          (ltu/body->json)
          (ltu/is-status 403))

      ;; admin query succeeds
      (let [entries (-> (session (ring-app))
                        (content-type "application/json")
                        (header authn-info-header "root ADMIN")
                        (request base-uri)
                        (ltu/body->json)
                        (ltu/is-status 200)
                        (ltu/is-resource-uri collection-uri)
                        (ltu/is-count #(= 1 %))
                        (ltu/entries resource-tag))]
        (is ((set (map :id entries)) uri))

        ;; verify that all entries are accessible
        (let [pair-fn (juxt :id #(str p/service-context (:id %)))
              pairs (map pair-fn entries)]
          (doseq [[id entry-uri] pairs]
            (-> (session (ring-app))
                (header authn-info-header "root ADMIN")
                (request entry-uri)
                (ltu/body->json)
                (ltu/is-status 200)
                (ltu/is-id id)))))

      ;; admin delete succeeds
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri
                   :request-method :delete)
          (ltu/body->json)
          (ltu/is-status 200))

      ;; ensure entry is really gone
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri)
          (ltu/body->json)
          (ltu/is-status 404)))

    ;; abbreviated lifecycle using href to template instead of copy
    (let [uri (-> (session (ring-app))
                  (content-type "application/json")
                  (header authn-info-header "root ADMIN")
                  (request base-uri
                           :request-method :post
                           :body (json/write-str href-create))
                  (ltu/body->json)
                  (ltu/is-status 201)
                  (ltu/location))
          abs-uri (str p/service-context (u/de-camelcase uri))]

      ;; admin delete succeeds
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri
                   :request-method :delete)
          (ltu/body->json)
          (ltu/is-status 200))

      ;; ensure entry is really gone
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri)
          (ltu/body->json)
          (ltu/is-status 404)))))

(deftest bad-methods
  (let [resource-uri (str p/service-context (u/new-resource-id resource-name))]
    (doall
      (for [[uri method] [[base-uri :options]
                          [base-uri :delete]
                          [base-uri :put]
                          [resource-uri :options]
                          [resource-uri :post]]]
        (-> (session (ring-app))
            (request uri
                     :request-method method
                     :body (json/write-str {:dummy "value"}))
            (ltu/is-status 405))))))

(ns com.sixsq.slipstream.ssclj.resources.configuration-lifecycle-test
  (:require
    [clojure.test :refer :all]
    [clojure.data.json :as json]
    [peridot.core :refer :all]
    [com.sixsq.slipstream.ssclj.resources.configuration :refer :all]
    [com.sixsq.slipstream.ssclj.resources.configuration-template :as ct]
    [com.sixsq.slipstream.ssclj.resources.configuration-template-slipstream :as example]
    [com.sixsq.slipstream.ssclj.resources.lifecycle-test-utils :as ltu]
    [com.sixsq.slipstream.ssclj.resources.common.dynamic-load :as dyn]
    [com.sixsq.slipstream.ssclj.middleware.authn-info-header :refer [authn-info-header]]
    [com.sixsq.slipstream.ssclj.app.params :as p]
    [com.sixsq.slipstream.ssclj.app.routes :as routes]
    [com.sixsq.slipstream.ssclj.resources.common.utils :as u]
    [com.sixsq.slipstream.ssclj.resources.common.debug-utils :as du]))

(use-fixtures :each ltu/with-test-client-fixture)

(def base-uri (str p/service-context (u/de-camelcase resource-name)))

(defn ring-app []
  (ltu/make-ring-app (ltu/concat-routes [(routes/get-main-routes)])))

;; initialize must to called to pull in ConfigurationTemplate test examples
(dyn/initialize)

(defn strip-unwanted-attrs [m]
  (let [unwanted #{:id :resourceURI :acl :operations
                   :created :updated :name :description}]
    (into {} (remove #(unwanted (first %)) m))))

(deftest lifecycle

  (let [href (str ct/resource-url "/" example/service)
        template-url (str p/service-context ct/resource-url "/" example/service)
        resp (-> (session (ring-app))
                 (content-type "application/json")
                 (header authn-info-header "root ADMIN")
                 (request template-url)
                 (ltu/body->json)
                 (ltu/is-status 200))
        template (get-in resp [:response :body])
        valid-create {:configurationTemplate (strip-unwanted-attrs (assoc template :prsEnable false))}
        href-create {:configurationTemplate {:href      href
                                             :prsEnable false}}
        invalid-create (assoc-in valid-create [:configurationTemplate :invalid] "BAD")]

    ;; anonymous create should fail
    (-> (session (ring-app))
        (content-type "application/json")
        (request base-uri
                 :request-method :post
                 :body (json/write-str valid-create))
        (ltu/body->json)
        (ltu/is-status 403))

    ;; user create should also fail
    (-> (session (ring-app))
        (content-type "application/json")
        (header authn-info-header "jane USER")
        (request base-uri
                 :request-method :post
                 :body (json/write-str valid-create))
        (ltu/body->json)
        (ltu/is-status 403))

    ;; admin create with invalid template fails
    (-> (session (ring-app))
        (content-type "application/json")
        (header authn-info-header "root ADMIN")
        (request base-uri
                 :request-method :post
                 :body (json/write-str invalid-create))
        (ltu/body->json)
        (ltu/is-status 400))

    ;; full configuration lifecycle as administrator should work
    (let [uri (-> (session (ring-app))
                  (content-type "application/json")
                  (header authn-info-header "root ADMIN")
                  (request base-uri
                           :request-method :post
                           :body (json/write-str valid-create))
                  (ltu/body->json)
                  (ltu/is-status 201)
                  (ltu/location))
          abs-uri (str p/service-context (u/de-camelcase uri))]

      ;; admin get succeeds
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri)
          (ltu/body->json)
          (ltu/is-status 200))

      ;; anonymous query fails
      (-> (session (ring-app))
          (request base-uri)
          (ltu/body->json)
          (ltu/is-status 403))

      ;; admin query succeeds
      (let [entries (-> (session (ring-app))
                        (content-type "application/json")
                        (header authn-info-header "root ADMIN")
                        (request base-uri)
                        (ltu/body->json)
                        (ltu/is-status 200)
                        (ltu/is-resource-uri collection-uri)
                        (ltu/is-count #(= 1 %))
                        (ltu/entries resource-tag))]
        (is ((set (map :id entries)) uri))

        ;; verify that all entries are accessible
        (let [pair-fn (juxt :id #(str p/service-context (:id %)))
              pairs (map pair-fn entries)]
          (doseq [[id entry-uri] pairs]
            (-> (session (ring-app))
                (header authn-info-header "root ADMIN")
                (request entry-uri)
                (ltu/body->json)
                (ltu/is-status 200)
                (ltu/is-id id)))))

      ;; try editing the configuration
      (let [old-cfg (-> (session (ring-app))
                        (header authn-info-header "root ADMIN")
                        (request abs-uri)
                        (ltu/body->json)
                        (ltu/is-status 200)
                        :response
                        :body)
            old-flag (:prsEnable old-cfg)
            new-cfg (assoc old-cfg :prsEnable (not old-flag))
            _ (-> (session (ring-app))
                  (content-type "application/json")
                  (header authn-info-header "root ADMIN")
                  (request abs-uri
                           :request-method :put
                           :body (json/write-str new-cfg))
                  (ltu/is-status 200))
            reread-flag (-> (session (ring-app))
                            (header authn-info-header "root ADMIN")
                            (request abs-uri)
                            (ltu/body->json)
                            (ltu/is-status 200)
                            :response
                            :body
                            :prsEnable)]
        (is (not= old-flag reread-flag)))

      ;; admin delete succeeds
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri
                   :request-method :delete)
          (ltu/body->json)
          (ltu/is-status 200))

      ;; ensure entry is really gone
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri)
          (ltu/body->json)
          (ltu/is-status 404)))

    ;; abbreviated lifecycle using href to template instead of copy
    (let [uri (-> (session (ring-app))
                  (content-type "application/json")
                  (header authn-info-header "root ADMIN")
                  (request base-uri
                           :request-method :post
                           :body (json/write-str href-create))
                  (ltu/body->json)
                  (ltu/is-status 201)
                  (ltu/location))
          abs-uri (str p/service-context (u/de-camelcase uri))]

      ;; admin delete succeeds
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri
                   :request-method :delete)
          (ltu/body->json)
          (ltu/is-status 200))

      ;; ensure entry is really gone
      (-> (session (ring-app))
          (header authn-info-header "root ADMIN")
          (request abs-uri)
          (ltu/body->json)
          (ltu/is-status 404)))))

(deftest bad-methods
  (let [resource-uri (str p/service-context (u/new-resource-id resource-name))]
    (doall
      (for [[uri method] [[base-uri :options]
                          [base-uri :delete]
                          [base-uri :put]
                          [resource-uri :options]
                          [resource-uri :post]]]
        (-> (session (ring-app))
            (request uri
                     :request-method method
                     :body (json/write-str {:dummy "value"}))
            (ltu/is-status 405))))))

fix configuration identifier; check editing


(ns reagent.ratom
  (:refer-clojure :exclude [atom])
  (:require-macros [reagent.debug :refer (dbg log warn dev?)])
  (:require [reagent.impl.util :as util]))

(declare ^:dynamic *ratom-context*)

(defonce debug false)

(defonce -running (clojure.core/atom 0))

(defn running [] @-running)

(defn capture-derefed [f obj]
  (set! (.-cljsCaptured obj) nil)
  (binding [*ratom-context* obj]
    (f)))

(defn captured [obj]
  (let [c (.-cljsCaptured obj)]
    (set! (.-cljsCaptured obj) nil)
    c))

(defn- notify-deref-watcher! [derefable]
  (let [obj *ratom-context*]
    (when-not (nil? obj)
      (let [captured (.-cljsCaptured obj)]
        (set! (.-cljsCaptured obj)
              (conj (if (nil? captured) #{} captured)
                    derefable))))))

;;; Atom

(defprotocol IReactiveAtom)

(deftype RAtom [^:mutable state meta validator ^:mutable watches]
  IAtom
  IReactiveAtom

  IEquiv
  (-equiv [o other] (identical? o other))

  IDeref
  (-deref [this]
    (notify-deref-watcher! this)
    state)

  IReset
  (-reset! [a new-value]
    (when-not (nil? validator)
      (assert (validator new-value) "Validator rejected reference state"))
    (let [old-value state]
      (set! state new-value)
      (when-not (nil? watches)
        (-notify-watches a old-value new-value))
      new-value))

  ISwap
  (-swap! [a f]
    (-reset! a (f state)))
  (-swap! [a f x]
    (-reset! a (f state x)))
  (-swap! [a f x y]
    (-reset! a (f state x y)))
  (-swap! [a f x y more]
    (-reset! a (apply f state x y more)))

  IMeta
  (-meta [_] meta)

  IPrintWithWriter
  (-pr-writer [a writer opts]
    (-write writer "#<Atom: ")
    (pr-writer state writer opts)
    (-write writer ">"))

  IWatchable
  (-notify-watches [this oldval newval]
    (reduce-kv (fn [_ key f]
                 (f key this oldval newval)
                 nil)
               nil watches))
  (-add-watch [this key f]
    (set! watches (assoc watches key f)))
  (-remove-watch [this key]
    (set! watches (dissoc watches key)))

  IHash
  (-hash [this] (goog/getUid this)))

(defn atom
  "Like clojure.core/atom, except that it keeps track of derefs."
  ([x] (RAtom. x nil nil nil))
  ([x & {:keys [meta validator]}] (RAtom. x meta validator nil)))

;;; cursor

(declare make-reaction)

(deftype RCursor [ratom path ^:mutable reaction]
  IAtom
  IReactiveAtom

  IEquiv
  (-equiv [o other]
    (and (instance? RCursor other)
         (= path (.-path other))
         (= ratom (.-ratom other))))

  Object
  (_reaction [this]
    (if (nil? reaction)
      (set! reaction
            (if (satisfies? IDeref ratom)
              (make-reaction #(get-in @ratom path)
                             :on-set (if (= path [])
                                       #(reset! ratom %2)
                                       #(swap! ratom assoc-in path %2)))
              (make-reaction #(ratom path)
                             :on-set #(ratom path %2))))
      reaction))

  (_peek [this]
    (binding [*ratom-context* nil]
      (-deref (._reaction this))))

  IDeref
  (-deref [this]
    (-deref (._reaction this)))

  IReset
  (-reset! [this new-value]
    (-reset! (._reaction this) new-value))

  ISwap
  (-swap! [a f]
    (-swap! (._reaction a) f))
  (-swap! [a f x]
    (-swap! (._reaction a) f x))
  (-swap! [a f x y]
    (-swap! (._reaction a) f x y))
  (-swap! [a f x y more]
    (-swap! (._reaction a) f x y more))

  IPrintWithWriter
  (-pr-writer [a writer opts]
    (-write writer (str "#<Cursor: " path " "))
    (pr-writer (._peek a) writer opts)
    (-write writer ">"))

  IWatchable
  (-notify-watches [this oldval newval]
    (-notify-watches (._reaction this) oldval newval))
  (-add-watch [this key f]
    (-add-watch (._reaction this) key f))
  (-remove-watch [this key]
    (-remove-watch (._reaction this) key))

  IHash
  (-hash [this] (hash [ratom path])))

(defn cursor
  [src path]
  (if (satisfies? IDeref path)
    (do
      (warn "Calling cursor with an atom as the second arg is "
            "deprecated, in (cursor "
            src " " (pr-str path) ")")
      (assert (satisfies? IReactiveAtom path)
              (str "src must be a reactive atom, not "
                   (pr-str path)))
      (RCursor. path src nil))
    (do
      (assert (or (satisfies? IReactiveAtom src)
                  (and (ifn? src)
                       (not (vector? src))))
              (str "src must be a reactive atom or a function, not "
                   (pr-str src)))
      (RCursor. src path nil))))

;;;; reaction

(defprotocol IDisposable
  (dispose! [this]))

(defprotocol IRunnable
  (run [this]))

(defprotocol IComputedImpl
  (-update-watching [this derefed])
  (-handle-change [k sender oldval newval])
  (-peek-at [this]))

(deftype Reaction [f ^:mutable state ^:mutable dirty? ^:mutable active?
                   ^:mutable watching ^:mutable watches
                   auto-run on-set on-dispose]
  IAtom
  IReactiveAtom

  IWatchable
  (-notify-watches [this oldval newval]
    (reduce-kv (fn [_ key f]
                 (f key this oldval newval)
                 nil)
               nil watches))

  (-add-watch [this k wf]
    (set! watches (assoc watches k wf)))

  (-remove-watch [this k]
    (set! watches (dissoc watches k))
    (when (and (empty? watches)
               (not auto-run))
      (dispose! this)))

  IReset
  (-reset! [a newval]
    (let [oldval state]
      (set! state newval)
      (when on-set
        (set! dirty? true)
        (on-set oldval newval))
      (-notify-watches a oldval newval)
      newval))

  ISwap
  (-swap! [a f]
    (-reset! a (f (-peek-at a))))
  (-swap! [a f x]
    (-reset! a (f (-peek-at a) x)))
  (-swap! [a f x y]
    (-reset! a (f (-peek-at a) x y)))
  (-swap! [a f x y more]
    (-reset! a (apply f (-peek-at a) x y more)))

  IComputedImpl
  (-handle-change [this sender oldval newval]
    (when (and active? (not dirty?) (not (identical? oldval newval)))
      (set! dirty? true)
      ((or auto-run run) this)))

  (-update-watching [this derefed]
    (doseq [w derefed]
      (when-not (contains? watching w)
        (add-watch w this -handle-change)))
    (doseq [w watching]
      (when-not (contains? derefed w)
        (remove-watch w this)))
    (set! watching derefed))

  (-peek-at [this]
    (if-not dirty?
      state
      (binding [*ratom-context* nil]
        (-deref this))))

  IRunnable
  (run [this]
    (let [oldstate state
          res (capture-derefed f this)
          derefed (captured this)]
      (when (not= derefed watching)
        (-update-watching this derefed))
      (when-not active?
        (when debug (swap! -running inc))
        (set! active? true))
      (set! dirty? false)
      (set! state res)
      (-notify-watches this oldstate state)
      res))

  IDeref
  (-deref [this]
    (if-not (or auto-run (some? *ratom-context*))
      (do
        (when dirty?
          (let [oldstate state]
            (set! state (f))
            (when-not (identical? oldstate state)
              (-notify-watches this oldstate state))))
        state)
      (do
        (when (some? *ratom-context*)
          (notify-deref-watcher! this))
        (if dirty?
          (run this)
          state))))

  IDisposable
  (dispose! [this]
    (doseq [w watching]
      (remove-watch w this))
    (set! watching nil)
    (set! state nil)
    (set! dirty? true)
    (when active?
      (when debug (swap! -running dec))
      (set! active? false))
    (when on-dispose
      (on-dispose)))

  IEquiv
  (-equiv [o other] (identical? o other))

  IPrintWithWriter
  (-pr-writer [this writer opts]
    (-write writer (str "#<Reaction " (hash this) ": "))
    (pr-writer state writer opts)
    (-write writer ">"))

  IHash
  (-hash [this] (goog/getUid this)))

(defn make-reaction [f & {:keys [auto-run on-set on-dispose derefed]}]
  (let [runner (if (= auto-run true) run auto-run)
        active (not (nil? derefed))
        dirty (not active)
        reaction (Reaction. f nil dirty active
                            nil nil
                            runner on-set on-dispose)]
    (when-not (nil? derefed)
      (when debug (swap! -running inc))
      (-update-watching reaction derefed))
    reaction))

;;; wrap

(deftype Wrapper [^:mutable state callback ^:mutable changed
                  ^:mutable watches]

  IAtom

  IDeref
  (-deref [this]
    (when (dev?)
      (when (and changed (some? *ratom-context*))
        (warn "derefing stale wrap: "
              (pr-str this))))
    state)

  IReset
  (-reset! [this newval]
    (let [oldval state]
      (set! changed true)
      (set! state newval)
      (when-not (nil? watches)
        (-notify-watches this oldval newval))
      (callback newval)
      newval))

  ISwap
  (-swap! [a f]
    (-reset! a (f state)))
  (-swap! [a f x]
    (-reset! a (f state x)))
  (-swap! [a f x y]
    (-reset! a (f state x y)))
  (-swap! [a f x y more]
    (-reset! a (apply f state x y more)))

  IEquiv
  (-equiv [_ other]
          (and (instance? Wrapper other)
               ;; If either of the wrappers have changed, equality
               ;; cannot be relied on.
               (not changed)
               (not (.-changed other))
               (= state (.-state other))
               (= callback (.-callback other))))

  IWatchable
  (-notify-watches [this oldval newval]
    (reduce-kv (fn [_ key f]
                 (f key this oldval newval)
                 nil)
               nil watches))
  (-add-watch [this key f]
    (set! watches (assoc watches key f)))
  (-remove-watch [this key]
    (set! watches (dissoc watches key)))

  IPrintWithWriter
  (-pr-writer [_ writer opts]
    (-write writer "#<wrap: ")
    (pr-writer state writer opts)
    (-write writer ">")))

(defn make-wrapper [value callback-fn args]
  (Wrapper. value
            (util/partial-ifn. callback-fn args nil)
            false nil))

(ns reagent.ratom
  (:refer-clojure :exclude [atom])
  (:require-macros [reagent.debug :refer (dbg log warn dev?)])
  (:require [reagent.impl.util :as util]))

(declare ^:dynamic *ratom-context*)

(defonce debug false)

(defonce -running (clojure.core/atom 0))

(defn running [] @-running)

(defn capture-derefed [f obj]
  (set! (.-cljsCaptured obj) nil)
  (binding [*ratom-context* obj]
    (f)))

(defn captured [obj]
  (let [c (.-cljsCaptured obj)]
    (set! (.-cljsCaptured obj) nil)
    c))

(defn- notify-deref-watcher! [derefable]
  (let [obj *ratom-context*]
    (when-not (nil? obj)
      (let [captured (.-cljsCaptured obj)]
        (set! (.-cljsCaptured obj)
              (conj (if (nil? captured) #{} captured)
                    derefable))))))

;;; Atom

(defprotocol IReactiveAtom)

(deftype RAtom [^:mutable state meta validator ^:mutable watches]
  IAtom
  IReactiveAtom

  IEquiv
  (-equiv [o other] (identical? o other))

  IDeref
  (-deref [this]
    (notify-deref-watcher! this)
    state)

  IReset
  (-reset! [a new-value]
    (when-not (nil? validator)
      (assert (validator new-value) "Validator rejected reference state"))
    (let [old-value state]
      (set! state new-value)
      (when-not (nil? watches)
        (-notify-watches a old-value new-value))
      new-value))

  ISwap
  (-swap! [a f]
    (-reset! a (f state)))
  (-swap! [a f x]
    (-reset! a (f state x)))
  (-swap! [a f x y]
    (-reset! a (f state x y)))
  (-swap! [a f x y more]
    (-reset! a (apply f state x y more)))

  IMeta
  (-meta [_] meta)

  IPrintWithWriter
  (-pr-writer [a writer opts]
    (-write writer "#<Atom: ")
    (pr-writer state writer opts)
    (-write writer ">"))

  IWatchable
  (-notify-watches [this oldval newval]
    (reduce-kv (fn [_ key f]
                 (f key this oldval newval)
                 nil)
               nil watches))
  (-add-watch [this key f]
    (set! watches (assoc watches key f)))
  (-remove-watch [this key]
    (set! watches (dissoc watches key)))

  IHash
  (-hash [this] (goog/getUid this)))

(defn atom
  "Like clojure.core/atom, except that it keeps track of derefs."
  ([x] (RAtom. x nil nil nil))
  ([x & {:keys [meta validator]}] (RAtom. x meta validator nil)))

;;; cursor

(declare make-reaction)

(deftype RCursor [ratom path ^:mutable reaction]
  IAtom
  IReactiveAtom

  IEquiv
  (-equiv [o other]
    (and (instance? RCursor other)
         (= path (.-path other))
         (= ratom (.-ratom other))))

  Object
  (_reaction [this]
    (if (nil? reaction)
      (set! reaction
            (if (satisfies? IDeref ratom)
              (make-reaction #(get-in @ratom path)
                             :on-set (if (= path [])
                                       #(reset! ratom %2)
                                       #(swap! ratom assoc-in path %2)))
              (make-reaction #(ratom path)
                             :on-set #(ratom path %2))))
      reaction))

  (_peek [this]
    (binding [*ratom-context* nil]
      (-deref (._reaction this))))

  IDeref
  (-deref [this]
    (-deref (._reaction this)))

  IReset
  (-reset! [this new-value]
    (-reset! (._reaction this) new-value))

  ISwap
  (-swap! [a f]
    (-swap! (._reaction a) f))
  (-swap! [a f x]
    (-swap! (._reaction a) f x))
  (-swap! [a f x y]
    (-swap! (._reaction a) f x y))
  (-swap! [a f x y more]
    (-swap! (._reaction a) f x y more))

  IPrintWithWriter
  (-pr-writer [a writer opts]
    (-write writer (str "#<Cursor: " path " "))
    (pr-writer (._peek a) writer opts)
    (-write writer ">"))

  IWatchable
  (-notify-watches [this oldval newval]
    (-notify-watches (._reaction this) oldval newval))
  (-add-watch [this key f]
    (-add-watch (._reaction this) key f))
  (-remove-watch [this key]
    (-remove-watch (._reaction this) key))

  IHash
  (-hash [this] (hash [ratom path])))

(defn cursor
  [src path]
  (if (satisfies? IDeref path)
    (do
      (warn "Calling cursor with an atom as the second arg is "
            "deprecated, in (cursor "
            src " " (pr-str path) ")")
      (assert (satisfies? IReactiveAtom path)
              (str "src must be a reactive atom, not "
                   (pr-str path)))
      (RCursor. path src nil))
    (do
      (assert (or (satisfies? IReactiveAtom src)
                  (and (ifn? src)
                       (not (vector? src))))
              (str "src must be a reactive atom or a function, not "
                   (pr-str src)))
      (RCursor. src path nil))))

;;;; reaction

(defprotocol IDisposable
  (dispose! [this]))

(defprotocol IRunnable
  (run [this]))

(defprotocol IComputedImpl
  (-update-watching [this derefed])
  (-handle-change [k sender oldval newval])
  (-peek-at [this]))

(deftype Reaction [f ^:mutable state ^:mutable dirty? ^:mutable active?
                   ^:mutable watching ^:mutable watches
                   auto-run on-set on-dispose]
  IAtom
  IReactiveAtom

  IWatchable
  (-notify-watches [this oldval newval]
    (reduce-kv (fn [_ key f]
                 (f key this oldval newval)
                 nil)
               nil watches))

  (-add-watch [this k wf]
    (set! watches (assoc watches k wf)))

  (-remove-watch [this k]
    (set! watches (dissoc watches k))
    (when (and (empty? watches)
               (not auto-run))
      (dispose! this)))

  IReset
  (-reset! [a newval]
    (let [oldval state]
      (set! state newval)
      (when on-set
        (set! dirty? true)
        (on-set oldval newval))
      (-notify-watches a oldval newval)
      newval))

  ISwap
  (-swap! [a f]
    (-reset! a (f (-peek-at a))))
  (-swap! [a f x]
    (-reset! a (f (-peek-at a) x)))
  (-swap! [a f x y]
    (-reset! a (f (-peek-at a) x y)))
  (-swap! [a f x y more]
    (-reset! a (apply f (-peek-at a) x y more)))

  IComputedImpl
  (-handle-change [this sender oldval newval]
    (when (and active? (not dirty?) (not (identical? oldval newval)))
      (set! dirty? true)
      ((or auto-run run) this)))

  (-update-watching [this derefed]
    (doseq [w derefed]
      (when-not (contains? watching w)
        (add-watch w this -handle-change)))
    (doseq [w watching]
      (when-not (contains? derefed w)
        (remove-watch w this)))
    (set! watching derefed))

  (-peek-at [this]
    (if-not dirty?
      state
      (binding [*ratom-context* nil]
        (-deref this))))

  IRunnable
  (run [this]
    (let [oldstate state
          res (capture-derefed f this)
          derefed (captured this)]
      (when (not= derefed watching)
        (-update-watching this derefed))
      (when-not active?
        (when debug (swap! -running inc))
        (set! active? true))
      (set! dirty? false)
      (set! state res)
      (-notify-watches this oldstate state)
      res))

  IDeref
  (-deref [this]
    (if (or auto-run (some? *ratom-context*))
      (do
        (notify-deref-watcher! this)
        (if dirty?
          (run this)
          state))
      (do
        (when dirty?
          (let [oldstate state]
            (set! state (f))
            (when-not (identical? oldstate state)
              (-notify-watches this oldstate state))))
        state)))

  IDisposable
  (dispose! [this]
    (doseq [w watching]
      (remove-watch w this))
    (set! watching nil)
    (set! state nil)
    (set! dirty? true)
    (when active?
      (when debug (swap! -running dec))
      (set! active? false))
    (when on-dispose
      (on-dispose)))

  IEquiv
  (-equiv [o other] (identical? o other))

  IPrintWithWriter
  (-pr-writer [this writer opts]
    (-write writer (str "#<Reaction " (hash this) ": "))
    (pr-writer state writer opts)
    (-write writer ">"))

  IHash
  (-hash [this] (goog/getUid this)))

(defn make-reaction [f & {:keys [auto-run on-set on-dispose derefed]}]
  (let [runner (if (= auto-run true) run auto-run)
        active (not (nil? derefed))
        dirty (not active)
        reaction (Reaction. f nil dirty active
                            nil nil
                            runner on-set on-dispose)]
    (when-not (nil? derefed)
      (when debug (swap! -running inc))
      (-update-watching reaction derefed))
    reaction))

;;; wrap

(deftype Wrapper [^:mutable state callback ^:mutable changed
                  ^:mutable watches]

  IAtom

  IDeref
  (-deref [this]
    (when (dev?)
      (when (and changed (some? *ratom-context*))
        (warn "derefing stale wrap: "
              (pr-str this))))
    state)

  IReset
  (-reset! [this newval]
    (let [oldval state]
      (set! changed true)
      (set! state newval)
      (when-not (nil? watches)
        (-notify-watches this oldval newval))
      (callback newval)
      newval))

  ISwap
  (-swap! [a f]
    (-reset! a (f state)))
  (-swap! [a f x]
    (-reset! a (f state x)))
  (-swap! [a f x y]
    (-reset! a (f state x y)))
  (-swap! [a f x y more]
    (-reset! a (apply f state x y more)))

  IEquiv
  (-equiv [_ other]
          (and (instance? Wrapper other)
               ;; If either of the wrappers have changed, equality
               ;; cannot be relied on.
               (not changed)
               (not (.-changed other))
               (= state (.-state other))
               (= callback (.-callback other))))

  IWatchable
  (-notify-watches [this oldval newval]
    (reduce-kv (fn [_ key f]
                 (f key this oldval newval)
                 nil)
               nil watches))
  (-add-watch [this key f]
    (set! watches (assoc watches key f)))
  (-remove-watch [this key]
    (set! watches (dissoc watches key)))

  IPrintWithWriter
  (-pr-writer [_ writer opts]
    (-write writer "#<wrap: ")
    (pr-writer state writer opts)
    (-write writer ">")))

(defn make-wrapper [value callback-fn args]
  (Wrapper. value
            (util/partial-ifn. callback-fn args nil)
            false nil))

Make -deref in Reaction a little clearer