T2: Toucan 20.0.1-SNAPSHOTA classy high-level Clojure library for defining application models and retrieving them from a DB | (this space intentionally left almost blank) |
namespaces
| |
Connection ResolutionThe rules for determining which connection to use are as follows. These are tried in order until one returns non-nil:
You can define a 'named' connectable such as IMPORTANT CAVEAT! Positional connectables will be used in preference to [[current-connectable]], even when it was bound by [[with-transaction]] -- this means your query will run OUTSIDE of the current transaction! Sometimes, this is what you want, because maybe a certain query is meant to run against a different database! Usually, however, it is not! So in that case you can either do something like ```clj (t2/query (or conn/current-connectable ::my-db) ...) ``` to use the current connection if it exists, or define your named connectable method like ```clj (m/defmethod conn/do-with-connection ::my-db [_connectable f] (conn/do-with-connection (if (and conn/current-connectable (not= conn/current-connectable ::my-db)) conn/current-connectable "jdbc:postgresql://...") f)) ``` This, however, is super annoying! So I might reconsider this behavior in the future. For reducible queries, the connection is not resolved until the query is executed, so you may create a reducible query with no default connection available and execute it later with one bound. (This also means that [[toucan2.execute/reducible-query]] does not capture dynamic bindings such as [[toucan2.connection/current-connectable]] -- you probably wouldn't want it to, anyway, since we have no guarantees and open connection will be around when we go to use the reducible query later. The default JDBC implementations for methods here live in [[toucan2.jdbc.connection]]. | (ns toucan2.connection (:require [clojure.spec.alpha :as s] [methodical.core :as m] [pretty.core :as pretty] [toucan2.log :as log] [toucan2.protocols :as protocols] [toucan2.types :as types] [toucan2.util :as u])) |
(set! *warn-on-reflection* true) | |
(comment types/keep-me) | |
The current connectable or connection. If you get a connection with [[with-connection]] or [[with-transaction]], it
will be bound here. You can also bind this yourself to a connectable or connection, and Toucan methods called without
an explicit will connectable will use it rather than the | (def ^:dynamic *current-connectable* nil) |
Take a connectable, get a connection of some sort from it, and execute ```clj (m/defmethod t2.conn/do-with-connection ::my-connectable [_connectable f] (with-open [conn (get-connection)] (f conn))) ``` Another common use case is to define a 'named' connectable that acts as an alias for another more complicated connectable, such as a JDBC connection string URL. You can do that like this: ```clj (m/defmethod t2.conn/do-with-connection ::a-connectable [_connectable f] (t2.conn/do-with-connection "jdbc:postgresql://localhost:5432/toucan2?user=cam&password=cam" f)) ``` | (m/defmulti do-with-connection
{:arglists '([connectable₁ f])
:defmethod-arities #{2}
:dispatch-value-spec ::types/dispatch-value.keyword-or-class}
u/dispatch-on-first-arg
:default-value ::default) |
Wrap functions as passed to [[do-with-connection]] or [[do-with-transaction]] in a way that binds [[current-connectable]]. | (defn- bind-current-connectable-fn
[f]
{:pre [(fn? f)]}
(^:once fn* [conn]
(binding [*current-connectable* conn]
(f conn)))) |
(m/defmethod do-with-connection :around ::default
"Do some debug logging/context capture. Bind [[*current-connectable*]] to the connection `f` is called with inside of
`f`."
[connectable f]
(assert (fn? f))
;; add the connection class or pretty representation rather than the connection type itself to avoid leaking sensitive
;; creds
(let [connectable-class (if (instance? pretty.core.PrettyPrintable connectable)
(pretty/pretty connectable)
(protocols/dispatch-value connectable))]
(log/debugf "Resolve connection %s" connectable-class)
(u/try-with-error-context ["resolve connection" {::connectable connectable-class}]
(next-method connectable (bind-current-connectable-fn f))))) | |
Execute With no args in the bindings vector, ```clj (t2/with-connection [] ...) ``` With one arg, ```clj (t2/with-connection [conn] ...) ``` If you're using the default JDBC backend, ```clj (t2/with-connection [^java.sql.Connection conn] (let [metadata (.getMetaData conn)] ...)) ``` With a connection binding and a connectable: ```clj (t2/with-connection [conn ::my-connectable] ...) ``` This example gets a connection by calling [[do-with-connection]] with | (defmacro with-connection
{:arglists '([[connection-binding] & body]
[[connection-binding connectable] & body])}
[[connection-binding connectable] & body]
`(do-with-connection
~connectable
(^:once fn* with-connection* [~(or connection-binding '_)] ~@body))) |
(s/fdef with-connection
:args (s/cat :bindings (s/spec (s/cat :connection-binding (s/? symbol?)
:connectable (s/? any?)))
:body (s/+ any?))
:ret any?) | |
method if this is called with something we don't know how to handle or if no default connection is defined. This is
separate from | (m/defmethod do-with-connection ::default
[connectable _f]
(throw (ex-info (format "Don't know how to get a connection from ^%s %s. Do you need to implement %s for %s?"
(some-> connectable class .getCanonicalName)
(pr-str connectable)
`do-with-connection
(protocols/dispatch-value connectable))
{:connectable connectable}))) |
method called if there is no current connection. | (m/defmethod do-with-connection :default
[_connectable _f]
(throw (ex-info (str "No default Toucan connection defined. "
(format "You can define one by implementing %s for :default. "
`do-with-connection)
(format "You can also implement %s for a model, or bind %s."
'toucan2.model/default-connectable
`*current-connectable*))
{}))) |
(m/defmethod do-with-connection nil
"`nil` means use the current connection.
The difference between `nil` and using [[*current-connectable*]] directly is that this waits until it gets resolved
by [[do-with-connection]] to get the value for [[*current-connectable*]]. For a reducible query this means you'll get
the value at the time you reduce the query rather than at the time you build the reducible query."
[_connectable f]
(let [current-connectable (if (nil? *current-connectable*)
:default
*current-connectable*)]
(do-with-connection current-connectable f))) | |
connection string support | |
Extract the protocol part of a ```clj (connection-string-protocol "jdbc:postgresql:...") => "jdbc" ``` | (defn connection-string-protocol
[connection-string]
(when (string? connection-string)
(second (re-find #"^(?:([^:]+):)" connection-string)))) |
Implementation of [[do-with-connection]] for strings. Dispatches on the [[connection-string-protocol]] of the string,
e.g. | (m/defmulti do-with-connection-string
{:arglists '([^java.lang.String connection-string f])
:defmethod-arities #{2}
:dispatch-value-spec string?}
(fn [connection-string _f]
(connection-string-protocol connection-string))) |
(m/defmethod do-with-connection String "Implementation for Strings. Hands off to [[do-with-connection-string]]." [connection-string f] (do-with-connection-string connection-string f)) | |
JDBC implementations live in [[toucan2.jdbc.connection]] | |
| (m/defmulti do-with-transaction
{:arglists '([connection₁ options f])
:defmethod-arities #{3}
:dispatch-value-spec ::types/dispatch-value.keyword-or-class}
u/dispatch-on-first-arg
:default-value ::default) |
(m/defmethod do-with-transaction :around ::default "Bind [[*current-connectable*]] to the connection `f` is called with inside of `f`." [connection options f] (log/debugf "do with transaction %s %s" options (some-> connection class .getCanonicalName symbol)) (next-method connection options (bind-current-connectable-fn f))) | |
Gets a connection with [[with-connection]], and executes An
| (defmacro with-transaction
{:style/indent 1, :arglists '([[conn-binding connectable options?] & body])}
[[conn-binding connectable options] & body]
`(with-connection [conn# ~connectable]
(do-with-transaction conn# ~options (^:once fn* with-transaction* [~(or conn-binding '_)] ~@body)))) |
(s/def :toucan2.with-transaction-options/nested-transaction-rule
(s/nilable #{:allow :ignore :prohibit})) | |
(s/def ::with-transaction-options (s/keys :opt-un [:toucan2.with-transaction-options/nested-transaction-rule])) | |
(s/fdef with-transaction
:args (s/cat :bindings (s/spec (s/cat :connection-binding (s/? symbol?)
:connectable (s/? any?)
:options (s/? ::with-transaction-options)))
:body (s/+ any?))
:ret any?) | |
JDBC implementation lives in [[toucan2.jdbc.connection]] | |
Convenience namespace exposing the most common parts of the library's public API for day-to-day usage (i.e., not implementing anything advanced) | (ns ^:no-doc toucan2.core (:refer-clojure :exclude [compile count instance?]) (:require [potemkin :as p] [toucan2.connection] [toucan2.delete] [toucan2.execute] [toucan2.honeysql2] [toucan2.insert] [toucan2.instance] [toucan2.jdbc] [toucan2.model] [toucan2.protocols] [toucan2.save] [toucan2.select] [toucan2.tools.after-insert] [toucan2.tools.after-select] [toucan2.tools.after-update] [toucan2.tools.before-delete] [toucan2.tools.before-insert] [toucan2.tools.before-select] [toucan2.tools.before-update] [toucan2.tools.compile] [toucan2.tools.debug] [toucan2.tools.default-fields] [toucan2.tools.hydrate] [toucan2.tools.named-query] [toucan2.tools.transformed] [toucan2.update] [toucan2.util])) |
this is so no one gets confused and thinks these namespaces are unused. | (comment toucan2.connection/keep-me toucan2.delete/keep-me toucan2.execute/keep-me toucan2.honeysql2/keep-me toucan2.insert/keep-me toucan2.instance/keep-me toucan2.jdbc/keep-me toucan2.model/keep-me toucan2.protocols/keep-me toucan2.save/keep-me toucan2.select/keep-me toucan2.tools.after-insert/keep-me toucan2.tools.after-select/keep-me toucan2.tools.after-update/keep-me toucan2.tools.before-delete/keep-me toucan2.tools.before-insert/keep-me toucan2.tools.before-select/keep-me toucan2.tools.before-update/keep-me toucan2.tools.compile/keep-me toucan2.tools.debug/keep-me toucan2.tools.default-fields/keep-me toucan2.tools.hydrate/keep-me toucan2.tools.named-query/keep-me toucan2.tools.transformed/keep-me toucan2.update/keep-me toucan2.util/keep-me) |
(p/import-vars [toucan2.connection do-with-connection with-connection with-transaction] [toucan2.delete delete!] [toucan2.execute query query-one reducible-query with-call-count] [toucan2.insert insert! insert-returning-instance! insert-returning-pk! insert-returning-instances! insert-returning-pks!] [toucan2.instance instance instance-of? instance?] [toucan2.model default-connectable primary-key-values-map primary-keys resolve-model select-pks-fn table-name] [toucan2.protocols changes current model original] [toucan2.save save!] [toucan2.select count exists? reducible-select select select-fn->fn select-fn->pk select-fn-reducible select-fn-set select-fn-vec select-one select-one-fn select-one-pk select-pk->fn select-pks-set select-pks-vec] [toucan2.tools.after-insert define-after-insert] [toucan2.tools.after-select define-after-select] [toucan2.tools.after-update define-after-update] [toucan2.tools.before-delete define-before-delete] [toucan2.tools.before-insert define-before-insert] [toucan2.tools.before-select define-before-select] [toucan2.tools.before-update define-before-update] [toucan2.tools.compile build compile] [toucan2.tools.debug debug] [toucan2.tools.default-fields define-default-fields] [toucan2.tools.hydrate batched-hydrate hydrate model-for-automagic-hydration simple-hydrate] [toucan2.tools.named-query define-named-query] [toucan2.tools.transformed deftransforms transforms] [toucan2.update reducible-update reducible-update-returning-pks update! update-returning-pks!]) | |
Implementation of [[delete!]]. Code for building Honey SQL for DELETE lives in [[toucan2.honeysql2]] | (ns toucan2.delete (:require [toucan2.pipeline :as pipeline])) |
Delete instances of a model that match ```clj ;; delete a row by primary key (t2/delete! :models/venues 1) ;; Delete all rows matching a condition (t2/delete! :models/venues :name "Bird Store") ``` Allowed syntax is identical to [[toucan2.select/select]], including optional positional parameters like | (defn delete!
{:arglists '([modelable & conditions? queryable?]
[:conn connectable modelable & conditions? queryable?])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/delete.update-count unparsed-args)) |
Code for executing queries and statements, and reducing their results. The functions here meant for use on a regular basis are:
| (ns toucan2.execute (:require [clojure.spec.alpha :as s] [toucan2.pipeline :as pipeline])) |
(set! *warn-on-reflection* true) | |
(defn- query* [f]
(fn query**
([queryable]
;; `nil` connectable = use the current connection or `:default` if none is specified.
(query** nil queryable))
([connectable queryable]
(query** connectable nil queryable))
([connectable modelable queryable]
;; by passing `result-type/*` we'll basically get whatever the default is -- instances for `SELECT` or update counts
;; for `DML` stuff.
(query** connectable :toucan.result-type/* modelable queryable))
([connectable query-type modelable queryable]
(let [parsed-args {:connectable connectable
:modelable modelable
:queryable queryable}]
(f query-type parsed-args))))) | |
Create a reducible query that when reduced with resolve and compile Note that this query can be something like a You can specify See [[toucan2.connection]] for Connection resolution rules. | (def ^{:arglists '([queryable]
[connectable queryable]
[connectable modelable queryable]
[connectable query-type modelable queryable])}
reducible-query
(query* pipeline/reducible-parsed-args)) |
Util functions for running queries and immediately realizing the results. | |
Like [[reducible-query]], but immediately executes and fully reduces the query. ```clj (query ::my-connectable ["SELECT * FROM venues;"]) ;; => [{:id 1, :name "Tempest"} {:id 2, :name "BevMo"}] ``` Like [[reducible-query]], this may be used with either | (def ^{:arglists '([queryable]
[connectable queryable]
[connectable modelable queryable]
[connectable query-type modelable queryable])}
query
(query*
(fn [query-type parsed-args]
(let [rf (pipeline/default-rf query-type)]
(pipeline/transduce-parsed rf query-type parsed-args))))) |
Like [[query]], and immediately executes the query, but realizes and returns only the first result. ```clj (query-one ::my-connectable ["SELECT * FROM venues;"]) ;; => {:id 1, :name "Tempest"} ``` Like [[reducible-query]], this may be used with either | (def ^{:arglists '([queryable]
[connectable queryable]
[connectable modelable queryable]
[connectable query-type modelable queryable])}
query-one
(query*
(fn [query-type parsed-args]
(let [rf (pipeline/default-rf query-type)
xform (pipeline/first-result-xform-fn query-type)]
(pipeline/transduce-parsed (xform rf) query-type parsed-args))))) |
[[with-call-count]] | |
Impl for [[with-call-count]] macro; don't call this directly. | (defn ^:no-doc do-with-call-counts
[f]
(let [call-count (atom 0)
old-thunk pipeline/*call-count-thunk*]
(binding [pipeline/*call-count-thunk* (fn []
(when old-thunk
(old-thunk))
(swap! call-count inc))]
(f (fn [] @call-count))))) |
Execute ```clj (with-call-count [call-count] (select ...) (println "CALLS:" (call-count)) (insert! ...) (println "CALLS:" (call-count))) ;; -> CALLS: 1 ;; -> CALLS: 2 ``` | (defmacro with-call-count [[call-count-fn-binding] & body] `(do-with-call-counts (^:once fn* [~call-count-fn-binding] ~@body))) |
(s/fdef with-call-count
:args (s/cat :bindings (s/spec (s/cat :call-count-binding symbol?))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.honeysql2 (:require [better-cond.core :as b] [clojure.string :as str] [honey.sql :as hsql] [honey.sql.helpers :as hsql.helpers] [methodical.core :as m] [toucan2.instance :as instance] [toucan2.log :as log] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.query :as query] [toucan2.util :as u])) | |
Default global options to pass to [[honey.sql/format]]. | (defonce global-options
(atom {:quoted true, :dialect :ansi, :quoted-snake true})) |
Option override when to pass to [[honey.sql/format]]. | (def ^:dynamic *options* nil) |
Get combined Honey SQL options for building and compiling queries by merging [[global-options]] and [[options]]. | (defn options
[]
(merge @global-options
*options*)) |
Building queries | |
(defn- fn-condition->honeysql-where-clause
[k [f & args]]
{:pre [(keyword? f) (seq args)]}
(into [f k] args)) | |
Something sequential like | (defn condition->honeysql-where-clause
[k v]
;; don't think there's any situation where `nil` on the LHS is on purpose and not a bug.
{:pre [(some? k)]}
(if (sequential? v)
(fn-condition->honeysql-where-clause k v)
[:= k v])) |
(m/defmethod query/apply-kv-arg [#_model :default #_query clojure.lang.IPersistentMap #_k :default]
"Apply key-value args to a Honey SQL 2 query map."
[_model honeysql k v]
(log/debugf "apply kv-arg %s %s" k v)
(let [result (update honeysql :where (fn [existing-where]
(:where (hsql.helpers/where existing-where
(condition->honeysql-where-clause k v)))))]
(log/tracef "=> %s" result)
result)) | |
Build an Honey SQL | (defn table-and-alias
[model]
(b/cond
:let [table-id (keyword (model/table-name model))
alias-id (model/namespace model)
alias-id (when alias-id
(keyword alias-id))]
alias-id
[table-id alias-id]
:else
[table-id])) |
Qualify the (plain keyword) columns in [model & columns] forms with the model table name, unless they are already qualified. This apparently doesn't hurt anything and prevents ambiguous column errors if you're joining another column or something like that. I wasn't going to put this in at first since I forgot it existed, but apparently Toucan 1 did it (despite not being adequately tested) so I decided to preserve this behavior going forward since I can't see any downsides to it. In Honey SQL 2 I think using keyword namespaces is the preferred way to qualify stuff, so we'll go that route
instead of using | |
(defn- qualified? [column]
(or (namespace column)
(str/includes? (name column) "."))) | |
(defn- maybe-qualify [column table]
(cond
(not (keyword? column)) column
(qualified? column) column
:else (keyword (name table) (name column)))) | |
(defn- maybe-qualify-columns [columns [table-id alias-id]]
(let [table (or alias-id table-id)]
(assert (keyword? table))
(mapv #(maybe-qualify % table)
columns))) | |
Should we splice in the default | (defn include-default-select?
[honeysql-query]
(every? (fn [k]
(not (contains? honeysql-query k)))
[:union :union-all :select :select-distinct])) |
Should we splice in the default | (defn- include-default-from?
[honeysql-query]
(every? (fn [k]
(not (contains? honeysql-query k)))
[:union :union-all])) |
(m/defmethod pipeline/build [#_query-type :default
#_model :default
#_resolved-query clojure.lang.IPersistentMap]
"Base map backend implementation. Applies the `:kv-args` in `parsed-args` using [[query/apply-kv-args]], and ignores
other parsed args."
[query-type model {:keys [kv-args], :as parsed-args} m]
(let [m (query/apply-kv-args model m kv-args)]
(next-method query-type model (dissoc parsed-args :kv-args) m))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.*
#_model :default
#_query clojure.lang.IPersistentMap]
"Build a Honey SQL 2 SELECT query."
[query-type model {:keys [columns], :as parsed-args} resolved-query]
(log/debugf "Building SELECT query for %s with columns %s" model columns)
(let [parsed-args (dissoc parsed-args :columns)
table+alias (table-and-alias model)
resolved-query (-> (merge
(when (include-default-select? resolved-query)
{:select (or (some-> (not-empty columns) (maybe-qualify-columns table+alias))
[:*])})
(when (and model
(include-default-from? resolved-query))
{:from [table+alias]})
resolved-query)
(with-meta (meta resolved-query)))]
(log/debugf "=> %s" resolved-query)
(next-method query-type model parsed-args resolved-query))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.count
#_model :default
#_query clojure.lang.IPersistentMap]
"Build an efficient `count(*)` query to power [[toucan2.select/count]]."
[query-type model parsed-args resolved-query]
(let [parsed-args (assoc parsed-args :columns [[:%count.* :count]])]
(next-method query-type model parsed-args resolved-query))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.exists
#_model :default
#_query clojure.lang.IPersistentMap]
"Build an efficient query like `SELECT exists(SELECT 1 FROM ...)` query to power [[toucan2.select/exists?]]."
[query-type model parsed-args resolved-query]
(let [parsed-args (assoc parsed-args :columns [[[:inline 1]]])
subselect (next-method query-type model parsed-args resolved-query)]
{:select [[[:exists subselect] :exists]]})) | |
(defn- empty-insert [_model dialect]
(if (#{:mysql :mariadb} dialect)
{:columns []
:values [[]]}
{:values :default})) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/insert.*
#_model :default
#_query clojure.lang.IPersistentMap]
"Build a Honey SQL 2 INSERT query.
if `rows` is just a single empty row then insert it with
```sql
INSERT INTO table DEFAULT VALUES
```
(Postgres/H2/etc.)
or
```sql
INSERT INTO table () VALUES ()
```
(MySQL/MariaDB)"
[query-type model parsed-args resolved-query]
(log/debugf "Building INSERT query for %s" model)
(let [rows (some (comp not-empty :rows) [parsed-args resolved-query])
built-query (-> (merge {:insert-into [(keyword (model/table-name model))]}
(if (= rows [{}])
(empty-insert model (:dialect (options)))
{:values (map (partial instance/instance model)
rows)}))
(with-meta (meta resolved-query)))]
(log/debugf "=> %s" built-query)
;; rows is only added so we can get the default methods' no-op logic if there are no rows at all.
(next-method query-type model (assoc parsed-args :rows rows) built-query))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/update.*
#_model :default
#_query clojure.lang.IPersistentMap]
"Build a Honey SQL 2 UPDATE query."
[query-type model {:keys [kv-args changes], :as parsed-args} conditions-map]
(log/debugf "Building UPDATE query for %s" model)
(let [parsed-args (assoc parsed-args :kv-args (merge kv-args conditions-map))
built-query (-> {:update (table-and-alias model)
:set changes}
(with-meta (meta conditions-map)))]
(log/debugf "=> %s" built-query)
;; `:changes` are added to `parsed-args` so we can get the no-op behavior in the default method.
(next-method query-type model (assoc parsed-args :changes changes) built-query))) | |
For building a SELECT query using the args passed to something like [[toucan2.update/update!]]. This is needed to implement [[toucan2.tools.before-update]]. The main syntax difference is a map 'resolved-query' is supposed to be treated as a conditions map for update instead of as a raw Honey SQL query. TODO -- a conditions map should probably not be given a type of | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.instances.from-update
#_model :default
#_query clojure.lang.IPersistentMap]
"Treat the resolved query as a conditions map but otherwise behave the same as the `:toucan.query-type/select.instances`
impl."
[query-type model parsed-args conditions-map]
(next-method query-type model (update parsed-args :kv-args #(merge % conditions-map)) {})) | |
Build the correct | (defn- delete-from
[table+alias dialect]
(if (= (count table+alias) 1)
{:delete-from table+alias}
(let [[_table table-alias] table+alias]
(if (#{:mysql :mariadb} dialect)
{:delete table-alias
:from [table+alias]}
{:delete-from table+alias})))) |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/delete.*
#_model :default
#_query clojure.lang.IPersistentMap]
"Build a Honey SQL 2 DELETE query.
If the table for `model` should not be aliased (i.e., [[toucan2.model/namespace]] returns `nil`), builds a query that
compiles to something like:
```sql
DELETE FROM my_table
WHERE ...
```
If the table is aliased, this looks like
```sql
DELETE FROM my_table AS t1
WHERE ...
```
for Postgres/H2/etc., or like
```sql
DELETE t1
FROM my_table AS t1
WHERE ...
```
for MySQL/MariaDB. MySQL/MariaDB does not seem to support aliases in `DELETE FROM`, so we need to use this alternative
syntax; H2 doesn't support it however. So it has to be compiled differently based on the DB."
[query-type model parsed-args resolved-query]
(log/debugf "Building DELETE query for %s" model)
(let [built-query (-> (merge (delete-from (table-and-alias model) (:dialect (options)))
resolved-query)
(with-meta (meta resolved-query)))]
(log/debugf "=> %s" built-query)
(next-method query-type model parsed-args built-query))) | |
Query compilation | |
(m/defmethod pipeline/compile [#_query-type :default
#_model :default
#_query clojure.lang.IPersistentMap]
"Compile a Honey SQL 2 map to [sql & args]."
[query-type model honeysql]
(let [options-map (options)
_ (log/debugf "Compiling Honey SQL 2 with options %s" options-map)
sql-args (u/try-with-error-context ["compile Honey SQL to SQL" {::honeysql honeysql, ::options-map options-map}]
(hsql/format honeysql options-map))]
(log/debugf "=> %s" sql-args)
(pipeline/compile query-type model sql-args))) | |
Implementation of [[insert!]]. The code for building an INSERT query as Honey SQL lives in [[toucan2.honeysql2]] | (ns toucan2.insert (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.query :as query])) |
(s/def ::kv-args
(s/+ (s/cat
:k keyword?
:v any?))) | |
(s/def ::args.rows
(s/alt :nil nil?
:single-row-map map?
:multiple-row-maps (s/spec (s/* map?))
:kv-pairs ::kv-args
:columns-rows (s/cat :columns (s/spec (s/+ keyword?))
:rows (s/spec (s/+ sequential?))))) | |
(s/def ::args
(s/cat
:connectable ::query/default-args.connectable
:modelable ::query/default-args.modelable
:rows-or-queryable (s/alt :rows ::args.rows
:queryable some?))) | |
(m/defmethod query/parse-args :toucan.query-type/insert.*
"Default args parsing method for [[toucan2.insert/insert!]]. Uses the spec `:toucan2.insert/args`."
[query-type unparsed-args]
(let [parsed (query/parse-args-with-spec query-type ::args unparsed-args)
[rows-queryable-type rows-queryable] (:rows-or-queryable parsed)
parsed (select-keys parsed [:modelable :columns :connectable])]
(case rows-queryable-type
:queryable
(assoc parsed :queryable rows-queryable)
:rows
(assoc parsed :rows (let [[rows-type x] rows-queryable]
(condp = rows-type
:nil nil
:single-row-map [x]
:multiple-row-maps x
:kv-pairs [(into {} (map (juxt :k :v)) x)]
:columns-rows (let [{:keys [columns rows]} x]
(map (partial zipmap columns)
rows)))))))) | |
(defn- can-skip-insert? [parsed-args resolved-query]
(and (empty? (:rows parsed-args))
;; don't try to optimize out stuff like identity query.
(or (and (map? resolved-query)
(empty? (:rows resolved-query)))
(nil? resolved-query)))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/insert.*
#_model :default
#_resolved-query :default]
"Default INSERT query method. No-ops if there are no `:rows` to insert in either `parsed-args` or `resolved-query`."
[query-type model parsed-args resolved-query]
(let [rows (some (comp not-empty :rows) [parsed-args resolved-query])]
(if (can-skip-insert? parsed-args resolved-query)
(do
(log/debugf "Query has no changes, skipping update")
::pipeline/no-op)
(do
(log/debugf "Inserting %s rows into %s" (if (seq rows) (count rows) "?") model)
(next-method query-type model parsed-args resolved-query))))) | |
Insert a row or rows into the database. Returns the number of rows inserted. This function is pretty flexible in what it accepts: Insert a single row with key-value args: ```clj (t2/insert! :models/venues :name "Grant & Green", :category "bar") ``` Insert a single row as a map: ```clj (t2/insert! :models/venues {:name "Grant & Green", :category "bar"}) ``` Insert multiple row maps: ```clj (t2/insert! :models/venues [{:name "Grant & Green", :category "bar"} {:name "Savoy Tivoli", :category "bar"}]) ``` Insert rows with a vector of column names and a vector of value maps: ```clj (t2/insert! :models/venues [:name :category] [["Grant & Green" "bar"] ["Savoy Tivoli" "bar"]]) ``` As with other Toucan 2 functions, you can optionally pass a connectable if you pass Named connectables can also be used to define the rows: ```clj (t2/define-named-query ::named-rows {:rows [{:name "Grant & Green", :category "bar"} {:name "North Beach Cantina", :category "restaurant"}]}) (t2/insert! :models/venues ::named-rows) ``` | (defn insert!
{:arglists '([modelable row-or-rows-or-queryable]
[modelable k v & more]
[modelable columns row-vectors]
[:conn connectable modelable row-or-rows]
[:conn connectable modelable k v & more]
[:conn connectable modelable columns row-vectors])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/insert.update-count unparsed-args)) |
Like [[insert!]], but returns a vector of the primary keys of the newly inserted rows rather than the number of rows
inserted. The primary keys are determined by [[model/primary-keys]]. For models with a single primary key, this
returns a vector of single values, e.g. | (defn insert-returning-pks!
{:arglists '([modelable row-or-rows-or-queryable]
[modelable k v & more]
[modelable columns row-vectors]
[:conn connectable modelable row-or-rows]
[:conn connectable modelable k v & more]
[:conn connectable modelable columns row-vectors])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/insert.pks unparsed-args)) |
Like [[insert-returning-pks!]], but for one-row insertions. For models with a single primary key, this returns just the
new primary key as a scalar value (e.g. | (defn insert-returning-pk!
{:arglists '([modelable row-or-rows-or-queryable]
[modelable k v & more]
[modelable columns row-vectors]
[:conn connectable modelable row-or-rows]
[:conn connectable modelable k v & more]
[:conn connectable modelable columns row-vectors])}
[& unparsed-args]
(first (apply insert-returning-pks! unparsed-args))) |
Like [[insert!]], but returns a vector of maps representing the inserted objects. | (defn insert-returning-instances!
{:arglists '([modelable-columns row-or-rows-or-queryable]
[modelable-columns k v & more]
[modelable-columns columns row-vectors]
[:conn connectable modelable-columns row-or-rows]
[:conn connectable modelable-columns k v & more]
[:conn connectable modelable-columns columns row-vectors])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/insert.instances unparsed-args)) |
Like [[insert-returning-instances!]], but for one-row insertions. Returns the inserted object as a map. | (defn insert-returning-instance!
{:arglists '([modelable row-or-rows-or-queryable]
[modelable k v & more]
[modelable columns row-vectors]
[:conn connectable modelable row-or-rows]
[:conn connectable modelable k v & more]
[:conn connectable modelable columns row-vectors])}
[& unparsed-args]
(first (apply insert-returning-instances! unparsed-args))) |
Toucan 2 instances are a custom map type that does two things regular maps do not do:
Normally a Toucan instance is considered equal to a plain map with the same current (via [[toucan2.protocols/current]]) value. It is considered equal to other instances if they have the same current value and their model is the same. | (ns toucan2.instance (:refer-clojure :exclude [instance?]) (:require clojure.core.protocols [potemkin :as p] [pretty.core :as pretty] [toucan2.protocols :as protocols] [toucan2.realize :as realize] [toucan2.util :as u])) |
(set! *warn-on-reflection* true) | |
For debugging purposes: whether to print the original version of an instance, in addition to the current version, when printing an [[instance]]. | (def ^:dynamic *print-original* false) |
True if Toucan instances need to implement [[protocols/IModel]], [[protocols/IWithModel]], and [[protocols/IRecordChanges]]. | (defn instance?
[x]
(and (clojure.core/instance? toucan2.protocols.IModel x)
(clojure.core/instance? toucan2.protocols.IWithModel x)
(clojure.core/instance? toucan2.protocols.IRecordChanges x))) |
True if ```clj (instance-of? ::bird (instance ::toucan {})) ; -> true (instance-of? ::toucan (instance ::bird {})) ; -> false ``` | (defn instance-of?
[model x]
(and (instance? x)
(isa? (protocols/model x) model))) |
Changes between | (defn- changes*
[original current]
(if (or (not (map? original))
(not (map? current)))
current
(not-empty
(into
(empty original)
(map (fn [k]
(let [original-value (get original k ::not-found)
current-value (get current k)]
(when-not (= original-value current-value)
[k current-value]))))
(keys current))))) |
(declare ->TransientInstance) | |
(p/def-map-type Instance [model
^clojure.lang.IPersistentMap orig
^clojure.lang.IPersistentMap m
mta]
(get [_ k default-value]
(get m k default-value))
(assoc [this k v]
(let [m' (assoc m k v)]
(if (identical? m m')
this
(Instance. model orig m' mta))))
(dissoc [this k]
(let [m' (dissoc m k)]
(if (identical? m m')
this
(Instance. model orig m' mta))))
(keys [_this]
(keys m))
(meta [_this]
mta)
(with-meta [this new-meta]
(if (identical? mta new-meta)
this
(Instance. model orig m new-meta)))
clojure.lang.IPersistentCollection
(cons [this o]
(cond
(map? o)
(reduce #(apply assoc %1 %2) this o)
(clojure.core/instance? java.util.Map o)
(reduce
#(apply assoc %1 %2)
this
(into {} o))
:else
(if-let [[k v] (seq o)]
(assoc this k v)
this)))
(equiv [_this another]
(cond
(clojure.core/instance? toucan2.protocols.IModel another)
(and (= model (protocols/model another))
(= m another))
(map? another)
(= m another)
:else
false))
(empty [_this]
(Instance. model (empty orig) (empty m) mta))
java.util.Map
(containsKey [_this k]
(.containsKey m k))
clojure.lang.IEditableCollection
(asTransient [_this]
(->TransientInstance model (transient m) mta))
clojure.lang.IKVReduce
(kvreduce [_this f init]
(clojure.core.protocols/kv-reduce m f init))
protocols/IModel
(protocols/model [_this]
model)
protocols/IWithModel
(with-model [this new-model]
(if (= model new-model)
this
(Instance. new-model orig m mta)))
protocols/IRecordChanges
(original [_this]
orig)
(with-original [this new-original]
(if (identical? orig new-original)
this
(let [new-original (if (nil? new-original)
{}
new-original)]
(assert (map? new-original))
(Instance. model new-original m mta))))
(current [_this]
m)
(with-current [this new-current]
(if (identical? m new-current)
this
(let [new-current (if (nil? new-current)
{}
new-current)]
(assert (map? new-current))
(Instance. model orig new-current mta))))
(changes [_this]
(not-empty (changes* orig m)))
protocols/IDispatchValue
(dispatch-value [_this]
(protocols/dispatch-value model))
realize/Realize
(realize [_this]
(if (identical? orig m)
(let [m (realize/realize m)]
(Instance. model m m mta))
(Instance. model (realize/realize orig) (realize/realize m) mta)))
pretty/PrettyPrintable
(pretty [_this]
(if *print-original*
(list `instance model (symbol "#_") orig m)
(list `instance model m)))) | |
(deftype ^:no-doc TransientInstance [model ^clojure.lang.ITransientMap m mta]
clojure.lang.ITransientMap
(conj [this v]
(let [m' (conj! m v)]
(if (identical? m m')
this
(TransientInstance. model m' mta))))
(persistent [_this]
(let [m (persistent! m)]
(Instance. model m m mta)))
(assoc [this k v]
(let [m' (assoc! m k v)]
(if (identical? m m')
this
(TransientInstance. model m' mta))))
(without [this k]
(let [m' (dissoc! m k)]
(if (identical? m m')
this
(TransientInstance. model m' mta))))
(valAt [_this k]
(.valAt m k))
(valAt [_this k not-found]
(.valAt m k not-found))
(count [_this]
(count m))
clojure.lang.Associative
(containsKey [_this k]
(contains? m k))
pretty/PrettyPrintable
(pretty [_this]
(list `->TransientInstance model m mta))) | |
Create a new Toucan 2 instance. See the namespace docstring for [[toucan2.instance]] for more information about what a Toucan 2 instance is. This function has several arities:
| (defn instance
(^toucan2.instance.Instance []
(instance nil))
(^toucan2.instance.Instance [model]
(instance model {}))
(^toucan2.instance.Instance [model m]
(assert ((some-fn map? nil?) m)
(format "Expected a map or nil, got ^%s %s" (.getCanonicalName (class m)) (pr-str m)))
(cond
;; optimization: if `m` is already an instance with `model` return it as-is.
(and (instance? m)
(= (protocols/model m) model))
m
;; DISABLED FOR NOW BECAUSE MAYBE THE OTHER MODEL HAS A DIFFERENT UNDERLYING EMPTY MAP OR KEY TRANSFORM
;;
;; ;; optimization 2: if `m` is an instance of something else use [[protocols/with-model]]
;; (instance? m)
;; (protocols/with-model m model)
;; Strip any customizations, e.g. a different underlying empty map or key transform.
(u/custom-map? m)
(let [m* (into {} m)]
(->Instance model m* m* (meta m)))
:else
(->Instance model m m (meta m))))
(^toucan2.instance.Instance [model k v & more]
(let [m (into {} (partition-all 2) (list* k v more))]
(instance model m)))) |
(extend-protocol protocols/IWithModel
nil
(with-model [_this model]
(instance model))
clojure.lang.IPersistentMap
(with-model [m model]
(instance model m))) | |
Return a copy of | (defn reset-original
[an-instance]
(if (instance? an-instance)
(protocols/with-original an-instance (protocols/current an-instance))
an-instance)) |
TODO -- should we have a revert-changes helper function as well? | |
Applies | (defn update-original
([an-instance f]
(if (instance? an-instance)
(protocols/with-original an-instance (f (protocols/original an-instance)))
an-instance))
([an-instance f & args]
(if (instance? an-instance)
(protocols/with-original an-instance (apply f (protocols/original an-instance) args))
an-instance))) |
Applies | (defn update-current ([an-instance f] (protocols/with-current an-instance (f (protocols/current an-instance)))) ([an-instance f & args] (protocols/with-current an-instance (apply f (protocols/current an-instance) args)))) |
Like
| (defn update-original-and-current
([an-instance f]
(if (identical? (protocols/original an-instance) (protocols/current an-instance))
(reset-original (update-current an-instance f))
(as-> an-instance an-instance
(update-original an-instance f)
(update-current an-instance f))))
([an-instance f & args]
(if (identical? (protocols/original an-instance) (protocols/current an-instance))
(reset-original (apply update-current an-instance f args))
(as-> an-instance an-instance
(apply update-original an-instance f args)
(apply update-current an-instance f args))))) |
(ns toucan2.jdbc (:require [toucan2.jdbc.connection :as jdbc.conn] [toucan2.jdbc.pipeline :as jdbc.pipeline] [toucan2.protocols :as protocols])) | |
(comment jdbc.conn/keep-me
jdbc.pipeline/keep-me) | |
(set! *warn-on-reflection* true) | |
load the miscellaneous integrations | |
(defn- class-for-name ^Class [^String class-name]
(try
(Class/forName class-name)
(catch Throwable _))) | |
(when (class-for-name "org.postgresql.jdbc.PgConnection") (require 'toucan2.jdbc.postgres)) | |
(when (some class-for-name ["org.mariadb.jdbc.Connection"
"org.mariadb.jdbc.MariaDbConnection"
"com.mysql.cj.MysqlConnection"])
(require 'toucan2.jdbc.mysql-mariadb)) | |
c3p0 and Hikari integration: when we encounter a wrapped connection pool connection, dispatch off of the class of connection it wraps | (doseq [pool-connection-class-name ["com.mchange.v2.c3p0.impl.NewProxyConnection"
"com.zaxxer.hikari.pool.HikariProxyConnection"]]
(when-let [pool-connection-class (class-for-name pool-connection-class-name)]
(extend pool-connection-class
protocols/IDispatchValue
{:dispatch-value (fn [^java.sql.Wrapper conn]
(try
(protocols/dispatch-value (.unwrap conn java.sql.Connection))
(catch Throwable _
pool-connection-class)))}))) |
(ns toucan2.jdbc.connection (:require [methodical.core :as m] [next.jdbc] [next.jdbc.transaction] [toucan2.connection :as conn] [toucan2.log :as log])) | |
(set! *warn-on-reflection* true) | |
(m/defmethod conn/do-with-connection java.sql.Connection [conn f] (f conn)) | |
(m/defmethod conn/do-with-connection javax.sql.DataSource
[^javax.sql.DataSource data-source f]
(with-open [conn (.getConnection data-source)]
(f conn))) | |
(m/defmethod conn/do-with-connection clojure.lang.IPersistentMap "Implementation for map connectables. Treats them as a `clojure.java.jdbc`-style connection spec map, converting them to a `java.sql.DataSource` with [[next.jdbc/get-datasource]]." [m f] (conn/do-with-connection (next.jdbc/get-datasource m) f)) | |
for record types that implement | (m/prefer-method! #'conn/do-with-connection javax.sql.DataSource clojure.lang.IPersistentMap) |
jdbc | (m/defmethod conn/do-with-connection-string
"Implementation of `do-with-connection-string` (and thus [[do-with-connection]]) for all strings starting with `jdbc:`.
Calls `java.sql.DriverManager/getConnection` on the connection string."
[^String connection-string f]
(with-open [conn (java.sql.DriverManager/getConnection connection-string)]
(f conn))) |
(m/defmethod conn/do-with-transaction java.sql.Connection
[^java.sql.Connection conn options f]
(let [nested-tx-rule (get options :nested-transaction-rule next.jdbc.transaction/*nested-tx*)
options (dissoc options :nested-transaction-rule)]
(log/debugf "do with JDBC transaction (nested rule: %s) with options %s" nested-tx-rule options)
(binding [next.jdbc.transaction/*nested-tx* nested-tx-rule]
(next.jdbc/with-transaction [t-conn conn options]
(f t-conn))))) | |
MySQL and MariaDB integration (mostly workarounds for broken stuff). | (ns toucan2.jdbc.mysql-mariadb (:require [methodical.core :as m] [toucan2.jdbc.options :as jdbc.options] [toucan2.jdbc.read :as jdbc.read] [toucan2.jdbc.result-set :as jdbc.rs] [toucan2.log :as log] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.util :as u]) (:import (java.sql ResultSet ResultSetMetaData Types))) |
(set! *warn-on-reflection* true) | |
TODO -- need the MySQL class here too. | |
(doseq [^String connection-class-name ["org.mariadb.jdbc.Connection"
"org.mariadb.jdbc.MariaDbConnection"
"com.mysql.cj.MysqlConnection"]]
(when-let [connection-class (try
(Class/forName connection-class-name)
(catch Throwable _))]
(derive connection-class ::connection))) | |
(m/defmethod jdbc.read/read-column-thunk [#_conn ::connection
#_model :default
#_type Types/TIMESTAMP]
"MySQL/MariaDB `timestamp` is normalized to UTC, so return it as an `OffsetDateTime` rather than a `LocalDateTime`.
`datetime` columns should be returned as `LocalDateTime`. Both `timestamp` and `datetime` seem to come back as
`java.sql.Types/TIMESTAMP`, so check the actual database column type name so we can fetch objects as the correct
class."
[_conn _model ^ResultSet rset ^ResultSetMetaData rsmeta ^Long i]
(let [^Class klass (if (= (u/lower-case-en (.getColumnTypeName rsmeta i)) "timestamp")
java.time.OffsetDateTime
java.time.LocalDateTime)]
(jdbc.read/get-object-of-class-thunk rset i klass))) | |
(m/prefer-method! #'jdbc.read/read-column-thunk
[::connection :default Types/TIMESTAMP]
[java.sql.Connection :default Types/TIMESTAMP]) | |
INSERT RETURNGENERATEDKEYS with explicit non-integer PK value workaround | |
(m/defmethod pipeline/transduce-execute-with-connection [#_conn ::connection
#_query-type :toucan.query-type/insert.pks
#_model :default]
"Apparently `RETURN_GENERATED_KEYS` doesn't work for MySQL/MariaDB if:
1. Values for the primary key are specified in the INSERT itself, *and*
2. The primary key is not an integer.
So to work around this we will look at the rows we're inserting: if every rows specifies the primary key
column(s) (including `nil` values), we'll transduce those specified values rather than what JDBC returns.
This seems like it won't work if these values were arbitrary Honey SQL expressions. I suppose we could work around
THAT problem by running the primary key values thru another SELECT query... but that just seems like too much. I guess
we can cross that bridge when we get there."
[rf conn query-type model compiled-query]
(let [rows (:rows pipeline/*parsed-args*)
pks (model/primary-keys model)
return-pks-directly? (and (seq rows)
(every? (fn [row]
(every? (fn [k]
(contains? row k))
pks))
rows))]
(if return-pks-directly?
(do
(pipeline/transduce-execute-with-connection (pipeline/default-rf :toucan.query-type/insert.update-count)
conn
:toucan.query-type/insert.update-count
model
compiled-query)
(transduce
(map (model/select-pks-fn model))
rf
rows))
(next-method rf conn query-type model compiled-query)))) | |
(m/prefer-method! #'pipeline/transduce-execute-with-connection
[::connection :toucan.query-type/insert.pks :default]
[java.sql.Connection :toucan.result-type/pks :default]) | |
UPDATE returning PKs workaround | |
MySQL and MariaDB don't support returning PKs for UPDATE, so we'll have to hack it as follows:
| |
(m/defmethod pipeline/transduce-execute-with-connection [#_connection ::connection
#_query-type :toucan.query-type/update.pks
#_model :default]
"MySQL and MariaDB don't support returning PKs for UPDATE. Execute a SELECT query to capture the PKs of the rows that
will be affected BEFORE performing the UPDATE. We need to capture PKs for both `:toucan.query-type/update.pks` and for
`:toucan.query-type/update.instances`, since ultimately the latter is implemented on top of the former."
[original-rf conn _query-type model sql-args]
;; if for some reason we've already captured PKs, don't do it again.
(let [conditions-map pipeline/*resolved-query*
_ (log/debugf "update-returning-pks workaround: doing SELECT with conditions %s"
conditions-map)
parsed-args (update pipeline/*parsed-args* :kv-args merge conditions-map)
select-rf (pipeline/with-init conj [])
xform (map (model/select-pks-fn model))
pks (pipeline/transduce-query (xform select-rf)
:toucan.query-type/select.instances.fns
model
parsed-args
{})]
(log/debugf "update-returning-pks workaround: got PKs %s" pks)
(let [update-rf (pipeline/default-rf :toucan.query-type/update.update-count)]
(log/debugf "update-returning-pks workaround: performing original UPDATE")
(pipeline/transduce-execute-with-connection update-rf conn :toucan.query-type/update.update-count model sql-args))
(log/debugf "update-returning-pks workaround: transducing PKs with original reducing function")
(transduce
identity
original-rf
pks))) | |
(m/prefer-method! #'pipeline/transduce-execute-with-connection
[::connection :toucan.query-type/update.pks :default]
[java.sql.Connection :toucan.result-type/pks :default]) | |
Builder function | |
(m/defmethod jdbc.rs/builder-fn [::connection :default]
"This is an icky hack for MariaDB/MySQL. Inserted rows come back with the newly inserted ID as `:insert-id` rather than
the actual name of the primary key column. So tweak the `:label-fn` we pass to `next.jdbc` to rename `:insert-id` to
the actual PK name we'd expect. This only works for tables with a single-column PK."
[conn model rset opts]
(let [opts (jdbc.options/merge-options opts)
label-fn (get opts :label-fn name)
model-pks (model/primary-keys model)
insert-id-label-fn (if (= (count model-pks) 1)
(fn [label]
(if (= label "insert_id")
(let [pk (first model-pks)
;; there is some weirdness afoot. If we return a keyword without a namespace
;; then `next.jdbc` seems to qualify it regardless of whether the
;; `:qualifier-fn` returns `nil` or not -- so a PK like `:id` gets returned
;; as `(keyword "id")`. But that doesn't happen if the label function
;; returns a String.
;;
;; It seems like returning a string is the preferred thing to do, but in some
;; cases [[model/primary-keys]] returns a namespaced keyword, and we want to
;; preserve that namespace; `next.jdbc` does not try to change keywords that
;; already have namespaces.
;;
;; So return the PK name as a keyword if the PK keyword is namespaced;
;; otherwise return a string.
pk (if (namespace pk)
pk
(name pk))]
(log/debugf "MySQL/MariaDB inserted ID workaround: fetching insert_id as %s" pk)
pk)
label))
identity)
label-fn' (comp label-fn insert-id-label-fn)]
(next-method conn model rset (assoc opts :label-fn label-fn')))) | |
(ns toucan2.jdbc.options (:require [toucan2.util :as u])) | |
Default options automatically passed to all | (defonce global-options
(atom {:label-fn u/lower-case-en})) |
Options to pass to | (def ^:dynamic *options* nil) |
Merge maps of | (defn merge-options
[extra-options]
(merge @global-options
*options*
extra-options)) |
(ns toucan2.jdbc.pipeline (:require [methodical.core :as m] [toucan2.jdbc.query :as jdbc.query] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.types :as types])) | |
(m/defmethod pipeline/transduce-execute-with-connection [#_connection java.sql.Connection
#_query-type :default
#_model :default]
"Default impl for the JDBC query execution backend."
[rf conn query-type model sql-args]
{:pre [(sequential? sql-args) (string? (first sql-args))]}
;; `:return-keys` is passed in this way instead of binding a dynamic var because we don't want any additional queries
;; happening inside of the `rf` to return keys or whatever.
(let [extra-options (when (isa? query-type :toucan.result-type/pks)
{:return-keys true})
result (jdbc.query/reduce-jdbc-query rf (rf) conn model sql-args extra-options)]
(rf result))) | |
(m/defmethod pipeline/transduce-execute-with-connection [#_connection java.sql.Connection
#_query-type :toucan.result-type/pks
#_model :default]
"JDBC query execution backend for executing queries that return PKs (`:toucan.result-type/pks`).
Applies transducer to call [[toucan2.model/select-pks-fn]] on each result row."
[rf conn query-type model sql-args]
(let [xform (map (model/select-pks-fn model))]
(next-method (xform rf) conn query-type model sql-args))) | |
(defn- transduce-instances-from-pks
[rf model columns pks]
;; make sure [[toucan2.select]] is loaded so we get the impls for `:toucan.query-type/select.instances`
(when-not (contains? (loaded-libs) 'toucan2.select)
(locking clojure.lang.RT/REQUIRE_LOCK
(require 'toucan2.select)))
(if (empty? pks)
[]
(let [kv-args {:toucan/pk [:in pks]}
parsed-args {:columns columns
:kv-args kv-args}]
(pipeline/transduce-query rf :toucan.query-type/select.instances-from-pks model parsed-args {})))) | |
(derive ::DML-queries-returning-instances :toucan.result-type/instances) | |
(doseq [query-type [:toucan.query-type/delete.instances
:toucan.query-type/update.instances
:toucan.query-type/insert.instances]]
(derive query-type ::DML-queries-returning-instances)) | |
(m/defmethod pipeline/transduce-execute-with-connection [#_connection java.sql.Connection
#_query-type ::DML-queries-returning-instances
#_model :default]
"DML queries like `UPDATE` or `INSERT` don't usually support returning instances, at least not with JDBC. So for these
situations we'll fake it by first running an equivalent query returning inserted/affected PKs, and then do a
subsequent SELECT to get those rows. Then we'll reduce the rows with the original reducing function."
[rf conn query-type model sql-args]
;; We're using `conj` here instead of `rf` so no row-transform nonsense or whatever is done. We will pass the
;; actual instances to the original `rf` once we get them.
(let [pk-query-type (types/similar-query-type-returning query-type :toucan.result-type/pks)
pks (pipeline/transduce-execute-with-connection conj conn pk-query-type model sql-args)
;; this is sort of a hack but I don't know of any other way to pass along `:columns` information with the
;; original parsed args
columns (:columns pipeline/*parsed-args*)]
;; once we have a sequence of PKs then get instances as with `select` and do our magic on them using the
;; ORIGINAL `rf`.
(transduce-instances-from-pks rf model columns pks))) | |
PostgreSQL integration. | (ns toucan2.jdbc.postgres (:require [methodical.core :as m] [toucan2.jdbc.read :as jdbc.read] [toucan2.util :as u]) (:import (java.sql ResultSet ResultSetMetaData Types))) |
(set! *warn-on-reflection* true) | |
(when-let [pg-connection-class (try
(Class/forName "org.postgresql.jdbc.PgConnection")
(catch Throwable _
nil))]
(derive pg-connection-class ::connection)) | |
(m/defmethod jdbc.read/read-column-thunk [#_conn ::connection
#_model :default
#_type Types/TIMESTAMP]
"Both Postgres `timestamp` and `timestamp with time zone` come back as `java.sql.Types/TIMESTAMP`; check the actual
database column type name so we can fetch objects as the correct class."
[_conn _model ^ResultSet rset ^ResultSetMetaData rsmeta ^Long i]
(let [^Class klass (if (= (u/lower-case-en (.getColumnTypeName rsmeta i)) "timestamptz")
java.time.OffsetDateTime
java.time.LocalDateTime)]
(jdbc.read/get-object-of-class-thunk rset i klass))) | |
(m/prefer-method! #'jdbc.read/read-column-thunk
[::connection :default Types/TIMESTAMP]
[java.sql.Connection :default Types/TIMESTAMP]) | |
(ns ^:no-doc toucan2.jdbc.query (:require [next.jdbc] [toucan2.jdbc.options :as jdbc.options] [toucan2.jdbc.result-set :as jdbc.rs] [toucan2.log :as log] [toucan2.util :as u]) (:import java.sql.ResultSet)) | |
(set! *warn-on-reflection* true) | |
TODO: it's a little silly having a one-function namespace. Maybe we should move this into one other ones | |
We normally only read in a forward direction, and treat result sets as read-only. So make sure the JDBC can optimize
things when possible. Note that you're apparently not allowed to do this when | (def ^:private read-forward-options
{:concurrency :read-only
:cursors :close
:result-type :forward-only}) |
Execute | (defn ^:no-doc reduce-jdbc-query
[rf init ^java.sql.Connection conn model sql-args extra-options]
{:pre [(instance? java.sql.Connection conn) (sequential? sql-args) (string? (first sql-args)) (ifn? rf)]}
(let [opts (jdbc.options/merge-options extra-options)
opts (merge (when-not (:return-keys opts)
read-forward-options)
opts)]
(log/debugf "Preparing JDBC query with next.jdbc options %s" opts)
(u/try-with-error-context [(format "execute SQL with %s" (class conn)) {::sql-args sql-args}]
(with-open [stmt (next.jdbc/prepare conn sql-args opts)]
(when-not (= (.getFetchDirection stmt) ResultSet/FETCH_FORWARD)
(try
(.setFetchDirection stmt ResultSet/FETCH_FORWARD)
(catch Throwable e
(log/debugf e "Error setting fetch direction"))))
(log/tracef "Executing statement with %s" (class conn))
(let [result-set? (.execute stmt)]
(cond
(:return-keys opts)
(do
(log/debugf "Query was executed with %s; returning generated keys" :return-keys)
(with-open [rset (.getGeneratedKeys stmt)]
(jdbc.rs/reduce-result-set rf init conn model rset opts)))
result-set?
(with-open [rset (.getResultSet stmt)]
(log/debugf "Query returned normal result set")
(jdbc.rs/reduce-result-set rf init conn model rset opts))
:else
(do
(log/debugf "Query did not return a ResultSet; nothing to reduce. Returning update count.")
(reduce rf init [(.getUpdateCount stmt)])))))))) |
[[read-column-thunk]] method, which is used to determine how to read values of columns in results, and default implementations | (ns toucan2.jdbc.read (:require [clojure.spec.alpha :as s] [methodical.core :as m] [next.jdbc.result-set :as next.jdbc.rs] [toucan2.log :as log] [toucan2.protocols :as protocols] [toucan2.types :as types] [toucan2.util :as u]) (:import (java.sql Connection ResultSet ResultSetMetaData Types))) |
(comment s/keep-me
types/keep-me) | |
(set! *warn-on-reflection* true) | |
Map of ```clj (type-name java.sql.Types/FLOAT) -> (type-name 6) -> "FLOAT" ``` arglists metadata is mostly so (theoretically) Kondo can catch if you try to call this with the wrong type or wrong number of args. | (def ^{:arglists '(^String [^Integer i] ^String [^Integer i not-found])} type-name
(into {} (for [^java.lang.reflect.Field field (.getDeclaredFields Types)]
[(.getLong field Types) (.getName field)]))) |
Return a zero-arg function that, when called, will fetch the value of the column from the current row. Dispatches on TODO -- dispatch for this method is busted.
| (m/defmulti read-column-thunk
{:arglists '([^Connection conn₁ model₂ ^ResultSet rset ^ResultSetMetaData rsmeta₍₃₎ ^Long i])
:defmethod-arities #{5}
:dispatch-value-spec (types/or-default-spec
(s/cat :connection-class ::types/dispatch-value.keyword-or-class
:model ::types/dispatch-value.model
:column-type any?))}
(fn [^Connection conn model _rset ^ResultSetMetaData rsmeta ^Long i]
(let [col-type (.getColumnType rsmeta i)]
(log/debugf
"Column %s %s is of JDBC type %s, native type %s"
i
(let [table-name (some->> (.getTableName rsmeta i) not-empty)
column-name (.getColumnLabel rsmeta i)]
(if table-name
(str table-name \. column-name)
column-name))
(symbol "java.sql.Types" (type-name col-type))
(.getColumnTypeName rsmeta i))
[(protocols/dispatch-value conn) (protocols/dispatch-value model) col-type]))) |
(m/defmethod read-column-thunk :default
[_conn _model ^ResultSet rset _rsmeta ^Long i]
(log/debugf "Fetching values in column %s with %s" i (list '.getObject 'rs i))
(fn default-read-column-thunk []
(log/tracef "col %s => %s" i (list '.getObject 'rset i))
(.getObject rset i))) | |
(m/defmethod read-column-thunk :after :default
[_conn model _rset _rsmeta thunk]
(fn []
(u/try-with-error-context ["read column" {:thunk thunk, :model model}]
(thunk)))) | |
Return a thunk that will be used to fetch values at column index ```clj (.getObject rset i klass) ``` but includes extra logging. | (defn get-object-of-class-thunk
[^ResultSet rset ^Long i ^Class klass]
(log/debugf
"Fetching values in column %s with %s"
i
(list '.getObject 'rs i klass))
(fn get-object-of-class-thunk []
;; what's the overhead of this? A million rows with 10 columns each = 10 million calls =(
;;
;; from Criterium: a no-op call takes about 20ns locally. So 10m rows => 200ms from this no-op call. That's a little
;; expensive, but probably not as bad as the overhead we get from other nonsense here in Toucan 2. We'll have to do
;; some general performance tuning in the future.
(log/tracef "col %s => %s" i (list '.getObject 'rset i klass))
(.getObject rset i klass))) |
Default column read methods | |
(m/defmethod read-column-thunk [:default :default Types/CLOB]
[_conn _model ^ResultSet rset _ ^Long i]
(fn get-string-thunk []
(.getString rset i))) | |
(m/defmethod read-column-thunk [:default :default Types/TIMESTAMP] [_conn _model rset _rsmeta i] (get-object-of-class-thunk rset i java.time.LocalDateTime)) | |
(m/defmethod read-column-thunk [:default :default Types/TIMESTAMP_WITH_TIMEZONE] [_conn _model rset _rsmeta i] (get-object-of-class-thunk rset i java.time.OffsetDateTime)) | |
(m/defmethod read-column-thunk [:default :default Types/DATE] [_conn _model rset _rsmeta i] (get-object-of-class-thunk rset i java.time.LocalDate)) | |
(m/defmethod read-column-thunk [:default :default Types/TIME] [_conn _model rset _rsmeta i] (get-object-of-class-thunk rset i java.time.LocalTime)) | |
(m/defmethod read-column-thunk [:default :default Types/TIME_WITH_TIMEZONE] [_conn _model rset _rsmeta i] (get-object-of-class-thunk rset i java.time.OffsetTime)) | |
(defn- make-column-thunk [conn model ^ResultSet rset i]
(log/tracef "Building thunk to read column %s" i)
(let [rsmeta (.getMetaData rset)
thunk (read-column-thunk conn model rset rsmeta i)]
(fn column-thunk []
(next.jdbc.rs/read-column-by-index (thunk) rsmeta i)))) | |
Given a connection | (defn ^:no-doc make-i->thunk
[conn model rset]
(comp (memoize (fn [i]
(make-column-thunk conn model rset i)))
int)) |
Given a ```clj (f builder rset i) => result ``` When this function is called with a The function used to fetch the column is built by combining [[read-column-thunk]] and [[next.jdbc.result-set/read-column-by-index]]; the function is built once and used repeatedly for each new row. | (defn ^:no-doc read-column-by-index-fn
[i->thunk]
(fn read-column-by-index-fn* [_builder ^ResultSet rset ^Integer i]
(assert (not (.isClosed ^ResultSet rset))
"ResultSet is already closed. Do you need call toucan2.realize/realize on the row before the Connection is closed?")
(let [thunk (i->thunk i)
result (thunk)]
(log/tracef "col %s => %s" i result)
result))) |
Implementation of a custom | (ns toucan2.jdbc.result-set (:require [better-cond.core :as b] [clojure.spec.alpha :as s] [methodical.core :as m] [next.jdbc.result-set :as next.jdbc.rs] [toucan2.instance :as instance] [toucan2.jdbc.options :as jdbc.options] [toucan2.jdbc.read :as jdbc.read] [toucan2.jdbc.row :as jdbc.row] [toucan2.log :as log] [toucan2.model :as model] [toucan2.types :as types] [toucan2.util :as u]) (:import (java.sql ResultSet ResultSetMetaData))) |
(set! *warn-on-reflection* true) | |
(comment s/keep-me
types/keep-me) | |
Return the | (m/defmulti builder-fn
{:arglists '([^java.sql.Connection conn₁ model₂ ^java.sql.ResultSet rset opts])
:defmethod-arities #{4}
:dispatch-value-spec (types/or-default-spec
(s/cat :conn ::types/dispatch-value.keyword-or-class
:model ::types/dispatch-value.model))}
u/dispatch-on-first-two-args) |
(defrecord ^:no-doc InstanceBuilder [model ^ResultSet rset ^ResultSetMetaData rsmeta cols]
next.jdbc.rs/RowBuilder
(->row [_this]
(log/tracef "Fetching row %s" (.getRow rset))
(transient (instance/instance model)))
(column-count [_this]
(count cols))
;; this is purposefully not implemented because we should never get here; if we do it is an error and we want an
;; Exception thrown.
#_(with-column [this row i]
(println (pr-str (list 'with-column 'this 'row i)))
(next.jdbc.rs/with-column-value this row (nth cols (dec i))
(next.jdbc.rs/read-column-by-index (.getObject rset ^Integer i) rsmeta i)))
(with-column-value [_this row col v]
(assert (some? col) "Invalid col")
(assoc! row col v))
(row! [_this row]
(log/tracef "Converting transient row to persistent row")
(persistent! row))
next.jdbc.rs/ResultSetBuilder
(->rs [_this]
(transient []))
(with-row [_this acc row]
(conj! acc row))
(rs! [_this acc]
(persistent! acc))) | |
(defn- make-column-name->index [cols label-fn]
{:pre [(fn? label-fn)]}
(if (empty? cols)
(constantly nil)
(memoize
(fn [column-name]
(when (or (string? column-name)
(instance? clojure.lang.Named column-name))
;; TODO FIXME -- it seems like the column name we get here has already went thru the label fn/qualifying
;; functions. The `(originally ...)` in the log message is wrong. Are we applying label function twice?!
(let [column-name' (keyword
(when (instance? clojure.lang.Named column-name)
(when-let [col-ns (namespace column-name)]
(label-fn (name col-ns))))
(label-fn (name column-name)))
i (when column-name'
(first (keep-indexed
(fn [i col]
(when (= col column-name')
(inc i)))
cols)))]
(log/tracef "Index of column named %s (originally %s) is %s" column-name' column-name i)
(when-not i
(log/debugf "Could not determine index of column name %s. Found: %s" column-name cols))
i)))))) | |
Create a result set map builder function appropriate for passing as the | (defn instance-builder-fn
[model ^ResultSet rset opts]
(let [table-name->ns (model/table-name->namespace model)
label-fn (get opts :label-fn name)
qualifier-fn (memoize
(fn [table]
(let [table (some-> table not-empty name label-fn)
table-ns (some-> (get table-name->ns table) name)]
(log/tracef "Using namespace %s for columns in table %s" table-ns table)
table-ns)))
opts (merge {:label-fn label-fn
:qualifier-fn qualifier-fn}
opts)
rsmeta (.getMetaData rset)
_ (log/debugf "Getting modified column names with next.jdbc options %s" opts)
col-names (next.jdbc.rs/get-modified-column-names rsmeta opts)]
(log/debugf "Column names: %s" col-names)
(constantly
(assoc (->InstanceBuilder model rset rsmeta col-names) :opts opts)))) |
(m/defmethod builder-fn :default
"Default `next.jdbc` builder function. Uses [[instance-builder-fn]] to return Toucan 2 instances."
[_conn model rset opts]
(let [merged-opts (jdbc.options/merge-options opts)]
(instance-builder-fn model rset merged-opts))) | |
Reduce a Part of the low-level implementation of the JDBC query execution backend -- you probably shouldn't be using this directly. | (defn ^:no-doc reduce-result-set
[rf init conn model ^ResultSet rset opts]
(log/debugf "Reduce JDBC result set for model %s with rf %s and init %s" model rf init)
(let [i->thunk (jdbc.read/make-i->thunk conn model rset)
builder-fn* (next.jdbc.rs/builder-adapter
(builder-fn conn model rset opts)
(jdbc.read/read-column-by-index-fn i->thunk))
builder (builder-fn* rset opts)
combined-opts (jdbc.options/merge-options (merge (:opts builder) opts))
label-fn (get combined-opts :label-fn)
_ (assert (fn? label-fn) "Options must include :label-fn")
col-names (get builder :cols (next.jdbc.rs/get-modified-column-names
(.getMetaData rset)
combined-opts))
col-name->index (make-column-name->index col-names label-fn)]
(log/tracef "column name -> index = %s" col-name->index)
(loop [acc init]
(b/cond
(not (.next rset))
(do
(log/tracef "Result set has no more rows.")
acc)
:let [_ (log/tracef "Fetch row %s" (.getRow rset))
row (jdbc.row/row model rset builder i->thunk col-name->index)
acc' (rf acc row)]
(reduced? acc')
@acc'
:else
(recur acc'))))) |
Custom [[TransientRow]] type. This is mostly in a separate namespace so I don't have to look at it when working on unrelated [[toucan2.jdbc.result-set]] stuff. This is roughly adapted from [[next.jdbc.result-set/mapify-result-set]] in a somewhat-successful attempt to make
Toucan 2 be | (ns ^:no-doc toucan2.jdbc.row (:require [better-cond.core :as b] [clojure.core.protocols :as core-p] [clojure.datafy :as d] [clojure.pprint :as pprint] [clojure.string :as str] [next.jdbc.result-set :as next.jdbc.rs] [puget.printer :as puget] [toucan2.instance :as instance] [toucan2.log :as log] [toucan2.protocols :as protocols] [toucan2.realize :as realize] [toucan2.util :as u]) (:import (java.sql ResultSet))) |
(set! *warn-on-reflection* true) | |
(declare print-representation-parts) | |
Fetch the column with | (defn- fetch-column-with-name
[column-name->index i->thunk column-name not-found]
;; this might get called with some other non-string or non-keyword key, in that case just return `not-found`
;; immediately since we're not going to find it by hitting the database.
(let [i (column-name->index column-name)
result (b/cond
(not i) not-found
:let [thunk (i->thunk i)]
(not thunk) not-found
:else (thunk))]
(log/tracef "=> %s" result)
result)) |
(def ^:private ^:dynamic *fetch-all-columns* true) | |
One of these is built for every row in the results. TODO -- maybe we can combine the | (deftype ^:no-doc TransientRow [model
^ResultSet rset
;; `next.jdbc` result set builder, usually an instance
;; of [[toucan2.jdbc.result_set.InstanceBuilder]] or
;; whatever [[toucan2.jdbc.result-set/builder-fn]] returns. Should have the key `:cols`
builder
;; a function that given a column name key will normalize it and return the
;; corresponding JDBC index. This should probably be memoized for the whole result set.
column-name->index
;; an atom with a set of realized column name keywords.
realized-keys
;; ATOM with map. Given a JDBC column index (starting at 1) return a thunk that can be
;; used to fetch the column. This usually comes
;; from [[toucan2.jdbc.read/make-cached-i->thunk]].
i->thunk
;; a Volatile that contains the underlying transient map representing this row.
^clojure.lang.Volatile volatile-transient-row
;; a delay that should return a persistent map for the current row. Once this is called
;; we should return the realized row directly and work with that going forward.
realized-row]
next.jdbc.result_set.InspectableMapifiedResultSet
(row-number [_this] (.getRow rset))
(column-names [_this] (:cols builder))
(metadata [_this] (d/datafy (.getMetaData rset)))
clojure.lang.IPersistentMap
(assoc [this k v]
(log/tracef ".assoc %s %s" k v)
(if (realized? realized-row)
(assoc @realized-row k v)
(do
(vswap! volatile-transient-row (fn [^clojure.lang.ITransientMap transient-row]
(let [^clojure.lang.ITransientMap transient-row' (assoc! transient-row k v)]
(assert (= (.valAt transient-row' k) v)
(format "assoc! did not do what we expected. k = %s v = %s row = %s .valAt = %s"
(pr-str k)
(pr-str v)
(pr-str transient-row')
(pr-str (.valAt transient-row' k))))
transient-row')))
(swap! realized-keys conj k)
this)))
;; TODO -- can we `assocEx` the transient row?
(assocEx [_this k v]
(log/tracef ".assocEx %s %s" k v)
(.assocEx ^clojure.lang.IPersistentMap @realized-row k v))
(without [this k]
(log/tracef ".without %s" k)
(if (realized? realized-row)
(dissoc @realized-row k)
(do
(vswap! volatile-transient-row dissoc! k)
(let [k-index (column-name->index k)
column-name->index' (if-not k-index
column-name->index
(fn [column-name]
(let [index (column-name->index column-name)]
(when-not (= index k-index)
index))))]
(when k-index
(swap! i->thunk (fn [i->thunk]
(fn [index]
(if (= index k-index)
(constantly ::not-found)
(i->thunk index))))))
(swap! realized-keys disj k)
(if (identical? column-name->index column-name->index')
this
(TransientRow. model
rset
builder
column-name->index'
realized-keys
i->thunk
volatile-transient-row
realized-row))))))
;; Java 7 compatible: no forEach / spliterator
;;
;; TODO -- not sure if we need/want this
java.lang.Iterable
(iterator [_this]
(log/tracef ".iterator")
(.iterator ^java.lang.Iterable @realized-row))
clojure.lang.Associative
(containsKey [_this k]
(log/tracef ".containsKey %s" k)
(if (realized? realized-row)
(contains? @realized-row k)
(or (contains? @volatile-transient-row k)
(boolean (column-name->index k)))))
(entryAt [this k]
(log/tracef ".entryAt %s" k)
(let [v (.valAt this k ::not-found)]
(when-not (= v ::not-found)
(clojure.lang.MapEntry. k v))))
;; TODO -- this should probably also include any extra keys added with `assoc` or whatever
clojure.lang.Counted
(count [_this]
(log/tracef ".count")
(let [cols (:cols builder)]
(assert (seq cols))
(count cols)))
clojure.lang.IPersistentCollection
(cons [this o]
(log/tracef ".cons %s" o)
(cond
(map? o)
(reduce #(apply assoc %1 %2) this o)
(instance? java.util.Map o)
(reduce #(apply assoc %1 %2) this (into {} o))
:else
(if-let [[k v] (seq o)]
(assoc this k v)
this)))
(empty [_this]
(log/tracef ".empty")
(instance/instance model))
(equiv [_this obj]
(log/tracef ".equiv %s" obj)
(.equiv ^clojure.lang.IPersistentCollection @realized-row obj))
;; we support get with a numeric key for array-based builders:
clojure.lang.ILookup
(valAt [this k]
(log/tracef ".valAt %s" k)
(.valAt this k nil))
(valAt [this k not-found]
(log/tracef ".valAt %s %s" k not-found)
(cond
(realized? realized-row)
(get @realized-row k not-found)
(number? k)
(let [i (inc k)]
(if-let [thunk (@i->thunk i)]
(thunk)
not-found))
;; non-number column name
:else
(let [existing-value (.valAt ^clojure.lang.ITransientMap @volatile-transient-row k ::not-found)]
(if-not (= existing-value ::not-found)
existing-value
(let [fetched-value (fetch-column-with-name column-name->index @i->thunk k ::not-found)]
(if (= fetched-value ::not-found)
not-found
(do
(.assoc this k fetched-value)
fetched-value)))))))
clojure.lang.Seqable
(seq [_this]
(log/tracef ".seq")
(seq @realized-row))
;; calling [[persistent!]] on a transient row will convert it to a persistent object WITHOUT realizing all the columns.
clojure.lang.ITransientCollection
(persistent [_this]
(log/tracef ".persistent")
(binding [*fetch-all-columns* false]
@realized-row))
next.jdbc.rs/DatafiableRow
(datafiable-row [_this connectable opts]
;; since we have to call these eagerly, we trap any exceptions so
;; that they can be thrown when the actual functions are called
(let [row (try (.getRow rset) (catch Throwable t t))
cols (try (:cols builder) (catch Throwable t t))
metta (try (d/datafy (.getMetaData rset)) (catch Throwable t t))]
(vary-meta
@realized-row
assoc
`core-p/datafy (#'next.jdbc.rs/navize-row connectable opts)
`core-p/nav (#'next.jdbc.rs/navable-row connectable opts)
`row-number (fn [_this] (if (instance? Throwable row) (throw row) row))
`column-names (fn [_this] (if (instance? Throwable cols) (throw cols) cols))
`metadata (fn [_this] (if (instance? Throwable metta) (throw metta) metta)))))
protocols/IModel
(model [_this]
model)
protocols/IDispatchValue
(dispatch-value [_this]
(protocols/dispatch-value model))
protocols/IDeferrableUpdate
(deferrable-update [this k f]
(log/tracef "Doing deferrable update of %s with %s" k f)
(b/cond
(realized? realized-row)
(update @realized-row k f)
:let [existing-value (.valAt ^clojure.lang.ITransientMap @volatile-transient-row k ::not-found)]
;; value already exists: update the value in the transient row and call it a day
(not= existing-value ::not-found)
(assoc this k (f existing-value))
;; otherwise compose the column thunk with `f`
:else
(let [col-index (column-name->index k)]
(assert col-index (format "No column named %s in results. Got: %s" (pr-str k) (pr-str (:cols builder))))
(swap! i->thunk (fn [i->thunk]
(fn [i]
(let [thunk (i->thunk i)]
(if (= i col-index)
(comp f thunk)
thunk)))))
this)))
realize/Realize
(realize [_this]
@realized-row)
u/IsCustomMap
(custom-map? [_] true)
(toString [this]
(str/join \space (map str (print-representation-parts this))))) |
We don't use [[pretty.core/PrettyPrintable]] for this like we do for everything else because we want to print TWO things, the [[print-symbol]] and a map. | |
Returns a sequence of things to print to represent a [[TransientRow]]. Avoids realizing the entire row if we're still in 'transient' mode. | (defn- print-representation-parts
[^toucan2.jdbc.row.TransientRow row]
(try
(let [transient-row @(.volatile_transient_row row)
realized-keys (.realized_keys row)]
[(symbol (format "^%s " `TransientRow))
;; (instance? pretty.core.PrettyPrintable transient-row) (pretty/pretty transient-row)
(zipmap @realized-keys
(map #(get transient-row %) @realized-keys))])
(catch Exception _
["unrealized result set {row} -- do you need to call toucan2.realize/realize ?"]))) |
(defmethod print-method toucan2.jdbc.row.TransientRow
[row writer]
(doseq [part (print-representation-parts row)]
(print-method part writer))) | |
(defmethod pprint/simple-dispatch toucan2.jdbc.row.TransientRow
[row]
(doseq [part (print-representation-parts row)]
(pprint/simple-dispatch part))) | |
(defmethod log/print-handler toucan2.jdbc.row.TransientRow
[_klass]
(fn [printer row]
(for [part (print-representation-parts row)]
(puget/format-doc printer part)))) | |
(doseq [methodd [print-method
pprint/simple-dispatch]]
(prefer-method methodd toucan2.jdbc.row.TransientRow clojure.lang.IPersistentMap)) | |
A lot of the stuff below is an adapted/custom version of the code in [[next.jdbc.result-set]] -- I would have preferred to not have to do this but a lot of it was necessary to make things work in the Toucan 2 work. See this Slack thread for more information: https://clojurians.slack.com/archives/C1Q164V29/p1662494291800529 | |
(defn- fetch-column! [builder i->thunk ^clojure.lang.ITransientMap transient-row i]
;; make sure the key is not already present. If it is we don't want to stomp over existing values.
(let [col-name (nth (:cols builder) (dec i))]
(if (= (.valAt transient-row col-name ::not-found) ::not-found)
(let [thunk (@i->thunk i)]
(assert (fn? thunk))
(let [value (thunk)]
(if (= value ::not-found)
transient-row
(next.jdbc.rs/with-column-value builder transient-row col-name value))))
transient-row))) | |
(defn- fetch-all-columns! [builder i->thunk transient-row]
(log/tracef "Fetching all columns")
(let [n (next.jdbc.rs/column-count builder)]
(loop [i 1
transient-row transient-row]
(if (<= i n)
(recur (inc i) (fetch-column! builder i->thunk transient-row i))
transient-row)))) | |
(defn- make-realized-row-delay [builder i->thunk ^clojure.lang.Volatile volatile-transient-row]
(delay
(log/tracef "Fully realizing row. *fetch-all-columns* = %s" *fetch-all-columns*)
(let [row (cond->> @volatile-transient-row
*fetch-all-columns* (fetch-all-columns! builder i->thunk))]
(next.jdbc.rs/row! builder row)))) | |
Create a new | (defn ^:no-doc row
[model ^ResultSet rset builder i->thunk col-name->index]
(assert (not (.isClosed rset)) "ResultSet is already closed")
(let [volatile-transient-row (volatile! (next.jdbc.rs/->row builder))
i->thunk (atom i->thunk)
realized-row-delay (make-realized-row-delay builder i->thunk volatile-transient-row)
realized-keys (atom #{})]
;; this is a gross amount of positional args. But using `reify` makes debugging things too hard IMO.
(->TransientRow model
rset
builder
col-name->index
realized-keys
i->thunk
volatile-transient-row
realized-row-delay))) |
Toucan 2 logging utilities. This is basically just a fancy wrapper around | (ns toucan2.log (:require [clojure.spec.alpha :as s] [clojure.string :as str] [clojure.tools.logging :as tools.log] [clojure.tools.logging.impl :as tools.log.impl] [environ.core :as env] [pretty.core :as pretty] [puget.color] [puget.printer :as puget])) |
(set! *warn-on-reflection* true) | |
The current log level (as a keyword) to log messages directly to stdout with. By default this is You can dynamically bind this to enable logging at a higher level in the REPL for debugging purposes. You can also set a default value for this by setting the atom [[level]]. | (def ^:dynamic *level* nil) |
The default log level to log messages directly to stdout with. Takes the value of the env var
| (defonce level (atom (some-> (env/env :toucan-debug-level) keyword))) |
Whether or not to print the trace in color. True by default, unless the env var | (def ^:private ^:dynamic *color*
(if-let [env-var-value (env/env :no-color)]
(complement (Boolean/parseBoolean env-var-value))
true)) |
Puget printer method used when logging. Dispatches on class. | (defmulti ^:no-doc print-handler
{:arglists '([klass])}
(fn [klass]
klass)) |
(defmethod print-handler :default [_klass] nil) | |
(defmethod print-handler pretty.core.PrettyPrintable
[_klass]
(fn [printer x]
(puget/format-doc printer (pretty/pretty x)))) | |
(defmethod print-handler clojure.core.Eduction
[_klass]
(fn [printer ^clojure.core.Eduction ed]
(puget/format-doc printer (list 'eduction (.xform ed) (.coll ed))))) | |
(defmethod print-handler clojure.lang.IRecord
[klass]
(when (isa? klass clojure.lang.IReduceInit)
(fn [_printer x]
[:text (str x)]))) | |
(defrecord ^:no-doc Doc [forms]) | |
(defmethod print-handler Doc
[_klass]
(fn [printer {:keys [forms ns-symb]}]
(let [ns-symb (when ns-symb
(symbol (last (str/split (name ns-symb) #"\."))))]
[:group
(when ns-symb
[:span
(puget.color/document printer :number (name ns-symb))
[:text " "]])
[:align
(for [form forms]
(puget/format-doc printer form))]]))) | |
(defmethod print-handler Class
[_klass]
(fn [printer ^Class klass]
(puget.color/document printer :class-name (.getCanonicalName klass)))) | |
(defrecord ^:no-doc Text [s]) | |
(defmethod print-handler Text
[_klass]
(fn [_printer {:keys [s]}]
[:span
[:text s]
[:line]])) | |
(prefer-method print-handler pretty.core.PrettyPrintable clojure.lang.IRecord) | |
(def ^:private printer-options
{:print-handlers print-handler
:width 120
:print-meta true
:coll-limit 5}) | |
(defn- default-color-printer [x]
;; don't print in black. I can't see it
(puget/cprint x (assoc printer-options :color-scheme {:nil [:green]}))) | |
(defn- default-boring-printer [x] (puget/pprint x printer-options)) | |
(defn- pretty-printer []
(if *color*
default-color-printer
default-boring-printer)) | |
Pretty print a | (defn ^:no-doc -pprint-doc
([doc]
(-pprint-doc nil doc))
([ns-symb doc]
(try
((pretty-printer) (assoc doc :ns-symb ns-symb))
(catch Throwable e
(throw (ex-info (format "Error pretty printing doc: %s" (ex-message e))
{:doc doc}
e)))))) |
Implementation of the | (defn ^:no-doc -pprint-doc-to-str [doc] (str/trim (with-out-str (-pprint-doc doc)))) |
Exactly like [[interleave]] but includes the entirety of both collections even if the other collection is shorter. If one collection 'runs out', the remaining elements of the other collection are appended directly to the end of the resulting collection. | (defn- interleave-all
[x y]
(loop [acc [], x x, y y]
(let [acc (cond-> acc
(seq x) (conj (first x))
(seq y) (conj (first y)))
x (next x)
y (next y)]
(if (and (empty? x) (empty? y))
acc
(recur acc x y))))) |
Convert | (defn- build-doc
[format-string & args]
(let [->Text* (fn [s]
(list `->Text (str/trimr s)))
texts (map ->Text* (str/split format-string #"%s"))]
`(->Doc ~(vec (interleave-all texts args))))) |
(defn- level->int ^long [a-level ^long default]
(case a-level
:disabled 5
:error 4
:warn 3
:info 2
:debug 1
:trace 0
default)) | |
Current log level, as an integer. TODO -- better idea, why don't we just change [[level]] and [[level]] to store ints so we don't have to convert
them over and over again. We could introduce a | (defn ^:no-doc -current-level-int ^long [] (level->int (or *level* @level) Integer/MAX_VALUE)) |
Whether to enable logging for | (defmacro ^:no-doc -enable-level?
[a-level]
(let [a-level-int (level->int a-level 0)]
`(>= ~a-level-int (-current-level-int)))) |
Get a logger factor for the namespace named by symbol | (defn ^:no-doc -enabled-logger
[ns-symb a-level]
(let [logger (tools.log.impl/get-logger tools.log/*logger-factory* ns-symb)]
(when (tools.log.impl/enabled? logger a-level)
logger))) |
Implementation of various | (defmacro ^:no-doc -log
[a-level e doc]
`(let [doc# (delay ~doc)]
(when (-enable-level? ~a-level)
(-pprint-doc '~(ns-name *ns*) @doc#))
(when-let [logger# (-enabled-logger '~(ns-name *ns*) ~a-level)]
(tools.log/log* logger# ~a-level ~e (-pprint-doc-to-str @doc#))))) |
Implementation of various | (defmacro ^:no-doc logf
[a-level & args]
(let [[e format-string & args] (if (string? (first args))
(cons nil args)
args)]
(assert (string? format-string))
(let [doc (apply build-doc format-string args)]
`(-log ~a-level ~e ~doc)))) |
The log macros only work with | (defn- correct-number-of-args-for-format-string? [{:keys [msg args]}]
(let [matcher (re-matcher #"%s" msg)
format-string-arg-count (count (take-while some? (repeatedly #(re-find matcher))))]
(= (count args) format-string-arg-count))) |
(defn- pr-str-form? [form]
(and (seq? form)
(= (first form) 'pr-str))) | |
(s/def ::args
(s/& (s/cat :e (s/? (complement string?))
:msg string?
:args (s/* (complement pr-str-form?)))
correct-number-of-args-for-format-string?)) | |
Log an error message for a | (defmacro errorf
{:arglists '([throwable? s] [throwable? format-string & args])}
[& args]
`(logf :error ~@args)) |
(s/fdef errorf :args ::args :ret any?) | |
Log a warning for a | (defmacro warnf
{:arglists '([throwable? s] [throwable? format-string & args])}
[& args]
`(logf :warn ~@args)) |
(s/fdef warnf :args ::args :ret any?) | |
Only things that all users should see by default without configuring a logger should be this level. | (defmacro infof
{:arglists '([throwable? s] [throwable? format-string & args])}
[& args]
`(logf :info ~@args)) |
(s/fdef infof :args ::args :ret any?) | |
Most log messages should be this level. | (defmacro debugf
{:arglists '([throwable? s] [throwable? format-string & args])}
[& args]
`(logf :debug ~@args)) |
(s/fdef debugf :args ::args :ret any?) | |
Log messages that are done once-per-row should be this level. | (defmacro tracef
{:arglists '([throwable? s] [throwable? format-string & args])}
[& args]
`(logf :trace ~@args)) |
(s/fdef tracef :args ::args :ret any?) | |
(comment (reset! level :debug) (tracef "VERY NICE MESSAGE %s 1000" :abc) (debugf "VERY NICE MESSAGE %s 1000" :abc)) | |
Methods related to resolving Toucan 2 models, appropriate table names to use when building queries for them, and namespaces to use for columns in query results. | (ns toucan2.model (:refer-clojure :exclude [namespace]) (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.protocols :as protocols] [toucan2.types :as types] [toucan2.util :as u])) |
(set! *warn-on-reflection* true) | |
(comment s/keep-me
types/keep-me) | |
Resolve a modelable to an actual Toucan model (usually a keyword). A modelable is anything that can be resolved to
a model via this method. You can implement this method to define special model resolution behavior, for example
You can also implement this method to do define behaviors when a model is used, for example making sure some namespace with method implementation for the model is loaded, logging some information, etc. | (m/defmulti resolve-model
{:arglists '([modelable₁]), :defmethod-arities #{1}}
u/dispatch-on-first-arg) |
(m/defmethod resolve-model :default "Default implementation. Return `modelable` as is, i.e., there is nothing to resolve, and we can use it directly as a model." [modelable] modelable) | |
(m/defmethod resolve-model :around :default
"Log model resolution as it happens for debugging purposes."
[modelable]
(let [model (next-method modelable)]
(log/debugf "Resolved modelable %s => model %s" modelable model)
model)) | |
The default connectable that should be used when executing queries for | (m/defmulti default-connectable
{:arglists '([model₁]), :defmethod-arities #{1}}
u/dispatch-on-first-arg) |
(m/defmethod default-connectable :default "Return `nil`, so we can fall thru to something else (presumably `:default` anyway)?" [_model] nil) | |
Return the actual underlying table name that should be used to query a By default for things that implement ```clj (t2/table-name :models/user) ;; => :user ``` You can write your own implementations for this for models whose table names do not match their This is guaranteed to return a keyword, so it can easily be used directly in Honey SQL queries and the like; if you
return something else, the default | (m/defmulti table-name
{:arglists '([model₁])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod table-name :default
"Fallback implementation. Redirects keywords to the implementation for `clojure.lang.Named` (use the `name` of the
keyword). For everything else, throws an error, since we don't know how to get a table name from it."
[model]
(if (instance? clojure.lang.Named model)
((m/effective-method table-name clojure.lang.Named) model)
(throw (ex-info (format "Invalid model %s: don't know how to get its table name." (pr-str model))
{:model model})))) | |
(m/defmethod table-name :after :default
"Always return table names as keywords. This will facilitate using them directly inside Honey SQL, e.g.
{:select [:*], :from [(t2/table-name MyModel)]}"
[a-table-name]
(keyword a-table-name)) | |
(m/defmethod table-name clojure.lang.Named "Default implementation for anything that is a `clojure.lang.Named`, such as a keywords or symbols. Use the `name` as the table name. ```clj (t2/table-name :models/user) => :user ```" [model] (name model)) | |
(m/defmethod table-name String "Implementation for strings. Use the string name as-is." [table] table) | |
Return a sequence of the primary key columns names, as keywords, for a model. The default primary keys for a model are
```clj ;; tell Toucan that :model/bird has a composite primary key consisting of the columns :id and :name (m/defmethod primary-keys :model/bird [_model] [:id :name]) ``` If an implementation returns a single keyword, the default | (m/defmulti primary-keys
{:arglists '([model₁])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod primary-keys :around :default
"If the PK comes back unwrapped, wrap it -- make sure results are always returned as a vector of keywords. Throw an
error if results are in the incorrect format."
[model]
(let [pk-or-pks (next-method model)
pks (if (sequential? pk-or-pks)
pk-or-pks
[pk-or-pks])]
(when-not (every? keyword? pks)
(throw (ex-info (format "Bad %s for model %s: should return keyword or sequence of keywords, got %s"
`primary-keys
(pr-str model)
(pr-str pk-or-pks))
{:model model, :result pk-or-pks})))
pks)) | |
Return a map of primary key values for a Toucan 2 | (defn primary-key-values-map ([instance] (primary-key-values-map (protocols/model instance) instance)) ([model m] (select-keys m (primary-keys model)))) |
Return a function to get the value(s) of the primary key(s) from a row, as a single value or vector of values. Used by [[toucan2.select/select-pks-reducible]] and thus by [[toucan2.select/select-pks-set]], [[toucan2.select/select-pks-vec]], etc. The primary keys are determined by [[primary-keys]]. By default this is simply the keyword TODO -- consider renaming this to something better. What? | (defn select-pks-fn
[modelable]
(let [model (resolve-model modelable)
pk-keys (primary-keys model)]
(if (= (count pk-keys) 1)
(first pk-keys)
(apply juxt pk-keys)))) |
Return a map of namespaces to use when fetching results with this model. ```clj (m/defmethod model->namespace ::my-model [_model] {::my-model "x" ::another-model "y"}) ``` | (m/defmulti model->namespace
{:arglists '([model₁])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod model->namespace :default "By default, don't namespace column names when fetching rows." [_model] nil) | |
(m/defmethod model->namespace :after :default
"Validate the results."
[namespace-map]
(when (some? namespace-map)
(assert (map? namespace-map)
(format "model->namespace should return a map. Got: ^%s %s"
(some-> namespace-map class .getCanonicalName)
(pr-str namespace-map))))
namespace-map) | |
Take the [[model->namespace]] map for a model and return a map of string table name -> namespace. This is used to determine how to prefix columns in results based on their table name; see [[toucan2.jdbc.result-set/instance-builder-fn]] for an example of this usage. | (defn table-name->namespace
[model]
(not-empty
(into {}
(comp (filter (fn [[model _a-namespace]]
(not= (m/effective-primary-method table-name model)
(m/default-effective-method table-name))))
(map (fn [[model a-namespace]]
[(name (table-name model)) a-namespace])))
(model->namespace model)))) |
Get the namespace that should be used to prefix keys associated with a | (defn namespace
[model]
(some
(fn [[a-model a-namespace]]
(when (isa? model a-model)
a-namespace))
(model->namespace model))) |
(m/defmethod primary-keys :default
"By default the primary key for a model is the column `:id`; or `:some-namespace/id` if the model defines a namespace
for itself with [[model->namespace]]."
[model]
(if-let [model-namespace (namespace model)]
[(keyword (name model-namespace) "id")]
[:id])) | |
This is a low-level namespace implementing our query execution pipeline. Most of the stuff you'd use on a regular basis are implemented on top of stuff here. Pipeline order is
The main pipeline entrypoint is [[transduce-unparsed]]. | (ns toucan2.pipeline (:refer-clojure :exclude [compile resolve]) (:require [clojure.spec.alpha :as s] [methodical.core :as m] [pretty.core :as pretty] [toucan2.connection :as conn] [toucan2.model :as model] [toucan2.query :as query] [toucan2.realize :as realize] [toucan2.types :as types] [toucan2.util :as u])) |
(set! *warn-on-reflection* true) | |
(comment s/keep-me) | |
pipeline | |
Thunk function to call every time a query is executed if [[toucan2.execute/with-call-count]] is in use. Implementees
of [[transduce-execute-with-connection]] should invoke this every time a query gets executed. You can
use [[increment-call-count!]] to simplify the chore of making sure it's non- | (def ^:dynamic ^:no-doc *call-count-thunk* nil) |
The final stage of the Toucan 2 query execution pipeline. Execute a compiled query (as returned by [[compile]]) with a
database connection, e.g. a The only reason you should need to implement this method is if you are writing a new query execution backend. TODO -- This name is a little long, maybe this should be called | (m/defmulti transduce-execute-with-connection
{:arglists '([rf conn₁ query-type₂ model₃ compiled-query])
:defmethod-arities #{5}
:dispatch-value-spec (types/or-default-spec
(s/cat :conn ::types/dispatch-value.keyword-or-class
:query-type ::types/dispatch-value.query-type
:model ::types/dispatch-value.model))}
(fn [_rf conn query-type model _compiled-query]
(u/dispatch-on-first-three-args conn query-type model))) |
(m/defmethod transduce-execute-with-connection :before :default
"Count all queries that are executed by calling [[*call-count-thunk*]] if bound."
[_rf _conn _query-type _model query]
(when *call-count-thunk*
(*call-count-thunk*))
query) | |
Get a connection from the current connection and call [[transduce-execute-with-connection]]. For DML queries, this uses [[conn/with-transaction]] to get a connection and ensure we are in a transaction, if we're not already in one. For non-DML queries this uses the usual [[conn/with-connection]]. | (defn- transduce-execute
[rf query-type model compiled-query]
(u/try-with-error-context {::rf rf}
(if (isa? query-type :toucan.statement-type/DML)
;; For DML stuff we will run the whole thing in a transaction if we're not already in one. Not 100% sure this is
;; necessary since we would probably already be in one if we needed to be because stuff
;; like [[toucan2.tools.before-delete]] have to put us in one much earlier.
(conn/with-transaction [conn nil {:nested-transaction-rule :ignore}]
(transduce-execute-with-connection rf conn query-type model compiled-query))
;; otherwise we can just execute with a normal non-transaction query.
(conn/with-connection [conn]
(transduce-execute-with-connection rf conn query-type model compiled-query))))) |
The transducer that should be applied to the reducing function executed when running a query of
Be sure to ```clj (m/defmethod t2/results-transform [:toucan.query-type/select.* :my-model] [query-type model] (comp (next-method query-type model) (map (fn [instance] (assoc instance :num-cans 2))))) ``` It's probably better to put the transducer returned by | (m/defmulti results-transform
{:arglists '([query-type₁ model₂])
:defmethod-arities #{2}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type-model)}
u/dispatch-on-first-two-args) |
(m/defmethod results-transform :default [_query-type _model] identity) | |
Compile a You can implement this method to write a custom query compilation backend, for example to compile some certain record type in a special way. See [[toucan2.honeysql2]] for an example implementation. In addition to dispatching on | (m/defmulti compile
{:arglists '([query-type₁ model₂ built-query₃])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type-model-query)}
u/dispatch-on-first-three-args) |
(m/defmethod compile :default
"Default implementation: return query as-is (i.e., consider it to already be compiled). Check that the query is non-nil
and, if it is a collection, non-empty. Everything else is fair game."
[_query-type _model query]
(assert (and (some? query)
(or (not (coll? query))
(seq query)))
(format "Compiled query should not be nil/empty. Got: %s" (pr-str query)))
query) | |
TODO -- this is a little JDBC-specific. What if some other query engine wants to run plain string queries without us wrapping them in a vector? Maybe this is something that should be handled at the query execution level in [[transduce-execute-with-connection]] instead. I guess that wouldn't actually work because we need to attach metadata to compiled queries | (m/defmethod compile [#_query-type :default #_model :default #_built-query String] "Compile a string query. Default impl wraps the string in a vector and recursively calls [[compile]]." [query-type model sql] (compile query-type model [sql])) |
default implementation of [[compile]] for maps lives in [[toucan2.honeysql2]] | |
Build a query by applying You can implement this method to write a custom query compilation backend, for example to compile some certain record type in a special way. See [[toucan2.honeysql2]] for an example implementation. In addition to dispatching on TODO -- does this belong here, or in [[toucan2.query]]? | (m/defmulti build
{:arglists '([query-type₁ model₂ parsed-args resolved-query₃])
:defmethod-arities #{4}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type-model-query)}
(fn [query-type model _parsed-args resolved-query]
(u/dispatch-on-first-three-args query-type model resolved-query))) |
(m/defmethod build :default [_query-type _model _parsed-args resolved-query] resolved-query) | |
(m/defmethod build [#_query-type :default #_model :default #_resolved-query nil]
"Something like (select my-model nil) should basically mean SELECT * FROM my_model WHERE id IS NULL"
[query-type model parsed-args _nil]
;; if `:query` is present but equal to `nil`, treat that as if the pk value IS NULL
(let [parsed-args (assoc-in parsed-args [:kv-args :toucan/pk] nil)]
(build query-type model parsed-args {}))) | |
(m/defmethod build [#_query-type :default #_model :default #_resolved-query Integer] "Treat lone integers as queries to select an integer primary key." [query-type model parsed-args n] (build query-type model parsed-args (long n))) | |
(m/defmethod build [#_query-type :default #_model :default #_resolved-query Long]
"Treat lone integers as queries to select an integer primary key."
[query-type model parsed-args pk]
(build query-type model (update parsed-args :kv-args assoc :toucan/pk pk) {})) | |
(m/defmethod build [#_query-type :default #_model :default #_query String] "Default implementation for plain strings. Wrap the string in a vector and recurse." [query-type model parsed-args sql] (build query-type model parsed-args [sql])) | |
(m/defmethod build [#_query-type :default #_model :default #_query clojure.lang.Sequential]
"Default implementation of vector [query & args] queries."
[query-type model {:keys [kv-args], :as parsed-args} sql-args]
(when (seq kv-args)
(throw (ex-info "key-value args are not supported for [query & args]."
{:query-type query-type
:model model
:parsed-args parsed-args
:method #'build
:dispatch-value (m/dispatch-value build query-type model parsed-args sql-args)})))
(next-method query-type model parsed-args sql-args)) | |
default implementation of [[build]] for maps lives in [[toucan2.honeysql2]] | |
Resolve a | (m/defmulti resolve
{:arglists '([query-type₁ model₂ queryable₃])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type-model-query)}
u/dispatch-on-first-three-args) |
(m/defmethod resolve :default "The default implementation considers a query to already be resolved, and returns it as-is." [_query-type _model queryable] queryable) | |
The function to use when building a query. Normally [[build]], but you can bind this to intercept build behavior to do something different. | (def ^:dynamic ^{:arglists '([query-type model parsed-args resolved-query])} *build*
#'build) |
The function to use when compiling a query. Normally [[compile]], but you can bind this to intercept normal compilation behavior to do something different. | (def ^:dynamic ^{:arglists '([query-type model built-query])} *compile*
#'compile) |
The function to use to open a connection, execute, and transduce a query. Normally [[transduce-execute]]. The primary use case for binding this is to intercept query execution and return some results without opening any connections. | (def ^:no-doc ^:dynamic ^{:arglists '([rf query-type model compiled-query])}
*transduce-execute*
#'transduce-execute) |
The parsed args seen at the beginning of the pipeline. This is bound in case methods in later stages of the pipeline,
such as [[results-transform]], need it for one reason or another. (See for example [[toucan2.tools.default-fields]],
which applies different behavior if a query was initiated with | (def ^:dynamic *parsed-args* nil) |
The query after it has been resolved. This is bound in case methods in the later stages of the pipeline need it for one reason or another. | (def ^:dynamic *resolved-query* nil) |
(defn- transduce-compiled-query [rf query-type model compiled-query]
(u/try-with-error-context ["with compiled query" {::compiled-query compiled-query}]
(let [xform (results-transform query-type model)
rf (xform rf)]
(*transduce-execute* rf query-type model compiled-query)))) | |
(defn- transduce-built-query [rf query-type model built-query]
(u/try-with-error-context ["with built query" {::built-query built-query}]
(if (isa? built-query ::no-op)
(let [init (rf)]
(rf init))
(let [compiled-query (*compile* query-type model built-query)]
(transduce-compiled-query rf query-type model compiled-query))))) | |
One of the primary customization points for the Toucan 2 query execution pipeline. [[build]] and [[compile]] a
You can implement this method to introduce custom behavior that should happen before a query is built or compiled,
e.g. transformations to the | (m/defmulti transduce-query
{:arglists '([rf query-type₁ model₂ parsed-args resolved-query₃])
:defmethod-arities #{5}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type-model-query)}
(fn [_rf query-type model _parsed-args resolved-query]
(u/dispatch-on-first-three-args query-type model resolved-query))) |
(m/defmethod transduce-query :default
[rf query-type model parsed-args resolved-query]
(let [built-query (*build* query-type model parsed-args resolved-query)]
(transduce-built-query rf query-type model built-query))) | |
(defn- transduce-query* [rf query-type model parsed-args resolved-query]
(let [parsed-args (dissoc parsed-args :queryable)]
(binding [*resolved-query* resolved-query]
(u/try-with-error-context ["with resolved query" {::resolved-query resolved-query}]
(transduce-query rf query-type model parsed-args resolved-query))))) | |
(defn- transduce-with-model
[rf query-type model {:keys [queryable], :as parsed-args}]
;; if `*current-connectable*` is unbound but `model` has a default connectable, bind `*current-connectable*` and recur
(if-let [model-connectable (when-not conn/*current-connectable*
(model/default-connectable model))]
(binding [conn/*current-connectable* model-connectable]
(transduce-with-model rf query-type model parsed-args))
(binding [*parsed-args* parsed-args]
(u/try-with-error-context ["with parsed args" {::query-type query-type, ::parsed-args parsed-args}]
(let [queryable (if (contains? parsed-args :queryable)
queryable
(or queryable {}))
resolved-query (resolve query-type model queryable)]
(transduce-query* rf query-type model parsed-args resolved-query)))))) | |
Like [[transduce-unparsed]], but called with already-parsed args rather than unparsed args. | (defn ^:no-doc transduce-parsed
[rf query-type {:keys [modelable connectable], :as parsed-args}]
;; if `:connectable` was specified, bind it to [[conn/*current-connectable*]]; it should always override the current
;; connection (if one is bound). See docstring for [[toucan2.query/reducible-query]] for more info.
;;
;; TODO -- I'm not 100% sure this makes sense -- if we specify `:conn ::my-connection` and then want to do something
;; in a transaction for `::my-connection`? Shouldn't it still be done in a transaction?
(if connectable
(binding [conn/*current-connectable* connectable]
(transduce-parsed rf query-type (dissoc parsed-args :connectable)))
;; if [[conn/*current-connectable*]] is not yet bound, then get the default connectable for the model and recur.
(let [model (model/resolve-model modelable)]
(u/try-with-error-context ["with model" {::model model}]
(transduce-with-model rf query-type model (dissoc parsed-args :modelable)))))) |
Entrypoint to the Toucan 2 query execution pipeline. Parse | (defn ^:no-doc transduce-unparsed
[rf query-type unparsed-args]
(let [parsed-args (query/parse-args query-type unparsed-args)]
(u/try-with-error-context ["with unparsed args" {::query-type query-type, ::unparsed-args unparsed-args}]
(transduce-parsed rf query-type parsed-args)))) |
rf helper functions | |
Returns a version of reducing function | (defn ^:no-doc with-init
[rf init]
(fn
([] init)
([x] (rf x))
([x y] (rf x y)))) |
The default reducing function for queries of | (m/defmulti default-rf
{:arglists '([query-type])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type)}
keyword) |
(m/defmethod default-rf :toucan.result-type/update-count
"The reducing function for queries returning an update count. Sums all numbers passed in."
[_query-type]
(-> (fnil + 0 0)
(with-init 0)
completing)) | |
(m/defmethod default-rf :toucan.result-type/pks "The reducing function for queries returning PKs. Presumably these will come back as a map, but that map doesn't need to be realized. This needs to be combined with a transducer like `map` [[toucan2.model/select-pks-fn]] to get the PKs themselves." [_query-type] conj) | |
(m/defmethod default-rf :toucan.result-type/* "The default reducing function for all query types unless otherwise specified. Returns realized maps (by default, Toucan 2 instances)." [_query-type] ((map realize/realize) conj)) | |
Return a transducer that transforms a reducing function | (defn ^:no-doc first-result-xform-fn
[query-type]
(if (isa? query-type :toucan.result-type/update-count)
identity
(fn [rf]
(completing ((take 1) rf) first)))) |
Helper functions for implementing stuff like [[toucan2.select/select]] | |
Helper for implementing things like [[toucan2.select/select]]. Transduce | (defn ^:no-doc transduce-unparsed-with-default-rf
[query-type unparsed-args]
(assert (types/query-type? query-type))
(let [rf (default-rf query-type)]
(transduce-unparsed rf query-type unparsed-args))) |
reducible versions for implementing stuff like [[toucan2.select/reducible-select]] | |
Create a reducible with one of the functions in this namespace. | (defn- reducible-fn
[f & args]
(reify
clojure.lang.IReduceInit
(reduce [_this rf init]
;; wrap the rf in `completing` so we don't end up doing any special one-arity TRANSDUCE stuff inside of REDUCE
(apply f (completing (with-init rf init)) args))
pretty/PrettyPrintable
(pretty [_this]
(list* `reducible-fn f args)))) |
Helper for implementing things like [[toucan2.select/reducible-select]]. A reducible version of [[transduce-unparsed]]. | (defn ^:no-doc reducible-unparsed [query-type unparsed] (reducible-fn transduce-unparsed query-type unparsed)) |
Helper for implementing things like [[toucan2.execute/reducible-query]] that don't need arg parsing. A reducible version of [[transduce-parsed]]. | (defn ^:no-doc reducible-parsed-args [query-type parsed-args] (reducible-fn transduce-parsed query-type parsed-args)) |
Misc util functions. TODO -- I don't think this belongs here; hopefully this can live somewhere where we can call
it | |
Helper for compiling a | (defn compile* ([built-query] (compile* nil built-query)) ([query-type built-query] (compile* query-type nil built-query)) ([query-type model built-query] (compile query-type model built-query))) |
(ns toucan2.protocols (:require [potemkin :as p])) | |
(set! *warn-on-reflection* true) | |
(p/defprotocol+ IModel
:extend-via-metadata true
"Protocol for something that is-a or has-a model."
(model [this]
"Get the Toucan model associated with `this`.")) | |
(extend-protocol IModel
nil
(model [_this]
nil)
Object
(model [_this]
nil)) | |
(p/defprotocol+ IWithModel
:extend-via-metadata true
"Protocol for something that has-a model that supports creating a copy with a different model."
(^{:style/indent nil} with-model [this new-model]
"Return a copy of `instance` with its model set to `new-model.`")) | |
there are some default impls of [[with-model]] in [[toucan2.instance]] | |
Protocol for something that records the changes made to it, e.g. a Toucan instance. | (p/defprotocol+ IRecordChanges
(original [instance]
"Get the original version of `instance` as it appeared when it first came out of the DB.")
(^{:style/indent nil} with-original [instance new-original]
"Return a copy of `instance` with its `original` map set to `new-original`.")
(current [instance]
"Return the underlying map representing the current state of an `instance`.")
(^{:style/indent nil} with-current [instance new-current]
"Return a copy of `instance` with its underlying `current` map set to `new-current`.")
(changes [instance]
"Get a map with any changes made to `instance` since it came out of the DB. Only includes keys that have been
added or given different values; keys that were removed are not counted. Returns `nil` if there are no changes.")) |
| (extend-protocol IRecordChanges
nil
(original [_this]
nil)
;; (with-original [this])
(current [_this]
nil)
;; (with-current [this])
(changes [_this]
nil)
;; generally just treat a plain map like an instance with nil model/and original = nil,
;; and no-op for anything that would require "upgrading" the map to an actual instance in such a way that if
;;
;; (= plain-map instance)
;;
;; then
;;
;; (= (f plain-map) (f instance))
clojure.lang.IPersistentMap
(original [_this]
nil)
(with-original [this _m]
this)
(current [this]
this)
(with-current [_this new-current]
new-current)
;; treat the entire map as `changes` -- that way if you accidentally do something like
;;
;; (merge plain-map instance)
;;
;; in a `before-update` method, you don't accidentally shoot yourself in the foot and break `update!` or the like.
(changes [this]
this)) |
(p/defprotocol+ IDispatchValue
:extend-via-metadata true
"Protocol to get the value to use for multimethod dispatch in Toucan from something."
(dispatch-value
[this]
"Get the value that we should dispatch off of in multimethods for `this`. By default, the dispatch of a keyword is
itself while the dispatch value of everything else is its [[type]].")) | |
(extend-protocol IDispatchValue
Object
(dispatch-value [x]
(type x))
nil
(dispatch-value [_nil]
nil)
clojure.lang.Keyword
(dispatch-value [k]
k)) | |
(p/defprotocol+ IDeferrableUpdate
(deferrable-update [this k f]
"Like [[clojure.core/update]], but this update can be deferred until later. For things like transient rows where you
might want to apply transforms to values that ultimately get realized, but not *cause* them to be realized. Unlike
[[clojure.core/update]], does not support additional args to pass to `f`.")) | |
(extend-protocol IDeferrableUpdate
nil
(deferrable-update [_this k f]
(update nil k f))
clojure.lang.IPersistentMap
(deferrable-update [m k f]
(update m k f))) | |
(ns toucan2.query (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.model :as model] [toucan2.types :as types] [toucan2.util :as u])) | |
(comment types/keep-me) | |
[[parse-args]] | |
(s/def ::default-args.connectable
(s/? (s/cat :key (partial = :conn)
:connectable any?))) | |
(s/def ::default-args.modelable.column
(s/or :column keyword?
:expr-column (s/cat :expr any?
:column (s/? keyword?)))) | |
(s/def ::default-args.modelable
(s/or
:modelable (complement sequential?)
:modelable-columns (s/cat :modelable some? ; can't have a nil model. Or can you?
:columns (s/* (s/nonconforming ::default-args.modelable.column))))) | |
TODO -- can we use [[s/every-kv]] for this stuff? | (s/def ::default-args.kv-args
(s/* (s/cat
:k any?
:v any?))) |
(s/def ::default-args.queryable (s/? any?)) | |
(s/def ::default-args (s/cat :connectable ::default-args.connectable :modelable ::default-args.modelable :kv-args ::default-args.kv-args :queryable ::default-args.queryable)) | |
(s/def :toucan2.query.parsed-args/modelable some?) | |
(s/def :toucan2.query.parsed-args/kv-args (some-fn nil? map?)) | |
(s/def :toucan2.query.parsed-args/columns (some-fn nil? sequential?)) | |
(s/def ::parsed-args
(s/keys :req-un [:toucan2.query.parsed-args/modelable]
:opt-un [:toucan2.query.parsed-args/kv-args
:toucan2.query.parsed-args/columns])) | |
(defn- validate-parsed-args [parsed-args]
(u/try-with-error-context ["validate parsed args" {::parsed-args parsed-args}]
(let [result (s/conform ::parsed-args parsed-args)]
(when (s/invalid? result)
(throw (ex-info (format "Invalid parsed args: %s" (s/explain-str ::parsed-args parsed-args))
(s/explain-data ::parsed-args parsed-args))))))) | |
Parse | (defn parse-args-with-spec
[query-type spec unparsed-args]
(u/try-with-error-context ["parse args" {::query-type query-type, ::unparsed-args unparsed-args}]
(log/debugf "Parse args for query type %s %s" query-type unparsed-args)
(let [parsed (s/conform spec unparsed-args)]
(when (s/invalid? parsed)
(throw (ex-info (format "Don't know how to interpret %s args: %s"
(pr-str query-type)
(s/explain-str spec unparsed-args))
(s/explain-data spec unparsed-args))))
(log/tracef "Conformed args: %s" parsed)
(let [parsed (cond-> parsed
(:modelable parsed) (merge (let [[modelable-type x] (:modelable parsed)]
(case modelable-type
:modelable {:modelable x}
:modelable-columns x)))
(:connectable parsed) (update :connectable :connectable)
(not (contains? parsed :queryable)) (assoc :queryable {})
(seq (:kv-args parsed)) (update :kv-args (fn [kv-args]
(into {} (map (juxt :k :v)) kv-args))))]
(log/debugf "Parsed => %s" parsed)
(validate-parsed-args parsed)
parsed)))) |
These keys are commonly returned by several of the different implementations
| (m/defmulti parse-args
{:arglists '([query-type₁ unparsed-args])
:defmethod-arities #{2}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.query-type)}
u/dispatch-on-first-arg) |
(m/defmethod parse-args :default "The default implementation calls [[parse-args-with-spec]] with the `:toucan2.query/default-args` spec." [query-type unparsed-args] (parse-args-with-spec query-type ::default-args unparsed-args)) | |
Part of the default [[pipeline/build]] for maps: applying key-value args | |
Merge a key-value pair into a ```clj (apply-kv-arg :default {} :k :v) ;; => {:where [:= :k :v]} ``` You can add new implementations of this method to special behaviors for support arbitrary keys, or to support new
query backends. | (m/defmulti apply-kv-arg
{:arglists '([model₁ resolved-query₂ k₃ v])
:defmethod-arities #{4}
:dispatch-value-spec (types/or-default-spec
(s/cat :model ::types/dispatch-value.model
:resolved-query ::types/dispatch-value.query
:k keyword?))}
u/dispatch-on-first-three-args) |
(comment ;; with a composite PK like [:id :name] ;; we need to be able to handle either [:in [["BevMo" 4] ["BevLess" 5]]] ;; or [:between ["BevMo" 4] ["BevLess" 5]]) | |
(defn- toucan-pk-composite-values** [pk-columns tuple]
{:pre [(= (count pk-columns) (count tuple))]}
(map-indexed (fn [i col]
{:col col, :v (nth tuple i)})
pk-columns)) | |
(defn- toucan-pk-nested-composite-values [pk-columns tuples]
(->> (mapcat (fn [tuple]
(toucan-pk-composite-values** pk-columns tuple))
tuples)
(group-by :col)
(map (fn [[col ms]]
{:col col, :v (mapv :v ms)})))) | |
(defn- toucan-pk-composite-values* [pk-columns tuple]
(if (some sequential? tuple)
(toucan-pk-nested-composite-values pk-columns tuple)
(toucan-pk-composite-values** pk-columns tuple))) | |
(defn- toucan-pk-fn-values [pk-columns fn-name tuples]
(->> (mapcat (fn [tuple]
(toucan-pk-composite-values* pk-columns tuple))
tuples)
(group-by :col)
(map (fn [[col ms]]
{:col col, :v (into [fn-name] (map :v) ms)})))) | |
(defn- toucan-pk-composite-values [pk-columns tuple]
{:pre [(sequential? tuple)], :post [(sequential? %) (every? map? %) (every? :col %)]}
(if (keyword? (first tuple))
(toucan-pk-fn-values pk-columns (first tuple) (rest tuple))
(toucan-pk-composite-values* pk-columns tuple))) | |
(defn- apply-non-composite-toucan-pk [model m pk-column v]
;; unwrap the value if we got something like `:toucan/pk [1]`
(let [v (if (and (sequential? v)
(not (keyword? (first v)))
(= (count v) 1))
(first v)
v)]
(apply-kv-arg model m pk-column v))) | |
(defn- apply-composite-toucan-pk [model m pk-columns v]
(reduce
(fn [m {:keys [col v]}]
(apply-kv-arg model m col v))
m
(toucan-pk-composite-values pk-columns v))) | |
(m/defmethod apply-kv-arg :around [#_model :default #_query :default #_k :toucan/pk]
"Implementation for handling key-value args for `:toucan/pk`.
This is an `:around` so we can intercept the normal handler. This 'unpacks' the PK and ultimately uses the normal
calls to [[apply-kv-arg]]."
[model honeysql _k v]
;; `fn-name` here would be if you passed something like `:toucan/pk [:in 1 2]` -- the fn name would be `:in` -- and we
;; pass that to [[condition->honeysql-where-clause]]
(let [pk-columns (model/primary-keys model)]
(log/debugf "apply :toucan/pk %s for primary keys" v)
(if (= (count pk-columns) 1)
(apply-non-composite-toucan-pk model honeysql (first pk-columns) v)
(apply-composite-toucan-pk model honeysql pk-columns v)))) | |
Convenience. Merge a map of | (defn apply-kv-args
[model query kv-args]
(log/debugf "Apply kv-args %s" kv-args)
(reduce
(fn [query [k v]]
(apply-kv-arg model query k v))
query
kv-args)) |
(ns toucan2.realize (:require [potemkin :as p] [toucan2.log :as log] [toucan2.util :as u])) | |
(set! *warn-on-reflection* true) | |
TODO -- this should probably be moved to [[toucan2.protocols]], and be renamed | (p/defprotocol+ Realize
(realize [x]
"Fully realize either a reducible query, or a result row from that query.")) |
(defn- realize-IReduceInit [this]
(log/tracef "realize IReduceInit %s" (symbol (.getCanonicalName (class this))))
(u/try-with-error-context ["realize IReduceInit" {::reducible this}]
(into []
(map (fn [row]
(log/tracef "realize row ^%s %s" (some-> row class .getCanonicalName symbol) row)
(u/try-with-error-context ["realize row" {::row row}]
(realize row))))
this))) | |
(extend-protocol Realize
Object
(realize [this]
(log/tracef "Already realized: %s" (class this))
this)
;; Eduction is assumed to be for query results.
;; TODO -- isn't an Eduction an IReduceInit??
clojure.core.Eduction
(realize [this]
(into [] (map realize) this))
clojure.lang.IReduceInit
(realize [this]
(realize-IReduceInit this))
nil
(realize [_]
nil)) | |
(ns toucan2.save (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.connection :as conn] [toucan2.instance :as instance] [toucan2.log :as log] [toucan2.model :as model] [toucan2.protocols :as protocols] [toucan2.types :as types] [toucan2.update :as update] [toucan2.util :as u])) | |
(comment s/keep-me
types/keep-me) | |
(set! *warn-on-reflection* true) | |
(m/defmulti save!*
{:arglists '([object])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
(fn [object]
(protocols/dispatch-value (protocols/model object)))) | |
(m/defmethod save!* :around :default
[object]
(u/try-with-error-context ["save changes" {::model (protocols/model object)
::object object
::changes (protocols/changes object)}]
(log/debugf "Save %s %s changes %s" (protocols/model object) object (protocols/changes object))
(next-method object))) | |
(m/defmethod save!* :default
[object]
(assert (instance/instance? object)
(format "Don't know how to save something that's not a Toucan instance. Got: ^%s %s"
(some-> object class .getCanonicalName)
(pr-str object)))
(if-let [changes (not-empty (protocols/changes object))]
(let [model (protocols/model object)
pk-values (select-keys object (model/primary-keys (protocols/model object)))
rows-affected (update/update! model pk-values changes)]
(when-not (pos? rows-affected)
(throw (ex-info (format "Unable to save object: %s with primary key %s does not exist."
(pr-str model)
(pr-str pk-values))
{:object object
:pk pk-values})))
(when (> rows-affected 1)
(log/warnf "Warning: more than 1 row affected when saving %s with primary key %s" model pk-values))
(instance/reset-original object))
object)) | |
(defn save!
([object]
(save!* object))
([connectable object]
(if connectable
(binding [conn/*current-connectable* connectable]
(save!* object))
(save!* object)))) | |
Implementation of [[select]] and variations. The args spec used by [[select]] lives in [[toucan2.query]], specifically Code for building Honey SQL for a SELECT lives in [[toucan2.honeysql2]]. Functions that return primary keysFunctions that return primary keys such as [[select-pks-set]] determine which primary keys to return by
calling [[toucan2.model/select-pks-fn]], which is based on the model's implementation
of [[toucan2.model/primary-keys]]. Models with just a single primary key column will return primary keys 'unwrapped',
i.e., the values of that column will be returned directly. Models with compound primary keys (i.e., primary keys
consisting of more than one column) will be returned in vectors as if by calling ```clj ;; A model with a one-column primary key, :id (t2/select-pks-vec :models/venues :category "bar") ;; => [1 2] ;; A model with a compound primary key, [:id :name] (t2/select-pks-vec :models/venues.compound-key :category "bar") ;; => [[1 "Tempest"] [2 "Ho's Tavern"]] ``` | (ns toucan2.select (:refer-clojure :exclude [count]) (:require [clojure.spec.alpha :as s] [toucan2.log :as log] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.realize :as realize] [toucan2.types :as types])) |
(comment s/keep-me
types/keep-me) | |
Like [[select]], but returns an | (defn reducible-select
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[& unparsed-args]
(pipeline/reducible-unparsed :toucan.query-type/select.instances unparsed-args)) |
(defn select
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/select.instances unparsed-args)) | |
Like [[select]], but only fetches a single row, and returns only that row. | (defn select-one
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[& unparsed-args]
(let [query-type :toucan.query-type/select.instances
rf (pipeline/default-rf query-type)
xform (pipeline/first-result-xform-fn query-type)]
(pipeline/transduce-unparsed (xform rf) query-type unparsed-args))) |
Like [[reducible-select]], but returns a reducible sequence of results of | (defn select-fn-reducible
{:arglists '([f modelable-columns & kv-args? query?]
[f :conn connectable modelable-columns & kv-args? query?])}
[f & unparsed-args]
(eduction
(map f)
(pipeline/reducible-unparsed :toucan.query-type/select.instances.fns unparsed-args))) |
Like [[select]], but returns a set of values of ```clj (t2/select-fn-set (comp str/upper-case :category) :models/venues :category "bar") ;; => {"BAR"}``` | (defn select-fn-set
{:arglists '([f modelable-columns & kv-args? query?]
[f :conn connectable modelable-columns & kv-args? query?])}
[f & unparsed-args]
(let [f (comp realize/realize f)
rf (pipeline/with-init conj #{})
xform (map f)]
(not-empty (pipeline/transduce-unparsed (xform rf) :toucan.query-type/select.instances.fns unparsed-args)))) |
Like [[select]], but returns a vector of values of ```clj (t2/select-fn-vec (comp str/upper-case :category) :models/venues :category "bar") ;; => ["BAR" "BAR"] ``` NOTE: If your query does not specify an | (defn select-fn-vec
{:arglists '([f modelable-columns & kv-args? query?]
[f :conn connectable modelable-columns & kv-args? query?])}
[f & unparsed-args]
(let [f (comp realize/realize f)
rf (pipeline/with-init conj [])
xform (map f)]
(not-empty (pipeline/transduce-unparsed (xform rf) :toucan.query-type/select.instances.fns unparsed-args)))) |
Like [[select-one]], but applies ```clj (t2/select-one-fn :id :models/people :name "Cam") ;; => 1 ``` | (defn select-one-fn
{:arglists '([f modelable-columns & kv-args? query?]
[f :conn connectable modelable-columns & kv-args? query?])}
[f & unparsed-args]
(let [query-type :toucan.query-type/select.instances.fns
f (comp realize/realize f)
rf (pipeline/with-init conj [])
xform (comp (map f)
(pipeline/first-result-xform-fn query-type))]
(pipeline/transduce-unparsed (xform rf) query-type unparsed-args))) |
Returns a reducible sequence of all primary keys ```clj (into [] (t2/select-pks-reducible :models/venues :category "bar")) ;; => [1 2] ``` | (defn select-pks-reducible
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[modelable & unparsed-args]
(apply select-fn-reducible (model/select-pks-fn modelable) modelable unparsed-args)) |
Returns a set of all primary keys (as determined by [[toucan2.model/primary-keys]]
and [[toucan2.model/select-pks-fn]]) of instances matching the query. Models with just a single primary key columns
will be 'unwrapped' (i.e., the values of that column will be returned); models with compound primary keys (i.e., more
than one column) will be returned in vectors as if by calling ```clj (t2/select-pks-set :models/venues :category "bar") ;; => #{1 2} ``` | (defn select-pks-set
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[modelable & unparsed-args]
(apply select-fn-set (model/select-pks-fn modelable) modelable unparsed-args)) |
Returns a vector of all primary keys (as determined by [[toucan2.model/primary-keys]]
and [[toucan2.model/select-pks-fn]]) of instances matching the query. Models with just a single primary key columns
will be 'unwrapped' (i.e., the values of that column will be returned); models with compound primary keys (i.e., more
than one column) will be returned in vectors as if by calling ```clj (t2/select-pks-vec :models/venues :category "bar") ;; => [1 2] ``` NOTE: If your query does not specify an | (defn select-pks-vec
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[modelable & unparsed-args]
(apply select-fn-vec (model/select-pks-fn modelable) modelable unparsed-args)) |
Return the primary key of the first row matching the query. Models with just a single primary key columns will be
'unwrapped' (i.e., the values of that column will be returned); models with compound primary keys (i.e., more than one
column) will be returned in vectors as if by calling ```clj (t2/select-one-pk :models/people :name "Cam") ;; => 1 ``` | (defn select-one-pk
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[modelable & unparsed-args]
(apply select-one-fn (model/select-pks-fn modelable) modelable unparsed-args)) |
Return a map of ```clj (t2/select-fn->fn :id (comp str/upper-case :name) :models/people) ;; => {1 "CAM", 2 "SAM", 3 "PAM", 4 "TAM"} ``` | (defn select-fn->fn
{:arglists '([f1 f2 modelable-columns & kv-args? query?]
[f1 f2 :conn connectable modelable-columns & kv-args? query?])}
[f1 f2 & unparsed-args]
(let [f1 (comp realize/realize f1)
f2 (comp realize/realize f2)
rf (pipeline/with-init conj {})
xform (map (juxt f1 f2))]
(pipeline/transduce-unparsed (xform rf) :toucan.query-type/select.instances unparsed-args))) |
The inverse of [[select-pk->fn]]. Return a map of ```clj (t2/select-fn->pk (comp str/upper-case :name) :models/people) ;; => {"CAM" 1, "SAM" 2, "PAM" 3, "TAM" 4} ``` | (defn select-fn->pk
{:arglists '([f modelable-columns & kv-args? query?]
[f :conn connectable modelable-columns & kv-args? query?])}
[f modelable & args]
(let [pks-fn (model/select-pks-fn modelable)]
(apply select-fn->fn f pks-fn modelable args))) |
The inverse of [[select-fn->pk]]. Return a map of primary key -> ```clj (t2/select-pk->fn (comp str/upper-case :name) :models/people) ;; => {1 "CAM", 2 "SAM", 3 "PAM", 4 "TAM"} ``` | (defn select-pk->fn
{:arglists '([f modelable-columns & kv-args? query?]
[f :conn connectable modelable-columns & kv-args? query?])}
[f modelable & args]
(let [pks-fn (model/select-pks-fn modelable)]
(apply select-fn->fn pks-fn f modelable args))) |
(defn- count-rf []
(let [logged-warning? (atom false)
log-warning (fn []
(when-not @logged-warning?
(log/warnf "Warning: inefficient count query. See documentation for toucan2.select/count.")
(reset! logged-warning? true)))]
(fn count-rf*
([] 0)
([acc] acc)
([acc row]
(if (:count row)
(+ acc (:count row))
(do (log-warning)
(inc acc))))))) | |
Like [[select]], but returns the number of rows that match in an efficient way. Implementation note:The default Honey SQL 2 map query compilation backend builds an efficient ```sql SELECT count(*) AS "count" FROM ... ``` query. Custom query compilation backends should do the equivalent by implementing [[toucan2.pipeline/build]] for the
query type | (defn count
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[& unparsed-args]
(pipeline/transduce-unparsed (count-rf) :toucan.query-type/select.count unparsed-args)) |
(defn- exists?-rf
([] false)
([acc] acc)
([_acc row]
(if (contains? row :exists)
(let [exists (:exists row)
result (if (integer? exists)
(pos? exists)
(boolean exists))]
(if (true? result)
(reduced true)
false))
(do
(log/warnf "Warning: inefficient exists? query. See documentation for toucan2.select/exists?.")
(reduced true))))) | |
Like [[select]], but returns whether or not any rows match in an efficient way. Implementation note:The default Honey SQL 2 map query compilation backend builds an efficient ```sql SELECT exists(SELECT 1 FROM ... WHERE ...) AS exists ``` | (defn exists?
{:arglists '([modelable-columns & kv-args? query?]
[:conn connectable modelable-columns & kv-args? query?])}
[& unparsed-args]
(pipeline/transduce-unparsed exists?-rf :toucan.query-type/select.exists unparsed-args)) |
Common code shared by various | (ns toucan2.tools.after (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.types :as types] [toucan2.util :as u])) |
(set! *warn-on-reflection* true) | |
Should return a function with the signature ```clj (f instance) ``` This function is only done for side-effects for query types that return update counts or PKs. | (m/defmulti each-row-fn
{:arglists '([query-type₁ model₂])
:defmethod-arities #{2}
:dispatch-value-spec ::types/dispatch-value.query-type-model}
u/dispatch-on-first-two-args) |
(m/defmethod each-row-fn :after :default
[query-type f]
(assert (fn? f)
(format "Expected each-row-fn for query type %s to return a function, got ^%s %s"
(pr-str query-type)
(some-> f class .getCanonicalName)
(pr-str f)))
f) | |
(m/defmethod pipeline/results-transform [#_query-type :toucan.result-type/instances #_model ::model]
[query-type model]
;; if there's no [[each-row-fn]] for this `query-type` then we don't need to apply any transforms. Example: maybe a
;; model has an [[each-row-fn]] for `INSERT` queries, but not for `UPDATE`. Since the model derives from `::model`, we
;; end up here either way. But if `query-type` is `UPDATE` we shouldn't touch the query.
(if (m/is-default-primary-method? each-row-fn [query-type model])
(next-method query-type model)
(let [row-fn (each-row-fn query-type model)
row-fn (fn [row]
(u/try-with-error-context ["Apply after row fn" {::query-type query-type, ::model model}]
(log/debugf "Apply after %s for %s" query-type model)
(let [result (row-fn row)]
;; if the row fn didn't return something (not generally necessary for something like
;; `after-update` which is always done for side effects) then return the original row. We still
;; need it for stuff like getting the PKs back out.
(if (some? result)
result
row))))
xform (map row-fn)]
(comp xform
(next-method query-type model))))) | |
(m/defmulti ^:private result-type-rf
{:arglists '([original-query-type₁ model rf])
:defmethod-arities #{3}
:dispatch-value-spec ::types/dispatch-value.query-type}
u/dispatch-on-first-arg) | |
(m/defmethod result-type-rf :toucan.result-type/update-count "Reducing function transform that will return the count of rows." [_original-query-type _model rf] ((map (constantly 1)) rf)) | |
(m/defmethod result-type-rf :toucan.result-type/pks
"Reducing function transform that will return just the PKs (as single values or vectors of values) by getting them from
row maps (instances)."
[_original-query-type model rf]
(let [pks-fn (model/select-pks-fn model)]
((map (fn [row]
(assert (map? row))
(pks-fn row)))
rf))) | |
(derive ::query-type :toucan.query-type/abstract) | |
(m/defmethod pipeline/transduce-query [#_query-type ::query-type
#_model ::model
#_resolved-query :default]
"'Upgrade' a query so that it returns instances, and run the upgraded query so that we can apply [[each-row-fn]] to the
results. Then apply [[result-type-rf]] to the results of the original expected type are ultimately returned."
[rf query-type model parsed-args resolved-query]
(if (or
;; only "upgrade" the query if there's an applicable [[each-row-fn]] to apply.
(m/is-default-primary-method? each-row-fn [query-type model])
;; there's no need to "upgrade" the query if it's already returning instances.
(isa? query-type :toucan.result-type/instances))
(next-method rf query-type model parsed-args resolved-query)
;; otherwise we need to run an upgraded query but then transform the results back to the originals
;; with [[result-type-rf]]
(let [upgraded-type (types/similar-query-type-returning query-type :toucan.result-type/instances)
_ (assert upgraded-type (format "Don't know how to upgrade a %s query to one returning instances"
query-type))
rf* (result-type-rf query-type model rf)]
(pipeline/transduce-query rf* upgraded-type model parsed-args resolved-query)))) | |
(defn ^:no-doc ^{:style/indent [:form]} define-after-impl
[next-method query-type model row-fn]
(let [f (fn [row]
(or (row-fn row)
row))
next-f (when next-method
(next-method query-type model))]
(if next-f
(comp next-f f)
f))) | |
(defmacro define-after
[query-type model [instance-binding] & body]
`(do
(u/maybe-derive ~model ::model)
(m/defmethod each-row-fn [~query-type ~model]
[~'&query-type ~'&model]
(define-after-impl ~'next-method
~'&query-type
~'&model
(fn [~instance-binding]
~@body))))) | |
(s/fdef define-after*
:args (s/cat :query-type #(isa? % :toucan.query-type/*)
:model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.after-insert (:require [clojure.spec.alpha :as s] [toucan2.tools.after :as tools.after])) | |
(derive :toucan.query-type/insert.* ::tools.after/query-type) | |
(defmacro define-after-insert
{:style/indent :defn}
[model [instance-binding] & body]
`(tools.after/define-after :toucan.query-type/insert.*
~model
[~instance-binding]
~@body)) | |
(s/fdef define-after-insert
:args (s/cat :model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.after-select (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.pipeline :as pipeline] [toucan2.tools.simple-out-transform :as tools.simple-out-transform] [toucan2.types :as types] [toucan2.util :as u])) | |
(comment types/keep-me) | |
(m/defmulti after-select
{:arglists '([instance])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) | |
Do after-select for anything returning instances, not just SELECT. [[toucan2.insert/insert-returning-instances!]] should do after-select as well. | (tools.simple-out-transform/define-out-transform [:toucan.result-type/instances ::after-select]
[instance]
(if (isa? &query-type :toucan.query-type/select.instances-from-pks)
instance
(after-select instance))) |
(defmacro define-after-select
{:style/indent :defn}
[model [instance-binding] & body]
`(do
(u/maybe-derive ~model ::after-select)
(m/defmethod after-select ~model
[instance#]
(let [~instance-binding (cond-> instance#
~'next-method ~'next-method)]
~@body)))) | |
(s/fdef define-after-select
:args (s/cat :model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
| (m/prefer-method! #'pipeline/results-transform
[:toucan.result-type/instances ::after-select]
[:toucan.result-type/instances :toucan2.tools.after/model]) |
(ns toucan2.tools.after-update (:require [clojure.spec.alpha :as s] [toucan2.tools.after :as tools.after])) | |
(derive :toucan.query-type/update.* ::tools.after/query-type) | |
The value of this is ultimately ignored, but when composing multiple | (defmacro define-after-update
{:style/indent :defn}
[model [instance-binding] & body]
`(tools.after/define-after :toucan.query-type/update.*
~model
[~instance-binding]
~@body)) |
(s/fdef define-after-update
:args (s/cat :model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.before-delete (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.connection :as conn] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.realize :as realize] [toucan2.types :as types] [toucan2.util :as u])) | |
(set! *warn-on-reflection* true) | |
(comment types/keep-me) | |
Underlying method implemented when using [[define-before-delete]]. You probably shouldn't be adding implementations to this method directly, unless you know what you are doing! | (m/defmulti before-delete
{:arglists '([model₁ instance])
:defmethod-arities #{2}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod before-delete :around :default [model instance] (log/tracef "Do before-delete for %s %s" model instance) (next-method model instance)) | |
Select and transduce the matching rows and run their [[before-delete]] methods. | (defn- do-before-delete-for-matching-rows!
[model parsed-args resolved-query]
(pipeline/transduce-query
((map (fn [row]
;; this is another case where we don't NEED to fully realize the rows but it's a big hassle for people
;; to use this if we don't. Let's be nice and realize things for people.
(before-delete model (realize/realize row))))
(constantly nil))
:toucan.query-type/select.instances
model
parsed-args
resolved-query)) |
(m/defmethod pipeline/transduce-query [#_query-type :toucan.query-type/delete.*
#_model ::before-delete
#_resolved-query :default]
"Do a recursive SELECT query with the args passed to `delete!`; apply [[before-delete]] to all matching rows. Then call
the `next-method`. This is all done inside of a transaction."
[rf query-type model parsed-args resolved-query]
(conn/with-transaction [_conn nil {:nested-transaction-rule :ignore}]
(do-before-delete-for-matching-rows! model parsed-args resolved-query)
(next-method rf query-type model parsed-args resolved-query))) | |
Implementation of [[define-before-delete]]; don't call this directly. | (defn ^:no-doc -before-delete-impl
[next-method model instance f]
;; if `f` didn't return anything, just use the original instance again.
(let [result (or (f model instance)
instance)]
(if next-method
(next-method model result)
result))) |
Define a method that will be called for every instance that is about to be deleted. The results of this before-delete method are ultimately ignored, but the entire operation (both the original delete and the recursive select) are done in a transaction, so you can use before-delete to enforce preconditions and abort deletes when they fail, or do something for side effects. Before-delete is implemented by first selecting all the rows matching the [[toucan2.delete/delete!]] conditions and
then transducing those rows and calling the [[before-delete]] method this macro defines on each row. Because
before-delete has to fetch every instance matching the condition, defining a before-delete method can be quite
expensive! For example, a To skip before-delete behavior, you can always use the model's raw table name directly, e.g. ```clj (t2/delete! (t2/table-name :models/user) ...) ``` This might be wise when deleting a large number of rows. | (defmacro define-before-delete
{:style/indent :defn}
[model [instance-binding] & body]
`(do
(u/maybe-derive ~model ::before-delete)
(m/defmethod before-delete ~model
[model# instance#]
(-before-delete-impl ~'next-method
model#
instance#
(fn [~'&model ~instance-binding]
~@body))))) |
(s/fdef define-before-delete
:args (s/cat :model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.before-insert (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.connection :as conn] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.types :as types] [toucan2.util :as u])) | |
(comment types/keep-me) | |
(m/defmulti before-insert
{:arglists '([model₁ row])
:defmethod-arities #{2}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) | |
(defn- do-before-insert-to-rows [rows model]
(mapv
(fn [row]
(u/try-with-error-context [`before-insert {::model model, ::row row}]
(log/tracef "Do before-insert for %s %s" model row)
(let [result (before-insert model row)]
(log/tracef "[before insert] => %s" row)
result)))
rows)) | |
make sure we transform rows whether it's in the parsed args or in the resolved query. | |
(m/defmethod pipeline/transduce-query :around [#_query-type :toucan.query-type/insert.*
#_model ::before-insert
#_resolved-query :default]
"Execute [[before-insert]] methods and the INSERT query inside a transaction."
[rf query-type model parsed-args resolved-query]
(conn/with-transaction [_conn nil {:nested-transaction-rule :ignore}]
(next-method rf query-type model parsed-args resolved-query))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/insert.*
#_model ::before-insert
#_resolved-query clojure.lang.IPersistentMap]
"Apply [[before-insert]] to `:rows` in the `resolved-query` or `parsed-args` for Honey SQL queries."
[query-type model parsed-args resolved-query]
;; not 100% sure why either `parsed-args` OR `resolved-query` can have `:rows` but I guess we have to update either
;; one
(let [parsed-args (cond-> parsed-args
(:rows parsed-args) (update :rows do-before-insert-to-rows model))
resolved-query (cond-> resolved-query
(:rows resolved-query) (update :rows do-before-insert-to-rows model))]
(next-method query-type model parsed-args resolved-query))) | |
Important! before-insert should be done BEFORE any [[toucan2.tools.transformed/transforms]]. Transforms are often for serializing and deserializing values; we don't want before insert methods to have to work with already-serialized values. By marking | #_(m/prefer-method! #'pipeline/transduce-with-model
[:toucan.query-type/insert.* ::before-insert]
[:toucan.query-type/insert.* :toucan2.tools.transformed/transformed.model])
(defmacro define-before-insert
{:style/indent :defn}
[model [instance-binding] & body]
`(do
(u/maybe-derive ~model ::before-insert)
(m/defmethod before-insert ~model
[~'&model ~instance-binding]
(cond->> (do ~@body)
~'next-method (~'next-method ~'&model))))) |
(s/fdef define-before-insert
:args (s/cat :model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.before-select (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.types :as types] [toucan2.util :as u])) | |
(set! *warn-on-reflection* true) | |
(comment types/keep-me) | |
Impl for [[define-before-select]]. | (m/defmulti before-select
{:arglists '([model₁ parsed-args])
:defmethod-arities #{2}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod before-select :around :default
[model parsed-args]
(u/try-with-error-context ["before select" {::model model}]
(log/debugf "do before-select for %s" model)
(let [result (next-method model parsed-args)]
(log/debugf "[before select] => %s" result)
result))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.*
#_model ::model
#_resolved-query :default]
[query-type model parsed-args resolved-query]
(let [parsed-args (before-select model parsed-args)]
(next-method query-type model parsed-args resolved-query))) | |
(defmacro define-before-select
{:style/indent :defn}
[model [args-binding] & body]
`(do
(u/maybe-derive ~model ::model)
(m/defmethod before-select ~model
[~'&model ~args-binding]
(cond->> (do ~@body)
~'next-method
(~'next-method ~'&model))))) | |
(s/fdef define-before-select
:args (s/cat :dispatch-value some?
:bindings (s/spec (s/cat :args :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.before-update (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.connection :as conn] [toucan2.instance :as instance] [toucan2.log :as log] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.protocols :as protocols] [toucan2.realize :as realize] [toucan2.types :as types] [toucan2.util :as u])) | |
(set! *warn-on-reflection* true) | |
(comment types/keep-me) | |
(derive ::select-for-before-update :toucan.query-type/select.instances.from-update) | |
Do before-update operations for side effects and transformations to a | (m/defmulti before-update
{:arglists '([model₁ row])
:defmethod-arities #{2}
;; work around https://github.com/camsaul/methodical/issues/142
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod before-update :around :default
[model row]
(assert (map? row) (format "Expected a map row, got ^%s %s" (some-> row class .getCanonicalName) (pr-str row)))
(log/debugf "before-update %s %s" model row)
(let [result (next-method model row)]
(assert (map? result) (format "%s for %s should return a map, got %s" `before-update model (pr-str result)))
(log/debugf "[before-update] => %s" result)
result)) | |
(defn- changes->affected-pk-maps-rf [model changes]
(assert (map? changes) (format "Expected changes to be a map, got %s" (pr-str changes)))
(fn
([] {})
([m]
(assert (map? m) (format "changes->affected-pk-maps-rf should have returned a map, got %s" (pr-str m)))
m)
([changes->pks row]
(assert (map? changes->pks))
(assert (map? row) (format "%s expected a map row, got %s" `changes->affected-pk-maps (pr-str row)))
;; After going back and forth on this I've concluded that it's probably best to just realize the entire row here.
;; There are a lot of situations where we don't need to do this, but it means we have to step on eggshells
;; everywhere else in order to make things work nicely. Maybe we can revisit this in the future.
(let [row (realize/realize row)
row (merge row changes)
row (before-update model row)
;; if the `before-update` method returned a plain map then consider that to be the changes.
;; `protocols/changes` will return `nil` for non-instances. TODO -- does that behavior make sense? Clearly,
;; it's easy to use wrong -- it took me hours to figure out why something was working and that I needed to
;; make this change :sad:
row-changes (if (instance/instance? row)
(protocols/changes row)
row)]
(log/tracef "The following values have changed: %s" changes)
(cond-> changes->pks
(seq row-changes) (update row-changes (fn [pks]
(conj (set pks) (model/primary-key-values-map model row))))))))) | |
(defn- fetch-changes->pk-maps [model {:keys [changes], :as parsed-args} resolved-query]
(not-empty
(pipeline/transduce-query
(changes->affected-pk-maps-rf model changes)
::select-for-before-update
model
parsed-args
resolved-query))) | |
Fetch the matching rows based on original TODO -- this is sort of problematic since it breaks [[toucan2.tools.compile]] | (defn- apply-before-update-to-matching-rows
[model {:keys [changes], :as parsed-args} resolved-query]
(u/try-with-error-context ["apply before-update to matching rows" {::model model, ::changes changes}]
(log/debugf "apply before-update to matching rows for %s" model)
(when-let [changes->pk-maps (fetch-changes->pk-maps model parsed-args resolved-query)]
(log/tracef "changes->pk-maps = %s" changes->pk-maps)
(if (= (count changes->pk-maps) 1)
;; every row has the same exact changes: we only need to perform a single update, using the original
;; conditions.
[(assoc parsed-args :changes (first (keys changes->pk-maps)))]
;; more than one set of changes: need to do multiple updates.
(for [[changes pk-maps] changes->pk-maps
pk-map pk-maps]
(assoc parsed-args :changes changes, :kv-args pk-map)))))) |
(m/defmethod pipeline/transduce-query [#_query-type :toucan.query-type/update.*
#_model ::before-update
#_resolved-query :default]
"Apply [[toucan2.tools.before-update/before-update]] to matching rows. If multiple versions of `:changes` are produced
as a result, recursively does an update for each version."
[rf query-type model {::keys [doing-before-update?], :keys [changes], :as parsed-args} resolved-query]
(cond
doing-before-update?
(next-method rf query-type model parsed-args resolved-query)
(empty? changes)
(next-method rf query-type model parsed-args resolved-query)
:else
(let [new-args-maps (apply-before-update-to-matching-rows model
(assoc parsed-args ::doing-before-update? true)
resolved-query)]
(log/debugf "Doing recursive updates with new args maps %s" new-args-maps)
(conn/with-transaction [_conn nil {:nested-transaction-rule :ignore}]
(transduce
(comp (map (fn [args-map]
(next-method rf query-type model args-map resolved-query)))
(if (isa? query-type :toucan.result-type/pks)
cat
identity))
rf
new-args-maps))))) | |
(defmacro define-before-update [model [instance-binding] & body]
`(do
(u/maybe-derive ~model ::before-update)
(m/defmethod before-update ~model
[~'&model ~instance-binding]
(cond->> (do ~@body)
~'next-method
(~'next-method ~'&model))))) | |
(s/fdef define-before-update
:args (s/cat :model some?
:bindings (s/spec (s/cat :instance :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
| (m/prefer-method! #'pipeline/transduce-query
[:toucan.query-type/update.* ::before-update :default]
[:toucan2.tools.after/query-type :toucan2.tools.after/model :default]) |
Macros that can wrap a form and return the built query, compiled query, etc. without executing it. | (ns toucan2.tools.compile (:refer-clojure :exclude [compile]) (:require [toucan2.pipeline :as pipeline])) |
Impl for the [[compile]] macro. Do not use this directly. | (defn ^:no-doc -compile
[thunk]
(binding [pipeline/*transduce-execute* (fn [_rf _query-type _model compiled-query]
compiled-query)]
(thunk))) |
Return the compiled query that would be executed by a form, rather than executing that form itself. ```clj (compile (delete/delete :table :id 1)) => ["DELETE FROM table WHERE ID = ?" 1] ``` | (defmacro compile
{:style/indent 0}
[& body]
`(-compile (^:once fn* [] ~@body))) |
Impl for the [[build]] macro. Do not use this directly. | (defn ^:no-doc -build
[thunk]
(binding [pipeline/*compile* (fn [_query-type _model built-query]
built-query)]
(-compile thunk))) |
Return the built query before compilation that would have been executed by | (defmacro build
{:style/indent 0}
[& body]
`(-build (^:once fn* [] ~@body))) |
(defn -resolved [thunk]
(binding [pipeline/*build* (fn [_query-type _model _parsed-args resolved-query]
resolved-query)]
(-build thunk))) | |
Return the resolved query and parsed args before building a query (e.g. before creating a Honey SQL query from the
args passed to [[toucan2.select/select]] created by | (defmacro resolved
{:style/indent 0}
[& body]
`(-resolved (^:once fn* [] ~@body))) |
(defmacro parsed-args [& body] ) | |
(ns toucan2.tools.debug (:require [toucan2.log :as log] [toucan2.pipeline :as pipeline])) | |
(defn- print-result [message result] (log/-pprint-doc (log/->Doc [(log/->Text message) result])) result) | |
(defn -debug [thunk]
(binding [pipeline/*build* (comp (partial print-result "\nBuilt:")
(let [build* pipeline/*build*]
(fn [query-type model parsed-args resolved-query]
(print-result "\nParsed args:" parsed-args)
(print-result "\nResolved query:" resolved-query)
(build* query-type model parsed-args resolved-query))))
pipeline/*compile* (comp (partial print-result "\nCompiled:") pipeline/*compile*)]
(thunk))) | |
Simple debug macro. This is a placeholder until I come up with a more sophisticated version. | (defmacro debug
{:style/indent 0}
[& body]
`(-debug (^:once fn* [] ~@body))) |
(ns toucan2.tools.default-fields (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.honeysql2 :as t2.honeysql] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.types :as types] [toucan2.util :as u])) | |
(comment types/keep-me) | |
(set! *warn-on-reflection* true) | |
(s/def ::default-field
(s/or :keyword keyword?
:fn-and-alias (s/spec (s/cat :fn ifn?
:keyword keyword?)))) | |
(s/def ::default-fields (s/coll-of ::default-field)) | |
The default fields to return for a model | (m/defmulti default-fields
{:arglists '([model])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod default-fields :around :default
[model]
(let [fields (next-method model)]
(when (s/invalid? (s/conform ::default-fields fields))
(throw (ex-info (format "Invalid default fields for %s: %s" (pr-str model) (s/explain-str ::default-fields fields))
(s/explain-data ::default-fields fields))))
(log/debugf "Default fields for %s: %s" model fields)
fields)) | |
(defn- default-fields-xform [model]
(let [field-fns (mapv (fn [[field-type v]]
(case field-type
:keyword (fn [instance]
[v (get instance v)])
:fn-and-alias (let [{k :keyword, f :fn} v]
(fn [instance]
[k (f instance)]))))
(s/conform ::default-fields (default-fields model)))]
(map (fn [instance]
(log/tracef "Selecting default-fields from instance")
(into (empty instance) (map (fn [field-fn]
(field-fn instance))
field-fns)))))) | |
Whether to skip applying default Fields because the query already includes explicit fields, e.g. | (def ^:dynamic *skip-default-fields* false) |
TODO -- should we skip default fields for a Query that has top-level | (m/defmethod pipeline/transduce-query [#_query-type :toucan.result-type/instances
#_model ::default-fields
#_resolved-query-type clojure.lang.IPersistentMap]
"Skip default fields behavior for Honey SQL queries that contain `:select`. Bind [[*skip-default-fields*]] to `true`."
[rf query-type model parsed-args honeysql]
(if (t2.honeysql/include-default-select? honeysql)
(next-method rf query-type model parsed-args honeysql)
(binding [*skip-default-fields* true]
(log/debugf "Not adding default fields because query already contains `:select` or `:select-distinct`")
(next-method rf query-type model parsed-args honeysql)))) |
(m/defmethod pipeline/results-transform [#_query-type :toucan.result-type/instances #_model ::default-fields]
[query-type model]
(log/debugf "Model %s has default fields" model)
(cond
*skip-default-fields*
(next-method query-type model)
;; don't apply default fields for queries that specify other columns e.g. `(select [SomeModel :col])`
(seq (:columns pipeline/*parsed-args*))
(do
(log/debugf "Not adding default fields transducer since query already has `:columns`")
(next-method query-type model))
;; don't apply default fields for queries like [[toucan2.select/select-fn-set]] since they are already doing their
;; own transforms
(isa? query-type :toucan.query-type/select.instances.fns)
(do
(log/debugf "Not adding default fields transducer since query type derives from :toucan.query-type/select.instances.fns")
(next-method query-type model))
;; don't apply default fields for the recursive select done by before-update, because it busts things when we want
;; to update non-default fields =(
;;
;; See [[toucan2.tools.before-update-test/before-update-with-default-fields-test]]
(isa? query-type :toucan2.tools.before-update/select-for-before-update)
(do
(log/debugf "Not adding default fields transducer since query type is done for the purposes of before-update")
(next-method query-type model))
:else
(do
(log/debugf "adding transducer to return default fields for %s" model)
(let [xform (default-fields-xform model)]
(comp xform
(next-method query-type model)))))) | |
| (m/prefer-method! #'pipeline/results-transform
[:toucan.result-type/instances ::default-fields]
[:toucan.result-type/instances :toucan2.tools.after-select/after-select]) |
| (m/prefer-method! #'pipeline/results-transform
[:toucan.result-type/instances ::default-fields]
[:toucan.result-type/instances :toucan2.tools.after/model]) |
(defmacro define-default-fields {:style/indent :defn} [model & body]
`(do
(u/maybe-derive ~model ::default-fields)
(m/defmethod default-fields ~model [~'&model] ~@body))) | |
(s/fdef define-default-fields
:args (s/cat :model some?
:body (s/+ any?))
:ret any?) | |
(ns toucan2.tools.disallow (:require [methodical.core :as m] [toucan2.pipeline :as pipeline])) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.*
#_model ::select
#_resolved-query :default]
"Throw an Exception when trying to build a SELECT query for models deriving from `:toucan2.tools.disallow/select`."
[_query-type model _parsed-args _resolved-query]
(throw (UnsupportedOperationException. (format "You cannot select %s." model)))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/delete.*
#_model ::delete
#_resolved-query :default]
"Throw an Exception when trying to build a DELETE query for models deriving from `:toucan2.tools.disallow/delete`."
[_query-type model _parsed-args _resolved-query]
(throw (UnsupportedOperationException. (format "You cannot delete instances of %s." model)))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/insert.*
#_model ::insert
#_resolved-query :default]
"Throw an Exception when trying to build a INSERT query for models deriving from `:toucan2.tools.disallow/insert`."
[_query-type model _parsed-args _resolved-query]
(throw (UnsupportedOperationException. (format "You cannot create new instances of %s." model)))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/update.*
#_model ::update
#_resolved-query :default]
"Throw an Exception when trying to build a UPDATE query for models deriving from `:toucan2.tools.disallow/update`."
[_query-type model _parsed-args _resolved-query]
(throw (UnsupportedOperationException. (format "You cannot update a %s after it has been created." model)))) | |
[[hydrate]] adds one or more keys to an instance or instances using various hydration strategies, usually using one of
the existing keys in those instances. A typical use case would be to take a sequence of [[hydrate]] is how you use the hydration facilities; everything else in this namespace is only for extending hydration to support your models. Toucan 2 ships with several hydration strategies out of the box: Automagic Batched Hydration (via [[model-for-automagic-hydration]])[[hydrate]] attempts to do a batched hydration where possible. If the key being hydrated is defined as one of some
table's [[model-for-automagic-hydration]], ```clj (hydrate [{:userid 100}, {:userid 101}] :user) ``` Since ```clj (db/select :models/User :id [:in #{100 101}]) ``` The corresponding Users are then added under the key Function-Based Batched Hydration (via [[batched-hydrate]] methods)If the key can't be hydrated auto-magically with the appropriate [[model-for-automagic-hydration]], [[hydrate]] will attempt to do batched hydration if it can find a matching method for [[batched-hydrate]]. If a matching function is found, it is called with a collection of objects, e.g. ```clj (m/defmethod hydrate/batched-hydrate [:default :fields] [_model _k instances] (let [id->fields (get-some-fields instances)] (for [instance instances] (assoc instance :fields (get id->fields (:id instance)))))) ``` Simple Hydration (via [[simple-hydrate]] methods)If the key is not eligible for batched hydration, [[hydrate]] will look for a matching
[[simple-hydrate]] method. ```clj (m/defmethod simple-hydrate [:default :dashboard] [_model _k {:keys [dashboard-id], :as instance}] (assoc instance :dashboard (select/select-one :models/Dashboard :toucan/pk dashboard-id))) ``` Hydrating Multiple KeysYou can hydrate several keys at one time: ```clj (hydrate {...} :a :b) -> {:a 1, :b 2} ``` Nested HydrationYou can do recursive hydration by listing keys inside a vector: ```clj (hydrate {...} [:a :b]) -> {:a {:b 1}} ``` The first key in a vector will be hydrated normally, and any subsequent keys will be hydrated inside the corresponding values for that key. ```clj (hydrate {...} [:a [:b :c] :e]) -> {:a {:b {:c 1} :e 2}} ``` Forcing HydrationNormally, hydration is skipped if an instance already has a non-nil value for the key being hydrated, but you can override this behavior by implementing [[needs-hydration?]]. FlowchartIf you're digging in to the details, this is a flowchart of how hydration works: ``` hydrate ◄─────────────┐ │ │ ▼ │ hydrate-forms │ │ │ ▼ │ (recursively) hydrate-one-form │ │ │ keyword? ◄─┴─► sequence? │ │ │ │ ▼ ▼ │ hydrate-key hydrate-key-seq ─┘ │ ▼ (for each strategy) ◄────────┐ ::automagic-batched │ ::multimethod-batched │ ::multimethod-simple │ │ │ (try next strategy) ▼ │ can-hydrate-with-strategy? │ │ │ yes ◄──┴──► no ────────────┘ │ ▼ hydrate-with-strategy ``` | (ns toucan2.tools.hydrate (:require [camel-snake-kebab.core :as csk] [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.model :as model] [toucan2.protocols :as protocols] [toucan2.realize :as realize] [toucan2.select :as select] [toucan2.types :as types] [toucan2.util :as u])) |
(derive ::automagic-batched ::strategy) (derive ::multimethod-batched ::strategy) (derive ::multimethod-simple ::strategy) | |
(s/def ::dispatch-value.strategy (s/or :default ::types/dispatch-value.default :strategy #(isa? % ::strategy))) | |
(s/def ::dispatch-value.hydration-key (some-fn keyword? symbol?)) | |
(s/def ::dispatch-value.model-k
(s/or :default ::types/dispatch-value.default
:model-k (s/cat
:model ::types/dispatch-value.model
:k ::dispatch-value.hydration-key))) | |
(s/def ::dispatch-value.model-k-model
(s/or :default ::types/dispatch-value.default
:model-k (s/cat
:model ::types/dispatch-value.model
:k ::dispatch-value.hydration-key
:model ::types/dispatch-value.model))) | |
(s/def ::dispatch-value.model-strategy-k
(s/or :default ::types/dispatch-value.default
:model-strategy-k (s/cat :model ::types/dispatch-value.model
:strategy ::dispatch-value.strategy
:k ::dispatch-value.hydration-key))) | |
Can we hydrate the key Normally you should never need to call this yourself. The only reason you would implement it is if you are implementing a custom hydration strategy. | (m/defmulti can-hydrate-with-strategy?
{:arglists '([model₁ strategy₂ k₃])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::dispatch-value.model-strategy-k)}
u/dispatch-on-first-three-args) |
Hydrate the key Normally you should not call this yourself. The only reason you would implement this method is if you are implementing a custom hydration strategy. | (m/defmulti hydrate-with-strategy
{:arglists '([model strategy₁ k instances])
:defmethod-arities #{4}
:dispatch-value-spec (s/nonconforming ::dispatch-value.strategy)}
(fn [_model strategy _k _instances]
strategy)) |
Whether an | (m/defmulti needs-hydration?
{:arglists '([model₁ k₂ instance])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::dispatch-value.model-k)}
u/dispatch-on-first-two-args) |
(m/defmethod needs-hydration? :default [_model k instance] (nil? (get instance k))) | |
Automagic Batched Hydration (via :table-keys) | |
The model that should be used to automagically hydrate the key ```clj (model-for-automagic-hydration :some-table :user) :-> :myapp.models/user ``` Dispatches off of the [[toucan2.protocols/dispatch-value]] (normally [[toucan2.protocols/model]]) of the instance
being hydrated and the key ```clj ;; when hydrating the :user key for any model, hydrate with instances of the model :models/user ;; ;; By default, this will look for values of :user-id in the instances being hydrated and then fetch the instances of ;; :models/user with a matching :id (m/defmethod hydrate/model-for-automagic-hydration [:default :user] [_original-model _k] :models/user) ;; when hydrating the :user key for instances of :models/orders, hydrate with instances of :models/user (m/defmethod hydrate/model-for-automagic-hydration [:models/orders :user] [_original-model _k] :models/user) ``` Automagic hydration looks for the [[fk-keys-for-automagic-hydration]] in the instance being hydrated, and if they're
all non-
Tips
TODO -- should this get called with | (m/defmulti model-for-automagic-hydration
{:arglists '([original-model₁ k₂])
:defmethod-arities #{2}
:dispatch-value-spec (s/nonconforming ::dispatch-value.model-k)}
u/dispatch-on-first-two-args) |
(m/defmethod model-for-automagic-hydration :default [_model _k] nil) | |
(m/defmethod can-hydrate-with-strategy? [#_model :default #_strategy ::automagic-batched #_k :default] [model _strategy dest-key] (boolean (model-for-automagic-hydration model dest-key))) | |
The keys in we should use when automagically hydrating the key ```clj ;; when hydrating :user in an order with a user, fetch the user based on the value of the :user-id key ;; ;; This means we take the value of :user-id from our order and then fetch the user with the matching primary key ;; (by default, :id) (fk-keys-for-automagic-hydration :models/orders :user :models/user) => [:user-id] ``` The model that we are hydrating with (e.g. By default [[fk-keys-for-automagic-hydration]] is just the key we're hydrating, with Example implementation: ```clj ;; hydrate orders :user key using values of :creator-id (m/defmethod hydrate/fk-keys-for-automagic-hydration [:model/orders :user :default] [_original-model _dest-key _hydrating-model] [:creator-id]) ``` TipsWhen implementing this method, you probably do not want to specialize on the ```clj ;; by default when we hydrate the :user key with a :models/user, use :creator-id as the source FK (m/defmethod hydrate/fk-keys-for-automagic-hydration [:default :model/orders :user :models/user] [_original-model _dest-key _hydrating-model] [:creator-id]) ``` | (m/defmulti fk-keys-for-automagic-hydration
{:arglists '([original-model₁ dest-key₂ hydrating-model₃])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::dispatch-value.model-k-model)}
u/dispatch-on-first-three-args) |
(m/defmethod fk-keys-for-automagic-hydration :default [_original-model dest-key _hydrated-key] ;; TODO -- this should probably use the key transform associated with the `original-model` -- if it's not using magic ;; maps this wouldn't work [(csk/->kebab-case (keyword (str (name dest-key) "-id")))]) | |
(m/defmethod fk-keys-for-automagic-hydration :around :default
[original-model dest-key hydrating-model]
(assert (keyword? dest-key) "dest-key should be a keyword")
(let [result (next-method original-model dest-key hydrating-model)]
(when-not (and (sequential? result)
(seq result)
(every? keyword? result))
(throw (ex-info (format "fk-keys-for-automagic-hydration should return a non-empty sequence of keywords. Got: %s"
(pr-str result))
{:original-model original-model
:dest-key dest-key
:hydrating-model hydrating-model
:result result})))
result)) | |
(defn- automagic-batched-hydration-add-fks [model dest-key instances fk-keys]
(assert (seq fk-keys) "fk-keys cannot be empty")
(let [get-fk-values (apply juxt fk-keys)]
(for [instance instances]
(if-not (needs-hydration? model dest-key instance)
(do
(log/tracef "Don't need to hydrate %s: %s does not need hydration" instance dest-key)
instance)
(do
(log/tracef "Getting values of %s for instance" fk-keys)
(let [fk-vals (get-fk-values instance)]
(if (every? some? fk-vals)
(do
(log/tracef "Attempting to hydrate %s with values of %s %s" instance fk-keys fk-vals)
(assoc instance ::fk fk-vals))
(do
(log/tracef "Skipping %s: values of %s are %s" instance fk-keys fk-vals)
instance)))))))) | |
(defn- automagic-batched-hydration-fetch-pk->instance [hydrating-model instances]
(let [pk-keys (model/primary-keys hydrating-model)]
(assert (pos? (count pk-keys)))
(if-let [fk-values-set (not-empty (set (filter some? (map ::fk instances))))]
(let [fk-values-set (if (= (count pk-keys) 1)
(into #{} (map first) fk-values-set)
fk-values-set)]
(log/debugf "Fetching %s with PK columns %s values %s" hydrating-model pk-keys fk-values-set)
;; TODO -- not sure if we need to be realizing stuff here?
(select/select-pk->fn realize/realize hydrating-model :toucan/pk [:in fk-values-set]))
(log/debugf "Not hydrating %s because no instances have non-nil FK values" hydrating-model)))) | |
(defn- do-automagic-batched-hydration [dest-key instances pk->fetched-instance]
(log/debugf "Attempting to hydrate %s instances out of %s" (count (filter ::fk instances)) (count instances))
(for [instance instances]
(if-not (::fk instance)
;; If `::fk` doesn't exist for this instance...
(if (contains? instance dest-key)
;; don't stomp on any existing values of `dest-key` if one is already present.
instance
;; if no value is present, `assoc` `nil`.
(assoc instance dest-key nil))
;; otherwise if we DO have an `::fk`, remove it and add the hydrated key in its place
(let [fk-vals (::fk instance)
;; convert fk to from [id] to id if it only has one key. This is what [[toucan2.select/select-pk->fn]]
;; returns.
fk-vals (if (= (count fk-vals) 1)
(first fk-vals)
fk-vals)
fetched-instance (get pk->fetched-instance fk-vals)]
(log/tracef "Hydrate %s %s with %s" dest-key [instance] (or fetched-instance
"nil (no matching fetched instance)"))
(-> (dissoc instance ::fk)
(assoc dest-key fetched-instance)))))) | |
(m/defmethod hydrate-with-strategy ::automagic-batched
[model _strategy dest-key instances]
(u/try-with-error-context ["automagic batched hydration" {::model model, ::dest-key dest-key}]
(let [hydrating-model (model-for-automagic-hydration model dest-key)
_ (log/debugf "Hydrating %s key %s with instances from %s" (or model "map") dest-key hydrating-model)
fk-keys (fk-keys-for-automagic-hydration model dest-key hydrating-model)
_ (log/debugf "Hydrating with FKs %s" fk-keys)
instances (automagic-batched-hydration-add-fks model dest-key instances fk-keys)
pk->fetched-instance (automagic-batched-hydration-fetch-pk->instance hydrating-model instances)]
(log/debugf "Fetched %s instances of %s" (count pk->fetched-instance) hydrating-model)
(do-automagic-batched-hydration dest-key instances pk->fetched-instance)))) | |
Method-Based Batched Hydration (using impls of [[batched-hydrate]]) | |
Hydrate the key ```clj ;; This method defines a batched hydration strategy for the :bird-type key for all models. (m/defmethod hydrate/batched-hydrate [:default :is-bird?] [_model _k instances] ;; fetch a set of all the non-nil bird IDs in instances. (let [bird-ids (into #{} (comp (map :bird-id) (filter some?)) instances) ;; if bird-ids is non-empty, fetch a map of bird ID => bird type bird-id->bird-type (when (seq bird-ids) (select/select-pk->fn :bird-type :models/bird :id [:in bird-ids]))] ;; for each instance add a :bird-type key. (for [instance instances] (assoc instance :bird-type (get bird-id->bird-type (:bird-id instance)))))) ``` Batched hydration implementations should try to be efficient, e.g. minimizing the number of database calls made rather than doing one call per instance. If you just want to hydrate each instance independently, implement [[simple-hydrate]] instead. If you are hydrating entire instances of some other model, consider setting up automagic batched hydration using [[model-for-automagic-hydration]] and possibly [[fk-keys-for-automagic-hydration]]. | (m/defmulti batched-hydrate
{:arglists '([model₁ k₂ instances])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::dispatch-value.model-k)}
u/dispatch-on-first-two-args) |
(m/defmethod can-hydrate-with-strategy? [#_model :default #_strategy ::multimethod-batched #_k :default] [model _strategy k] (some? (m/effective-method batched-hydrate (m/dispatch-value batched-hydrate model k)))) | |
The basic strategy behind batched hydration is thus:
| |
Merge the annotated instances as returned by [[annotate-instances]] and the hydrated instances as returned by [[hydrate-annotated-instances]] back into a single un-annotated sequence. (merge-hydrated-instances [{:needs-hydration? false, :instance {:x 1, :y 1}} {:needs-hydration? false, :instance {:x 2, :y 2}} {:needs-hydration? true, :instance {:x 3}} {:needs-hydration? true, :instance {:x 4}} {:needs-hydration? false, :instance {:x 5, :y 5}} {:needs-hydration? true, :instance {:x 6}}] [{:x 3, :y 3} {:x 4, :y 4} {:x 6, :y 6}]) => [{:x 1, :y 1} {:x 2, :y 2} {:x 3, :y 3} {:x 4, :y 4} {:x 5, :y 5} {:x 6, :y 6}] | (defn- merge-hydrated-instances
[annotated-instances hydrated-instances]
(loop [acc [], annotated-instances annotated-instances, hydrated-instances hydrated-instances]
(if (empty? hydrated-instances)
(concat acc (map :instance annotated-instances))
(let [[not-hydrated [_needed-hydration & more]] (split-with (complement :needs-hydration?) annotated-instances)]
(recur (vec (concat acc (map :instance not-hydrated) [(first hydrated-instances)]))
more
(rest hydrated-instances)))))) |
(defn- annotate-instances [model k instances]
(for [instance instances]
{:needs-hydration? (needs-hydration? model k instance)
:instance instance})) | |
(defn- hydrate-annotated-instances [model k annotated-instances]
(when-let [instances-that-need-hydration (not-empty (map :instance (filter :needs-hydration? annotated-instances)))]
(batched-hydrate model k instances-that-need-hydration))) | |
(m/defmethod hydrate-with-strategy ::multimethod-batched
[model _strategy k instances]
(let [annotated-instances (annotate-instances model k instances)
hydrated-instances (hydrate-annotated-instances model k annotated-instances)]
(merge-hydrated-instances annotated-instances hydrated-instances))) | |
Method-Based Simple Hydration (using impls of [[simple-hydrate]]) | |
Implementations should return a version of map TODO -- better dox | (m/defmulti simple-hydrate
{:arglists '([model₁ k₂ instance])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::dispatch-value.model-k)}
u/dispatch-on-first-two-args) |
(defn- simple-hydrate* [model k instance]
(u/try-with-error-context ["simple hydrate" {:model model, :k k, :instance instance}]
(simple-hydrate model k instance))) | |
(m/defmethod can-hydrate-with-strategy? [#_model :default #_strategy ::multimethod-simple #_k :default] [model _strategy k] (some? (m/effective-method simple-hydrate (m/dispatch-value simple-hydrate model k)))) | |
(m/defmethod hydrate-with-strategy ::multimethod-simple
[model _strategy k instances]
;; TODO -- consider whether we should optimize this a bit and cache the methods we use so we don't have to go thru
;; multimethod dispatch on every instance.
(for [instance instances]
(when instance
;; only hydrate the key if it's not non-nil.
(cond->> instance
(needs-hydration? model k instance)
(simple-hydrate* model k))))) | |
Hydration Using All Strategies | |
(defn- strategies [] (keys (m/primary-methods hydrate-with-strategy))) | |
Determine the appropriate hydration strategy to hydrate the key | (defn ^:no-doc hydration-strategy
[model k]
(some
(fn [strategy]
(when (can-hydrate-with-strategy? model strategy k)
strategy))
(strategies))) |
Primary Hydration Fns | |
(declare hydrate) | |
TODO -- consider renaming this to | (def ^:dynamic *error-on-unknown-key* nil) |
Whether hydration should error when it encounters a key that has no hydration methods associated with
it (default: | (defonce global-error-on-unknown-key (atom false)) |
(defn ^:no-doc error-on-unknown-key? []
(if (some? *error-on-unknown-key*)
*error-on-unknown-key*
@global-error-on-unknown-key)) | |
(defn- hydrate-key
[model instances k]
(if-let [strategy (hydration-strategy model k)]
(u/try-with-error-context ["hydrate key" {:model model, :key k, :strategy strategy}]
(log/debugf "Hydrating %s %s with strategy %s" (or model "map") k strategy)
(hydrate-with-strategy model strategy k instances))
(do
(log/warnf "Don't know how to hydrate %s for model %s instances %s" k model (take 1 instances))
(when (error-on-unknown-key?)
(throw (ex-info (format "Don't know how to hydrate %s" (pr-str k))
{:model model, :instances instances, :k k})))
instances))) | |
Hydrate a nested hydration form (vector) by recursively calling [[hydrate]]. | (defn- hydrate-key-seq
[results [k & nested-keys :as coll]]
(when-not (seq nested-keys)
(throw (ex-info (str (format "Invalid hydration form: replace %s with %s. Vectors are for nested hydration." coll k)
" There's no need to use one when you only have a single key.")
{:invalid-form coll})))
(let [results (hydrate results k)
newly-hydrated-values (map k results)
recursively-hydrated-values (apply hydrate newly-hydrated-values nested-keys)]
(map
(fn [result v]
(if (and result (some? v))
(assoc result k v)
result))
results
recursively-hydrated-values))) |
(declare hydrate-one-form) | |
Convert a collection ```clj (flatten-collection [[{:a 1}]]) => [{:path [], :item []} {:path [0], :item []} {:path [0 0], :item {:a 1}}] ``` | (defn- flatten-collection
([coll]
(flatten-collection [] coll))
([path coll]
(if (sequential? coll)
(into [{:path path, :item []}]
(comp (map-indexed (fn [i x]
(flatten-collection (conj path i) x)))
cat)
coll)
[{:path path, :item coll}]))) |
Take a sequence of items flattened by [[flatten-collection]] and restore them to their original shape. | (defn- unflatten-collection
[flattened]
(reduce
(fn [acc {:keys [path item]}]
(if (= path [])
item
(assoc-in acc path item)))
[]
flattened)) |
(defn- hydrate-sequence-of-sequences [model coll k]
(let [flattened (flatten-collection coll)
items (for [{:keys [item path]} flattened
:when (map? item)]
(vary-meta item assoc ::path path))
hydrated (hydrate-one-form model items k)]
(unflatten-collection (concat flattened
(for [item hydrated]
(do
(assert (::path (meta item)))
{:item item, :path (::path (meta item))})))))) | |
Hydrate for a single hydration key or form | (defn- hydrate-one-form
[model results k]
(log/debugf "hydrate %s for model %s instances %s" k model (take 1 results))
(cond
(and (sequential? results)
(empty? results))
results
;; check whether the first non-nil result is a sequence. If it is, then hydrate sequences-of-sequences
(sequential? (some (fn [result]
(when (some? result)
result))
results))
(hydrate-sequence-of-sequences model results k)
(keyword? k)
(hydrate-key model results k)
(sequential? k)
(hydrate-key-seq results k)
:else
(throw (ex-info (format "Invalid hydration form: %s. Expected keyword or sequence." k)
{:invalid-form k})))) |
Hydrate many hydration forms across a sequence of | (defn- hydrate-forms [model results & forms] (reduce (partial hydrate-one-form model) results forms)) |
Given an arbitrarily nested sequence ```clj (unnest-first-result [:a :b]) => :a (unnest-first-result [[:a]]) => :a (unnest-first-result [[[:a]]]) => :a ``` | (defn- unnest-first-result
[coll]
(->> (iterate first coll)
(take-while sequential?)
last
first)) |
Public Interface | |
Hydrate the keys | (defn hydrate
;; no keys -- no-op
([instance-or-instances]
instance-or-instances)
([instance-or-instances & ks]
(u/try-with-error-context ["hydrate" {:what instance-or-instances, :keys ks}]
(cond
(not instance-or-instances)
nil
(and (sequential? instance-or-instances)
(empty? instance-or-instances))
instance-or-instances
;; sequence of instances
(sequential? instance-or-instances)
(let [model (protocols/model (unnest-first-result instance-or-instances))]
(apply hydrate-forms model instance-or-instances ks))
;; not sequential
:else
(first (apply hydrate-forms (protocols/model instance-or-instances) [instance-or-instances] ks)))))) |
(ns toucan2.tools.identity-query (:require [methodical.core :as m] [pretty.core :as pretty] [toucan2.connection :as conn] [toucan2.instance :as instance] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.realize :as realize])) | |
(set! *warn-on-reflection* true) | |
(defrecord ^:no-doc IdentityQuery [rows]
pretty/PrettyPrintable
(pretty [_this]
(list `identity-query rows))
realize/Realize
(realize [_this]
(realize/realize rows))
clojure.lang.IReduceInit
(reduce [_this rf init]
(log/debugf "reduce IdentityQuery rows")
(reduce rf init rows))) | |
A queryable that returns ```clj (def parrot-query (identity-query [{:id 1, :name "Parroty"} {:id 2, :name "Green Friend"}])) (select/select ::parrot parrot-query) => [(instance ::parrot {:id 1, :name "Parroty"}) (instance ::parrot {:id 2, :name "Green Friend"})] ``` | (defn identity-query [reducible-rows] (->IdentityQuery reducible-rows)) |
(m/defmethod pipeline/transduce-execute [#query-type :default #model :default #_query IdentityQuery] [rf _query-type model {:keys [rows], :as _query}] (log/debugf "transduce IdentityQuery rows %s" rows) (transduce (if model (map (fn [result-row] (instance/instance model result-row))) identity) rf rows)) | |
Not sure I understand how you're supposed to get to these points anyway | |
(m/defmethod pipeline/compile [#_query-type :default #_model :default #_query IdentityQuery] [_query-type _model query] query) | |
(m/defmethod pipeline/build :around [#_query-type :default #_model :default #_query IdentityQuery] "This is an around method so we can intercept anything else that might normally be considered a more specific method when it dispatches off of more-specific values of `query-type`." [_query-type _model _parsed-args resolved-query] resolved-query) | |
(m/defmethod pipeline/transduce-query [#_query-type :default
#_model IdentityQuery
#_resolved-query :default]
"Allow using an identity query as an 'identity model'."
[rf _query-type model _parsed-args _resolved-query]
(transduce identity rf model)) | |
Identity connection | |
(deftype ^:no-doc IdentityConnection []
pretty/PrettyPrintable
(pretty [_this]
(list `->IdentityConnection))) | |
(m/defmethod conn/do-with-connection IdentityConnection
[connectable f]
{:pre [(ifn? f)]}
(f connectable)) | |
(m/defmethod conn/do-with-transaction IdentityConnection
[connectable _options f]
{:pre [(ifn? f)]}
(f connectable)) | |
(m/defmethod pipeline/transduce-execute-with-connection [#_conn IdentityConnection #_query-type :default #_model :default]
[rf _conn _query-type model id-query]
(assert (instance? IdentityQuery id-query))
(binding [conn/*current-connectable* nil]
(transduce
(map (fn [row]
(if (map? row)
(instance/instance model row)
row)))
rf
(:rows id-query)))) | |
(m/defmethod pipeline/transduce-query [#_query-type :default
#_model :default
#_resolved-query IdentityQuery]
[rf query-type model parsed-args resolved-query]
(binding [conn/*current-connectable* (->IdentityConnection)]
(next-method rf query-type model parsed-args resolved-query))) | |
(ns toucan2.tools.named-query (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.pipeline :as pipeline] [toucan2.types :as types])) | |
Helper for defining 'named' queries. ```clj ;; define a custom query ::my-count that you can then use with select and the like (define-named-query ::my-count {:select [:%count.*], :from [(keyword (model/table-name model))]}) (select :model/user ::my-count) ``` This doesn't NEED to be a macro but having the definition live in the namespace it was defined in is useful for stack trace purposes. Also it lets us do validation with the spec below. | (defmacro define-named-query
{:style/indent 1}
([query-name resolved-query]
`(define-named-query ~query-name :default :default ~resolved-query))
([query-name query-type model resolved-query]
`(m/defmethod pipeline/resolve [~query-type ~model ~query-name]
"Created by [[toucan2.tools.named-query/define-named-query]]."
[~'&query-type ~'&model ~'&unresolved-query]
~resolved-query))) |
(s/fdef define-named-query
:args (s/alt :2-arity (s/cat :query-name (every-pred keyword? namespace)
:resolved-query some?)
:4-arity (s/cat :query-name (every-pred keyword? namespace)
:query-type (s/alt :query-type types/query-type?
:default #{:default})
:model some?
:resolved-query some?))
:ret any?) | |
(ns toucan2.tools.simple-out-transform (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.instance :as instance] [toucan2.pipeline :as pipeline])) | |
TODO -- I'm not really convinced this is worth it at all. It's used in exactly one place =( | |
(defn -xform [f]
(map (fn [instance]
(let [instance (f instance)]
(cond-> instance
(instance/instance? instance)
instance/reset-original))))) | |
(defmacro define-out-transform
{:style/indent :defn}
[[query-type model-type] [instance-binding] & body]
`(m/defmethod pipeline/results-transform [~query-type ~model-type]
[~'&query-type ~'&model]
(let [xform# (-xform (fn [~instance-binding] ~@body))]
(comp xform#
(~'next-method ~'&query-type ~'&model))))) | |
(s/fdef define-out-transform
:args (s/cat :dispatch-value (s/spec (s/cat :query-type keyword?
:model-type any?))
:bindings (s/spec (s/cat :row :clojure.core.specs.alpha/binding-form))
:body (s/+ any?))
:ret any?) | |
(comment
(define-out-transform [:toucan.query-type/select.instances ::venues]
[row]
(assoc row :neat true))) | |
(ns toucan2.tools.transformed (:require [better-cond.core :as b] [clojure.spec.alpha :as s] [methodical.core :as m] [methodical.impl.combo.operator :as m.combo.operator] [toucan2.instance :as instance] [toucan2.log :as log] [toucan2.model :as model] [toucan2.pipeline :as pipeline] [toucan2.protocols :as protocols] [toucan2.query :as query] [toucan2.types :as types] [toucan2.util :as u])) | |
(set! *warn-on-reflection* true) | |
(s/def ::transforms-map.direction->fn
(s/map-of #{:in :out}
ifn?)) | |
(s/def ::transforms-map.column->direction
(s/map-of keyword?
::transforms-map.direction->fn)) | |
(defn- validate-transforms-map [transforms-map]
(when (and transforms-map
(s/invalid? (s/conform ::transforms-map.column->direction transforms-map)))
(throw (ex-info (format "Invalid deftransforms map: %s"
(s/explain-str ::transforms-map.column->direction transforms-map))
(s/explain-data ::transforms-map.column->direction transforms-map))))) | |
combine the results of all matching methods into one map. | (m.combo.operator/defoperator ::merge-transforms
[method-fns invoke]
(transduce
(map invoke)
(fn
([]
{})
([m]
(validate-transforms-map m)
m)
([m1 m2]
;; for the time being keep the values from map returned by the more-specific method in preference to the ones
;; returned by the less-specific methods.
;;
;; TODO -- we should probably throw an error if one of the transforms is stomping on the other.
(merge-with merge m2 m1)))
method-fns)) |
Return a map of ```clj
{column-name {:in For a given | (defonce ^{:doc
:arglists '([model₁])}
transforms
;; TODO -- this has to be uncached for now because of https://github.com/camsaul/methodical/issues/98
(m/uncached-multifn
(m/standard-multifn-impl
(m.combo.operator/operator-method-combination ::merge-transforms)
;; TODO -- once https://github.com/camsaul/methodical/issues/97 is implemented, use that.
(m/standard-dispatcher u/dispatch-on-first-arg)
(m/standard-method-table))
{:ns *ns*
:name `transforms
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)})) |
I originally considered walking and transforming the HoneySQL, but decided against it because it's too ambiguous. It's too hard to tell if [:= :id :col] means A) It's also hard to know what are the "values" of every different type of filter clause (including custom ones we don't know about). I think leaving HoneySQL as an outlet to bypass type transforms makes sense for now. This also avoids locking us in to HoneySQL too much | |
(defn- transform-condition-value [xform v]
(cond
(sequential? v)
(into [(first v)]
(map (fn xform* [v]
(if (or (sequential? v)
(set? v))
(mapv xform* v)
(xform v))))
(rest v))
;; only apply xform if the value is non-nil.
(some? v)
(xform v)
:else
nil)) | |
Get the [[transforms]] functions for a model in a either the | (defn- wrapped-transforms
[model direction]
(u/try-with-error-context ["calculate transforms" {::model model, ::direction direction}]
(when-let [k->direction->transform (not-empty (transforms model))]
;; make the transforms map an instance so we can get appropriate magic map behavior when looking for the
;; appropriate transform for a given key.
(instance/instance
model
(into {} (for [[k direction->xform] k->direction->transform
:let [xform (get direction->xform direction)]
:when xform]
[k (fn xform-fn [v]
(if-not (some? v)
v
(u/try-with-error-context ["apply transform" {::transforms k->direction->transform
::model model
::k k
::v v
::xform xform}]
(xform v))))])))))) |
(defn- in-transforms [model] (wrapped-transforms model :in)) | |
this is just here so we can intercept low-level calls to [[query/apply-kv-arg]] instead of needing to know how to
handle stuff like TODO -- this whole thing is still busted a little bit I think because it's assuming that everything in TODO This name is WACK | (defrecord ^:no-doc RecordTypeForInterceptingApplyKVArgCalls []) |
(m/defmethod query/apply-kv-arg [#_model :default
#_query RecordTypeForInterceptingApplyKVArgCalls
#_k :default]
[model _query k v]
(let [v (if-let [xform (get (in-transforms model) k)]
(transform-condition-value xform v)
v)]
[k v])) | |
(def ^:private ^:dynamic *skip-in-transforms* false) | |
(m/defmethod query/apply-kv-arg [#_model ::transformed.model
#_query :default
#_k :default]
[model query k v]
(if (or (instance? RecordTypeForInterceptingApplyKVArgCalls query)
*skip-in-transforms*
(nil? v))
(next-method model query k v)
(let [[k v*] (query/apply-kv-arg model (->RecordTypeForInterceptingApplyKVArgCalls) k v)]
#_(printf "Intercepted apply-kv-arg %s %s => %s\n" k (pr-str v) (pr-str v*))
(binding [*skip-in-transforms* true]
(next-method model query k v*))))) | |
after select (or other things returning instances) | |
(defn- apply-result-row-transform [instance k xform]
(assert (map? instance)
(format "%s expected map rows, got %s" `apply-result-row-transform (pr-str instance)))
;; The "Special Optimizations" below *should* be the default case, but if some other aux methods are in place or
;; custom impls it might not be; things should still work normally either way.
;;
;; Special Optimization 1: if `instance` is an `IInstance`, and original and current are the same object, this only
;; applies `xform` once.
(instance/update-original-and-current
instance
(fn [row]
;; Special Optimization 2: if the underlying original/current maps of `instance` are instances of something
;; like [[toucan2.jdbc.row/->TransientRow]] we can do a 'deferred update' that only applies the transform if and
;; when the value is realized.
(log/tracef "Transform %s %s" k (get row k))
(u/try-with-error-context ["Transform result column" {::k k, ::xform xform, ::row row}]
(protocols/deferrable-update row k xform))))) | |
(defn- out-transforms [model] (wrapped-transforms model :out)) | |
Given a ```clj (f row) ``` that will apply that transform to that column if the row contains that column. | (defn- apply-result-row-transform-fn
[column xform]
(fn [instance]
(cond-> instance
(contains? instance column) (apply-result-row-transform column xform)))) |
Given a map of column key -> transform function, return a function with the signature ```clj (f row) ``` That can be called on each instance returned in the results. | (defn- result-row-transform-fn
[k->transform]
{:pre [(map? k->transform) (seq k->transform)]}
(reduce
(fn [f [k xform]]
(comp (apply-result-row-transform-fn k xform)
f))
identity
k->transform)) |
Return a transducer to transform rows of | (defn- transform-result-rows-transducer
[model]
(if-let [k->transform (not-empty (out-transforms model))]
(map (let [f (result-row-transform-fn k->transform)]
(fn [row]
(assert (map? row) (format "Expected map row, got ^%s %s" (some-> row class .getCanonicalName) (pr-str row)))
(log/tracef "Transform %s row %s" model row)
(let [result (u/try-with-error-context ["transform result row" {::model model, ::row row}]
(f row))]
(log/tracef "[transform] => %s" result)
result))))
identity)) |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/select.instances-from-pks
#_model ::transformed.model
#_resolved-query :default]
"Don't try to transform stuff when we're doing SELECT directly with PKs (e.g. to fake INSERT returning instances), We're
not doing transforms on the way out so we don't need to do them on the way in."
[query-type model parsed-args resolved-query]
(binding [*skip-in-transforms* true]
(next-method query-type model parsed-args resolved-query))) | |
(m/defmethod pipeline/results-transform [#_query-type :toucan.result-type/instances #_model ::transformed.model]
[query-type model]
(if (isa? query-type :toucan.query-type/select.instances-from-pks)
(next-method query-type model)
(let [xform (transform-result-rows-transducer model)]
(comp xform
(next-method query-type model))))) | |
before update | |
(defn- transform-update-changes [m k->transform]
{:pre [(map? k->transform) (seq k->transform)]}
(into {} (for [[k v] m]
[k (when (some? v)
(if-let [xform (get k->transform k)]
(xform v)
v))]))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/update.*
#_model ::transformed.model
#_resolved-query :default]
"Apply transformations to the `changes` map in an UPDATE query."
[query-type model {:keys [changes], :as parsed-args} resolved-query]
(b/cond
(not (map? changes))
(next-method query-type model parsed-args resolved-query)
:let [k->transform (not-empty (in-transforms model))]
(not k->transform)
(next-method query-type model parsed-args resolved-query)
(let [parsed-args (update parsed-args :changes transform-update-changes k->transform)]
(next-method query-type model parsed-args resolved-query)))) | |
before insert | |
(defn- transform-insert-rows [[first-row :as rows] k->transform]
{:pre [(map? first-row) (map? k->transform)]}
(let [x-forms (for [[k transform] k->transform]
(fn [row]
(if (some? (get row k))
(update row k transform)
row)))
x-form (apply comp x-forms)]
(map x-form rows))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/insert.*
#_model ::transformed.model
#_resolved-query :default]
[query-type model parsed-args resolved-query]
(assert (isa? model ::transformed.model))
(b/cond
(::already-transformed? parsed-args)
(next-method query-type model parsed-args resolved-query)
:let [k->transform (in-transforms model)]
(empty? k->transform)
(next-method query-type model parsed-args resolved-query)
:else
(u/try-with-error-context ["apply in transforms before inserting rows" {::query-type query-type
::model model
::parsed-args parsed-args
::transforms k->transform}]
(log/debugf "Apply %s transforms to %s" k->transform parsed-args)
(let [parsed-args (cond-> parsed-args
(seq (:rows parsed-args))
(update :rows transform-insert-rows k->transform)
true
(assoc ::already-transformed? true))
resolved-query (cond-> resolved-query
(seq (:rows resolved-query))
(update :rows transform-insert-rows k->transform))]
(next-method query-type model parsed-args resolved-query))))) | |
(m/defmethod pipeline/results-transform [#_query-type :toucan.query-type/insert.pks #_model ::transformed.model]
"Transform results of `insert!` returning PKs."
[query-type model]
(let [pk-keys (model/primary-keys model)
xform (comp
;; 1. convert result PKs to a map of PK key -> value
(map (fn [pk-or-pks]
(log/tracef "convert result PKs %s to map of PK key -> value" pk-or-pks)
(let [m (zipmap pk-keys (if (sequential? pk-or-pks)
pk-or-pks
[pk-or-pks]))]
(log/tracef "=> %s" pk-or-pks)
m)))
;; 2. transform the PK results using the model's [[out-transforms]]
(transform-result-rows-transducer model)
;; 3. Now flatten the maps of PK key -> value back into plain PK values or vectors of plain PK values
;; (if the model has a composite primary key)
(map (let [f (if (= (count pk-keys) 1)
(first pk-keys)
(juxt pk-keys))]
(fn [row]
(log/tracef "convert PKs map back to flat PKs")
(let [row (f row)]
(log/tracef "=> %s" row)
row)))))]
(comp xform
(next-method query-type model)))) | |
[[deftransforms]] | |
Define type transforms to use for a specific model. ```clj
{:column-name {:in
Transform functions for either case are skipped for Example: ```clj (deftransforms :models/user {:type {:in name, :out keyword}}) ``` You can also define transforms independently, and derive a model from them: ```clj (deftransforms ::type-keyword {:type {:in name, :out keyword}}) (derive :models/user ::type-keyword) (derive :models/user ::some-other-transform) ``` Don't derive a model from multiple [[deftransforms]] for the same key in the same direction. When multiple transforms match a given model they are combined into a single map of transforms with `merge-with merge`. If multiple transforms match a given column in a given direction, only one of them will be used; you should assume which one is used is indeterminate. (This may be made an error, or at least a warning, in the future.) Until upstream issue https://github.com/camsaul/methodical/issues/97 is resolved, you will have to specify which method should be applied first in cases of ambiguity using [[methodical.core/prefer-method!]]: ```clj (m/prefer-method! transforms ::user-with-location ::user-with-password) ``` If you want to override transforms completely for a model, and ignore transforms from ancestors of a model, you can
create an ```clj (m/defmethod toucan2.tools.transforms :around ::my-model [_model] {:field {:in name, :out keyword}}) ``` | (defmacro deftransforms
{:style/indent 1}
[model column->direction->fn]
`(do
(u/maybe-derive ~model ::transformed.model)
(m/defmethod transforms ~model
[~'model]
~column->direction->fn))) |
(s/fdef deftransforms
:args (s/cat :model some?
:transforms any?)
:ret any?) | |
apply results transforms before [[toucan2.tools.after-update]] or [[toucan2.tools.after-insert]] | (m/prefer-method! #'pipeline/results-transform
[:toucan.result-type/instances ::transformed.model]
[:toucan.result-type/instances :toucan2.tools.after/model]) |
apply results transforms before [[toucan2.tools.after-select]] | (m/prefer-method! #'pipeline/results-transform
[:toucan.result-type/instances ::transformed.model]
[:toucan.result-type/instances :toucan2.tools.after-select/after-select]) |
apply transforms before applying the [[toucan2.tools.default-fields]] functions | (m/prefer-method! #'pipeline/results-transform
[:toucan.result-type/instances ::transformed.model]
[:toucan.result-type/instances :toucan2.tools.default-fields/default-fields]) |
(ns toucan2.tools.with-temp (:require [clojure.pprint :as pprint] [clojure.spec.alpha :as s] [clojure.test :as t] [methodical.core :as m] [toucan2.delete :as delete] [toucan2.insert :as insert] [toucan2.log :as log] [toucan2.model :as model] [toucan2.types :as types] [toucan2.util :as u])) | |
(comment types/keep-me) | |
(m/defmulti with-temp-defaults
{:arglists '([model])
:defmethod-arities #{1}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) | |
(m/defmethod with-temp-defaults :default [_model] nil) | |
Implementation of [[with-temp]]. You can implement this if you need to do some sort of special behavior for a
particular model. But normally you would just implement [[with-temp-defaults]]. If you need to do special setup when
using [[with-temp]], you can implement a ```clj (m/defmethod do-with-temp* :before :default [_model _explicit-attributes f] (set-up-db!) f) ```
```clj (merge {} (with-temp-defaults model) explict-attributes) ``` | (m/defmulti do-with-temp*
{:arglists '([model₁ explicit-attributes f])
:defmethod-arities #{3}
:dispatch-value-spec (s/nonconforming ::types/dispatch-value.model)}
u/dispatch-on-first-arg) |
(m/defmethod do-with-temp* :default
[model explicit-attributes f]
(assert (some? model) (format "%s model cannot be nil." `with-temp))
(when (some? explicit-attributes)
(assert (map? explicit-attributes) (format "attributes passed to %s must be a map." `with-temp)))
(let [defaults (with-temp-defaults model)
merged-attributes (merge {} defaults explicit-attributes)]
(u/try-with-error-context ["with temp" {::model model
::explicit-attributes explicit-attributes
::default-attributes defaults
::merged-attributes merged-attributes}]
(log/debugf "Create temporary %s with attributes %s" model merged-attributes)
(let [temp-object (first (insert/insert-returning-instances! model merged-attributes))]
(log/debugf "[with-temp] => %s" temp-object)
(try
(t/testing (format "\nwith temporary %s with attributes\n%s\n"
(pr-str model)
(with-out-str (pprint/pprint merged-attributes)))
(f temp-object))
(finally
(delete/delete! model :toucan/pk ((model/select-pks-fn model) temp-object)))))))) | |
(defn do-with-temp [modelable attributes f]
(let [model (model/resolve-model modelable)]
(do-with-temp* model attributes f))) | |
Define a temporary instance of a model and bind it to [[with-temp]] can create multiple objects in one form if you pass additional bindings.
Examples: ```clj ;;; use the with-temp-defaults for :models/bird (with-temp [:models/bird bird] (do-something bird)) ;;; use the with-temp-defaults for :models/bird merged with {:name "Lucky Pigeon"} (with-temp [:models/bird bird {:name "Lucky Pigeon"}] (do-something bird)) ;;; define multiple instances at the same time (with-temp [:models/bird bird-1 {:name "Parroty"} :models/bird bird-2 {:name "Green Friend", :best-friend-id (:id bird-1)}] (do-something bird)) ``` If you want to implement custom behavior for a model other than default values, you can implement [[do-with-temp*]]. | (defmacro with-temp
{:style/indent :defn}
[[modelable temp-object-binding attributes & more] & body]
`(do-with-temp ~modelable ~attributes
(^:once fn* [temp-object#]
(let [~(or temp-object-binding '_) temp-object#]
~(if (seq more)
`(with-temp ~(vec more) ~@body)
`(do ~@body)))))) |
(s/fdef with-temp
:args (s/cat :bindings (s/spec (s/cat
:model+binding+attributes
(s/* (s/cat :model some?
:binding :clojure.core.specs.alpha/binding-form
:attributes any?))
:model+optional
(s/cat :model some?
:optional (s/? (s/cat :binding :clojure.core.specs.alpha/binding-form
:attributes (s/? any?))))))
:body (s/* any?))
:ret any?) | |
Toucan 2 query type hierarchy. | (ns toucan2.types (:require [clojure.spec.alpha :as s])) |
the query type hierarchy below is used for pipeline methods and tooling to decide what sort of things they need to do -- for example you should not do row-map transformations to a query that returns an update count. | |
(derive :toucan.query-type/select.* :toucan.query-type/*) (derive :toucan.query-type/insert.* :toucan.query-type/*) (derive :toucan.query-type/update.* :toucan.query-type/*) (derive :toucan.query-type/delete.* :toucan.query-type/*) | |
| |
(derive :toucan.statement-type/DML :toucan.statement-type/*) (derive :toucan.statement-type/DQL :toucan.statement-type/*) | |
(derive :toucan.query-type/select.* :toucan.statement-type/DQL) (derive :toucan.query-type/insert.* :toucan.statement-type/DML) (derive :toucan.query-type/update.* :toucan.statement-type/DML) (derive :toucan.query-type/delete.* :toucan.statement-type/DML) | |
(derive :toucan.result-type/instances :toucan.result-type/*) (derive :toucan.result-type/pks :toucan.result-type/*) (derive :toucan.result-type/update-count :toucan.result-type/*) | |
(doto :toucan.query-type/select.instances (derive :toucan.query-type/select.*) (derive :toucan.result-type/instances)) | |
[[toucan2.select/select-fn-set]] and [[toucan2.select/select-fn-vec]] queries -- we are applying a specific function transform to the results, so we don't want to apply a default fields transform or other stuff like that. | (derive :toucan.query-type/select.instances.fns :toucan.query-type/select.instances) |
A special query type that is just supposed to return the count of matching rows rather than the actual matching
rows. This is used to implement [[toucan2.select/count]]. Query compilation backends should build something that
returns a row with the key If the query does not return a row with the key | (derive :toucan.query-type/select.count :toucan.query-type/select.instances.fns) |
A special query type that should just return whether or not any rows matching the conditions exist. Used to
implement [[toucan2.select/exists?]]. Similar to If the query does not return a row with the key | (derive :toucan.query-type/select.exists :toucan.query-type/select.instances.fns) |
A special subtype of a SELECT query that should use the syntax of update. Used to power [[toucan2.tools.before-update]]. The difference is that update is supposed to treat a resolved query map as a conditions map rather than a Honey SQL form. | (derive :toucan.query-type/select.instances.from-update :toucan.query-type/select.instances) |
(doto :toucan.query-type/insert.update-count (derive :toucan.query-type/insert.*) (derive :toucan.result-type/update-count)) | |
(doto :toucan.query-type/insert.pks (derive :toucan.query-type/insert.*) (derive :toucan.result-type/pks)) | |
(doto :toucan.query-type/insert.instances (derive :toucan.query-type/insert.*) (derive :toucan.result-type/instances)) | |
(doto :toucan.query-type/update.update-count (derive :toucan.query-type/update.*) (derive :toucan.result-type/update-count)) | |
(doto :toucan.query-type/update.pks (derive :toucan.query-type/update.*) (derive :toucan.result-type/pks)) | |
(doto :toucan.query-type/update.instances (derive :toucan.query-type/update.*) (derive :toucan.result-type/instances)) | |
(doto :toucan.query-type/delete.update-count (derive :toucan.query-type/delete.*) (derive :toucan.result-type/update-count)) | |
(doto :toucan.query-type/delete.pks (derive :toucan.query-type/delete.*) (derive :toucan.result-type/pks)) | |
(doto :toucan.query-type/delete.instances (derive :toucan.query-type/delete.*) (derive :toucan.result-type/instances)) | |
The following are 'special' types only used in SPECIAL situations. | |
A select query that is done with PKs fetched directly from that database. These don't need to be transformed. | (derive :toucan.query-type/select.instances-from-pks :toucan.query-type/select.instances) |
True if | (defn query-type?
[query-type]
(some (fn [abstract-type]
(isa? query-type abstract-type))
[:toucan.result-type/*
:toucan.query-type/*
:toucan.statement-type/*])) |
utils | |
(defn parent-query-type [query-type]
(some (fn [k]
(when (isa? k :toucan.query-type/*)
k))
(parents query-type))) | |
E.g. something like ```clj (base-query-type :toucan.query-type/insert.instances) => :toucan.query-type/insert.* ``` | (defn base-query-type
[query-type]
(when (isa? query-type :toucan.query-type/*)
(loop [last-query-type nil, query-type query-type]
(if (or (= query-type :toucan.query-type/*)
(not query-type))
last-query-type
(recur query-type (parent-query-type query-type)))))) |
```clj (similar-query-type-returning :toucan.query-type/insert.instances :toucan.result-type/pks) => :toucan.query-type/insert.pks ``` | (defn similar-query-type-returning
[query-type result-type]
(let [base-type (base-query-type query-type)]
(some (fn [descendant]
(when (and ((parents descendant) base-type)
(isa? descendant result-type))
descendant))
(descendants base-type)))) |
(s/def ::dispatch-value.default (partial = :default)) | |
Helper for creating a spec that also accepts the | (defn or-default-spec
[spec]
(s/nonconforming
(s/or :default ::dispatch-value.default
:non-default spec))) |
| (s/def ::dispatch-value.query-type
(or-default-spec
(s/or :abstract-query-type #(isa? % :toucan.query-type/abstract)
:query-type query-type?))) |
technically What about (Class/forName "...") forms? Those are valid classes... | (s/def ::dispatch-value.keyword-or-class (some-fn keyword? symbol? nil?)) |
(s/def ::dispatch-value.model ::dispatch-value.keyword-or-class) | |
(s/def ::dispatch-value.query ::dispatch-value.keyword-or-class) | |
(s/def ::dispatch-value.query-type-model
(or-default-spec
(s/cat :query-type ::dispatch-value.query-type
:model ::dispatch-value.model))) | |
(s/def ::dispatch-value.query-type-model-query
(or-default-spec
(s/cat :query-type ::dispatch-value.query-type
:model ::dispatch-value.model
:query ::dispatch-value.query))) | |
Implementation of [[update!]]. | (ns toucan2.update (:require [clojure.spec.alpha :as s] [methodical.core :as m] [toucan2.log :as log] [toucan2.pipeline :as pipeline] [toucan2.query :as query])) |
this is basically the same as the args for | (s/def ::args (s/cat :connectable ::query/default-args.connectable :modelable ::query/default-args.modelable :pk (s/? (complement (some-fn keyword? map?))) ;; these are treated as CONDITIONS :kv-args ::query/default-args.kv-args ;; by default, assuming this resolves to a map query, is treated as a map of conditions. :queryable ::query/default-args.queryable ;; TODO -- This should support named changes maps too. Also, :changes map?)) |
(m/defmethod query/parse-args :toucan.query-type/update.*
[query-type unparsed-args]
(let [parsed (query/parse-args-with-spec query-type ::args unparsed-args)]
(cond-> parsed
(contains? parsed :pk) (-> (dissoc :pk)
(update :kv-args assoc :toucan/pk (:pk parsed)))))) | |
(m/defmethod pipeline/build [#_query-type :toucan.query-type/update.*
#_model :default
#_query :default]
"Default method for building UPDATE queries. Code for building Honey SQL for UPDATE lives
in [[toucan2.honeysql2]].
This doesn't really do much, but if the query has no `:changes`, returns the special flag `:toucan2.pipeline/no-op`."
[query-type model {:keys [changes], :as parsed-args} resolved-query]
(if (empty? changes)
(do
(log/debugf "Query has no changes, skipping update")
::pipeline/no-op)
(next-method query-type model parsed-args resolved-query))) | |
(defn reducible-update
{:arglists '([modelable pk? conditions-map-or-query? & conditions-kv-args changes-map])}
[& unparsed-args]
(pipeline/reducible-unparsed :toucan.query-type/update.update-count unparsed-args)) | |
(defn update!
{:arglists '([modelable pk? conditions-map-or-query? & conditions-kv-args changes-map])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/update.update-count unparsed-args)) | |
(defn reducible-update-returning-pks
{:arglists '([modelable pk? conditions-map-or-query? & conditions-kv-args changes-map])}
[& unparsed-args]
(pipeline/reducible-unparsed :toucan.query-type/update.pks unparsed-args)) | |
(defn update-returning-pks!
{:arglists '([modelable pk? conditions-map-or-query? & conditions-kv-args changes-map])}
[& unparsed-args]
(pipeline/transduce-unparsed-with-default-rf :toucan.query-type/update.pks unparsed-args)) | |
TODO -- add | |
(ns toucan2.util (:require [camel-snake-kebab.core :as csk] [clojure.spec.alpha :as s] [clojure.walk :as walk] [methodical.util.dispatch :as m.dispatch] [pretty.core :as pretty] [toucan2.protocols :as protocols]) (:import (clojure.lang IPersistentMap) (potemkin.collections PotemkinMap))) | |
TODO -- there is a lot of repeated code in here to make sure we don't accidentally realize and print | |
(set! *warn-on-reflection* true) | |
Dispatch on the first argument using [[dispatch-value]], and ignore all other args. | (def ^{:arglists '([x & _])} dispatch-on-first-arg
(m.dispatch/dispatch-on-first-arg #'protocols/dispatch-value)) |
Dispatch on the two arguments using [[protocols/dispatch-value]], and ignore all other args. | (def ^{:arglists '([x y & _])} dispatch-on-first-two-args
(m.dispatch/dispatch-on-first-two-args #'protocols/dispatch-value)) |
Dispatch on the three arguments using [[protocols/dispatch-value]], and ignore all other args. | (def ^{:arglists '([x y z & _])} dispatch-on-first-three-args
(m.dispatch/dispatch-on-first-three-args #'protocols/dispatch-value)) |
Locale-agnostic version of [[clojure.string/lower-case]]. | (defn lower-case-en [^CharSequence s] (.. s toString (toLowerCase java.util.Locale/US))) |
Derive | (defn maybe-derive
[child parent]
(when-not (isa? child parent)
(derive child parent))) |
[[try-with-error-context]] | |
TODO -- I don't love this stuff anymore, need to rework it at some point. | |
(defprotocol ^:private AddContext (^:no-doc add-context ^Throwable [^Throwable e additional-context])) | |
(defn- add-context-to-ex-data [ex-data-map additional-context]
(update ex-data-map
:toucan2/context-trace
#(conj (vec %) (walk/prewalk
(fn [form]
(cond
(instance? pretty.core.PrettyPrintable form)
(pretty/pretty form)
(instance? clojure.core.Eduction form)
(list 'eduction
(.xform ^clojure.core.Eduction form)
(.coll ^clojure.core.Eduction form))
(and (instance? clojure.lang.IReduceInit form)
(not (coll? form)))
(class form)
:else
form))
additional-context)))) | |
(extend-protocol AddContext
clojure.lang.ExceptionInfo
(add-context [^Throwable e additional-context]
(if (empty? additional-context)
e
(doto ^Throwable (ex-info (ex-message e)
(add-context-to-ex-data (ex-data e) additional-context)
(ex-cause e))
(.setStackTrace (.getStackTrace e)))))
Throwable
(add-context [^Throwable e additional-context]
(if (empty? additional-context)
e
(doto ^Throwable (ex-info (ex-message e)
(add-context-to-ex-data {} additional-context)
e)
(.setStackTrace (.getStackTrace e)))))) | |
(defmacro try-with-error-context
{:style/indent :defn}
[additional-context & body]
`(try
~@body
(catch Exception e#
(throw (add-context e# ~additional-context)))
(catch AssertionError e#
(throw (add-context e# ~additional-context))))) | |
(s/fdef try-with-error-context
:args (s/cat :additional-context (s/alt :message+map (s/spec (s/cat :message string?
:map map?))
;; some sort of function call or something like that.
:form seqable?)
:body (s/+ any?))
:ret any?) | |
Like | (defn ->kebab-case
[x]
(if (and (keyword? x) (namespace x))
(keyword (csk/->kebab-case (namespace x))
(csk/->kebab-case (name x)))
(csk/->kebab-case x))) |
Is this a map a transient row, or created using p/def-map-type? This includes Instances. | (defprotocol IsCustomMap (custom-map? [m])) |
(extend-protocol IsCustomMap IPersistentMap (custom-map? [_] false) PotemkinMap (custom-map? [_] true)) | |