595 lines
23 KiB
Clojure
595 lines
23 KiB
Clojure
;; copyright (c) 2018-2019 Sean Corfield, all rights reserved
|
|
|
|
(ns next.jdbc.result-set
|
|
"An implementation of `ResultSet` handling functions.
|
|
|
|
Defines the following protocols:
|
|
* `DatafiableRow` -- for turning a row into something datafiable
|
|
* `ReadableColumn` -- to read column values by label or index
|
|
* `RowBuilder` -- for materializing a row
|
|
* `ResultSetBuilder` -- for materializing a result set
|
|
|
|
Also provides the default implemenations for `Executable` and
|
|
the default `datafy`/`nav` behavior for rows from a result set."
|
|
(:require [clojure.core.protocols :as core-p]
|
|
[next.jdbc.prepare :as prepare]
|
|
[next.jdbc.protocols :as p])
|
|
(:import (java.sql PreparedStatement
|
|
ResultSet ResultSetMetaData
|
|
SQLException)
|
|
(java.util Locale)))
|
|
|
|
(set! *warn-on-reflection* true)
|
|
|
|
(defn get-column-names
|
|
"Given `ResultSetMetaData`, return a vector of column names, each qualified by
|
|
the table from which it came."
|
|
[^ResultSetMetaData rsmeta opts]
|
|
(mapv (fn [^Integer i] (keyword (not-empty (.getTableName rsmeta i))
|
|
(.getColumnLabel rsmeta i)))
|
|
(range 1 (inc (.getColumnCount rsmeta)))))
|
|
|
|
(defn get-unqualified-column-names
|
|
"Given `ResultSetMetaData`, return a vector of unqualified column names."
|
|
[^ResultSetMetaData rsmeta opts]
|
|
(mapv (fn [^Integer i] (keyword (.getColumnLabel rsmeta i)))
|
|
(range 1 (inc (.getColumnCount rsmeta)))))
|
|
|
|
(defn get-modified-column-names
|
|
"Given `ResultSetMetaData`, return a vector of modified column names, each
|
|
qualified by the table from which it came.
|
|
|
|
Requires both the `:qualifier-fn` and `:label-fn` options."
|
|
[^ResultSetMetaData rsmeta opts]
|
|
(assert (:qualifier-fn opts) ":qualifier-fn is required")
|
|
(assert (:label-fn opts) ":label-fn is required")
|
|
(mapv (fn [^Integer i] (keyword (some-> (.getTableName rsmeta i)
|
|
(not-empty)
|
|
((:qualifier-fn opts)))
|
|
(-> (.getColumnLabel rsmeta i)
|
|
((:label-fn opts)))))
|
|
(range 1 (inc (.getColumnCount rsmeta)))))
|
|
|
|
(defn get-unqualified-modified-column-names
|
|
"Given `ResultSetMetaData`, return a vector of unqualified modified column
|
|
names.
|
|
|
|
Requires the `:label-fn` option."
|
|
[^ResultSetMetaData rsmeta opts]
|
|
(assert (:label-fn opts) ":label-fn is required")
|
|
(mapv (fn [^Integer i] (keyword ((:label-fn opts) (.getColumnLabel rsmeta i))))
|
|
(range 1 (inc (.getColumnCount rsmeta)))))
|
|
|
|
(defn- lower-case
|
|
"Converts a string to lower case in the US locale to avoid problems in
|
|
locales where the lower case version of a character is not a valid SQL
|
|
entity name (e.g., Turkish)."
|
|
[^String s]
|
|
(.toLowerCase s (Locale/US)))
|
|
|
|
(defn get-lower-column-names
|
|
"Given `ResultSetMetaData`, return a vector of lower-case column names, each
|
|
qualified by the table from which it came."
|
|
[rsmeta opts]
|
|
(get-modified-column-names rsmeta (assoc opts
|
|
:qualifier-fn lower-case
|
|
:label-fn lower-case)))
|
|
|
|
(defn get-unqualified-lower-column-names
|
|
"Given `ResultSetMetaData`, return a vector of unqualified column names."
|
|
[rsmeta opts]
|
|
(get-unqualified-modified-column-names rsmeta
|
|
(assoc opts :label-fn lower-case)))
|
|
|
|
(defprotocol ReadableColumn
|
|
"Protocol for reading objects from the `java.sql.ResultSet`. Default
|
|
implementations (for `Object` and `nil`) return the argument, and the
|
|
`Boolean` implementation ensures a canonicalized `true`/`false` value,
|
|
but it can be extended to provide custom behavior for special types."
|
|
(read-column-by-label [val label]
|
|
"Function for transforming values after reading them via a column label.")
|
|
(read-column-by-index [val rsmeta idx]
|
|
"Function for transforming values after reading them via a column index."))
|
|
|
|
(extend-protocol ReadableColumn
|
|
Object
|
|
(read-column-by-label [x _] x)
|
|
(read-column-by-index [x _2 _3] x)
|
|
|
|
Boolean
|
|
(read-column-by-label [x _] (if (= true x) true false))
|
|
(read-column-by-index [x _2 _3] (if (= true x) true false))
|
|
|
|
nil
|
|
(read-column-by-label [_1 _2] nil)
|
|
(read-column-by-index [_1 _2 _3] nil))
|
|
|
|
(defprotocol RowBuilder
|
|
"Protocol for building rows in various representations.
|
|
|
|
The default implementation for building hash maps: `MapResultSetBuilder`"
|
|
(->row [_]
|
|
"Called once per row to create the basis of each row.")
|
|
(column-count [_]
|
|
"Return the number of columns in each row.")
|
|
(with-column [_ row i]
|
|
"Called with the row and the index of the column to be added;
|
|
this is expected to read the column value from the `ResultSet`!")
|
|
(row! [_ row]
|
|
"Called once per row to finalize each row once it is complete."))
|
|
|
|
(defprotocol ResultSetBuilder
|
|
"Protocol for building result sets in various representations.
|
|
|
|
Default implementations for building vectors of hash maps and vectors of
|
|
column names and row values: `MapResultSetBuilder` & `ArrayResultSetBuilder`"
|
|
(->rs [_]
|
|
"Called to create the basis of the result set.")
|
|
(with-row [_ rs row]
|
|
"Called with the result set and the row to be added.")
|
|
(rs! [_ rs]
|
|
"Called to finalize the result set once it is complete."))
|
|
|
|
(defrecord MapResultSetBuilder [^ResultSet rs rsmeta cols]
|
|
RowBuilder
|
|
(->row [this] (transient {}))
|
|
(column-count [this] (count cols))
|
|
(with-column [this row i]
|
|
(assoc! row
|
|
(nth cols (dec i))
|
|
(read-column-by-index (.getObject rs ^Integer i) rsmeta i)))
|
|
(row! [this row] (persistent! row))
|
|
ResultSetBuilder
|
|
(->rs [this] (transient []))
|
|
(with-row [this mrs row]
|
|
(conj! mrs row))
|
|
(rs! [this mrs] (persistent! mrs)))
|
|
|
|
(defn as-maps
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces bare vectors of hash map rows.
|
|
|
|
This is the default `:builder-fn` option."
|
|
[^ResultSet rs opts]
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-column-names rsmeta opts)]
|
|
(->MapResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-unqualified-maps
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces bare vectors of hash map rows, with simple keys."
|
|
[^ResultSet rs opts]
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-unqualified-column-names rsmeta opts)]
|
|
(->MapResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-modified-maps
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces bare vectors of hash map rows, with modified keys.
|
|
|
|
Requires both the `:qualifier-fn` and `:label-fn` options."
|
|
[^ResultSet rs opts]
|
|
(assert (:qualifier-fn opts) ":qualifier-fn is required")
|
|
(assert (:label-fn opts) ":label-fn is required")
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-modified-column-names rsmeta opts)]
|
|
(->MapResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-unqualified-modified-maps
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces bare vectors of hash map rows, with simple, modified keys.
|
|
|
|
Requires the `:label-fn` option."
|
|
[^ResultSet rs opts]
|
|
(assert (:label-fn opts) ":label-fn is required")
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-unqualified-modified-column-names rsmeta opts)]
|
|
(->MapResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-lower-maps
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces bare vectors of hash map rows, with lower-case keys."
|
|
[rs opts]
|
|
(as-modified-maps rs (assoc opts
|
|
:qualifier-fn lower-case
|
|
:label-fn lower-case)))
|
|
|
|
(defn as-unqualified-lower-maps
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces bare vectors of hash map rows, with simple, lower-case keys."
|
|
[rs opts]
|
|
(as-unqualified-modified-maps rs (assoc opts :label-fn lower-case)))
|
|
|
|
(defrecord ArrayResultSetBuilder [^ResultSet rs rsmeta cols]
|
|
RowBuilder
|
|
(->row [this] (transient []))
|
|
(column-count [this] (count cols))
|
|
(with-column [this row i]
|
|
(conj! row (read-column-by-index (.getObject rs ^Integer i) rsmeta i)))
|
|
(row! [this row] (persistent! row))
|
|
ResultSetBuilder
|
|
(->rs [this] (transient [cols]))
|
|
(with-row [this ars row]
|
|
(conj! ars row))
|
|
(rs! [this ars] (persistent! ars)))
|
|
|
|
(defn as-arrays
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces a vector of column names followed by vectors of row values."
|
|
[^ResultSet rs opts]
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-column-names rsmeta opts)]
|
|
(->ArrayResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-unqualified-arrays
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces a vector of simple column names followed by vectors of row
|
|
values."
|
|
[^ResultSet rs opts]
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-unqualified-column-names rsmeta opts)]
|
|
(->ArrayResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-modified-arrays
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces a vector of modified column names followed by vectors of
|
|
row values.
|
|
|
|
Requires both the `:qualifier-fn` and `:label-fn` options."
|
|
[^ResultSet rs opts]
|
|
(assert (:qualifier-fn opts) ":qualifier-fn is required")
|
|
(assert (:label-fn opts) ":label-fn is required")
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-modified-column-names rsmeta opts)]
|
|
(->ArrayResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-unqualified-modified-arrays
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces a vector of simple, modified column names followed by
|
|
vectors of row values.
|
|
|
|
Requires the `:label-fn` option."
|
|
[^ResultSet rs opts]
|
|
(assert (:label-fn opts) ":label-fn is required")
|
|
(let [rsmeta (.getMetaData rs)
|
|
cols (get-unqualified-modified-column-names rsmeta opts)]
|
|
(->ArrayResultSetBuilder rs rsmeta cols)))
|
|
|
|
(defn as-lower-arrays
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces a vector of lower-case column names followed by vectors of
|
|
row values."
|
|
[rs opts]
|
|
(as-modified-arrays rs (assoc opts
|
|
:qualifier-fn lower-case
|
|
:label-fn lower-case)))
|
|
|
|
(defn as-unqualified-lower-arrays
|
|
"Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder`
|
|
that produces a vector of simple, lower-case column names followed by
|
|
vectors of row values."
|
|
[rs opts]
|
|
(as-unqualified-modified-arrays rs (assoc opts :label-fn lower-case)))
|
|
|
|
(declare navize-row)
|
|
|
|
(defprotocol DatafiableRow
|
|
"Protocol for making rows datafiable and therefore navigable.
|
|
|
|
The default implementation just adds metadata so that `datafy` can be
|
|
called on the row, which will produce something that `nav` can be called
|
|
on, to lazily navigate through foreign key relationships into other tables.
|
|
|
|
If `datafiable-row` is called when reducing the result set produced by
|
|
`next.jdbc/plan`, the row is fully-realized from the `ResultSet`
|
|
first."
|
|
(datafiable-row [this connectable opts]
|
|
"Produce a datafiable representation of a row from a `ResultSet`."))
|
|
|
|
(defn- row-builder
|
|
"Given a `RowBuilder` -- a row materialization strategy -- produce a fully
|
|
materialized row from it."
|
|
[builder]
|
|
(->> (reduce (fn [r i] (with-column builder r i))
|
|
(->row builder)
|
|
(range 1 (inc (column-count builder))))
|
|
(row! builder)))
|
|
|
|
(definterface MapifiedResultSet)
|
|
|
|
(defn- mapify-result-set
|
|
"Given a `ResultSet`, return an object that wraps the current row as a hash
|
|
map. Note that a result set is mutable and the current row will change behind
|
|
this wrapper so operations need to be eager (and fairly limited).
|
|
|
|
Supports `IPersistentMap` in full. Any operation that requires a full hash
|
|
map (`assoc`, `dissoc`, `cons`, `seq`, etc) will cause a full row to be
|
|
realized (via `row-builder` above). The result will be a regular map: if
|
|
you want the row to be datafiable/navigable, use `datafiable-row` to
|
|
realize the full row explicitly before performing other
|
|
(metadata-preserving) operations on it."
|
|
[^ResultSet rs opts]
|
|
(let [builder (delay ((get opts :builder-fn as-maps) rs opts))]
|
|
(reify
|
|
|
|
MapifiedResultSet
|
|
;; marker, just for printing resolution
|
|
|
|
clojure.lang.IPersistentMap
|
|
(assoc [this k v]
|
|
(assoc (row-builder @builder) k v))
|
|
(assocEx [this k v]
|
|
(.assocEx ^clojure.lang.IPersistentMap (row-builder @builder) k v))
|
|
(without [this k]
|
|
(dissoc (row-builder @builder) k))
|
|
|
|
java.lang.Iterable ; Java 7 compatible: no forEach / spliterator
|
|
(iterator [this]
|
|
(.iterator ^java.lang.Iterable (row-builder @builder)))
|
|
|
|
clojure.lang.Associative
|
|
(containsKey [this k]
|
|
(try
|
|
(.getObject rs (name k))
|
|
true
|
|
(catch SQLException _
|
|
false)))
|
|
(entryAt [this k]
|
|
(try
|
|
(clojure.lang.MapEntry. k (read-column-by-label
|
|
(.getObject rs (name k))
|
|
(name k)))
|
|
(catch SQLException _)))
|
|
|
|
clojure.lang.Counted
|
|
(count [this]
|
|
(column-count @builder))
|
|
|
|
clojure.lang.IPersistentCollection
|
|
(cons [this obj]
|
|
(cons obj (seq (row-builder @builder))))
|
|
(empty [this]
|
|
{})
|
|
(equiv [this obj]
|
|
(.equiv ^clojure.lang.IPersistentCollection (row-builder @builder) obj))
|
|
|
|
clojure.lang.ILookup
|
|
(valAt [this k]
|
|
(try
|
|
(read-column-by-label (.getObject rs (name k)) (name k))
|
|
(catch SQLException _)))
|
|
(valAt [this k not-found]
|
|
(try
|
|
(read-column-by-label (.getObject rs (name k)) (name k))
|
|
(catch SQLException _
|
|
not-found)))
|
|
|
|
clojure.lang.Seqable
|
|
(seq [this]
|
|
(seq (row-builder @builder)))
|
|
|
|
DatafiableRow
|
|
(datafiable-row [this connectable opts]
|
|
(with-meta
|
|
(row-builder @builder)
|
|
{`core-p/datafy (navize-row connectable opts)}))
|
|
|
|
(toString [_]
|
|
(try
|
|
(str (row-builder @builder))
|
|
(catch Throwable _
|
|
"{row} from `plan` -- missing `map` or `reduce`?"))))))
|
|
|
|
(defmethod print-dup MapifiedResultSet [rs ^java.io.Writer w]
|
|
(.write w (str rs)))
|
|
|
|
(prefer-method print-dup MapifiedResultSet clojure.lang.IPersistentMap)
|
|
|
|
(defmethod print-method MapifiedResultSet [rs ^java.io.Writer w]
|
|
(.write w (str rs)))
|
|
|
|
(prefer-method print-method MapifiedResultSet clojure.lang.IPersistentMap)
|
|
|
|
(extend-protocol
|
|
DatafiableRow
|
|
clojure.lang.IObj ; assume we can "navigate" anything that accepts metadata
|
|
;; in reality, this is going to be over-optimistic and will like cause `nav`
|
|
;; to fail on attempts to navigate into result sets that are not hash maps
|
|
(datafiable-row [this connectable opts]
|
|
(with-meta this
|
|
{`core-p/datafy (navize-row connectable opts)})))
|
|
|
|
(defn datafiable-result-set
|
|
"Given a ResultSet, a connectable, and an options hash map, return a fully
|
|
realized, datafiable result set per the `:builder-fn` option passed in.
|
|
If no `:builder-fn` option is provided, `as-maps` is used as the default.
|
|
|
|
This can be used to process regular result sets or metadata result sets."
|
|
[^java.sql.ResultSet rs connectable opts]
|
|
(let [builder-fn (get opts :builder-fn as-maps)
|
|
builder (builder-fn rs opts)]
|
|
(loop [rs' (->rs builder) more? (.next rs)]
|
|
(if more?
|
|
(recur (with-row builder rs'
|
|
(datafiable-row (row-builder builder) connectable opts))
|
|
(.next rs))
|
|
(rs! builder rs')))))
|
|
|
|
(defn- stmt->result-set
|
|
"Given a `PreparedStatement` and options, execute it and return a `ResultSet`
|
|
if possible."
|
|
^ResultSet
|
|
[^PreparedStatement stmt opts]
|
|
(if (.execute stmt)
|
|
(.getResultSet stmt)
|
|
(when (:return-keys opts)
|
|
(try
|
|
(.getGeneratedKeys stmt)
|
|
(catch Exception _)))))
|
|
|
|
(defn- reduce-stmt
|
|
"Execute the `PreparedStatement`, attempt to get either its `ResultSet` or
|
|
its generated keys (as a `ResultSet`), and reduce that using the supplied
|
|
function and initial value.
|
|
|
|
If the statement yields neither a `ResultSet` nor generated keys, return
|
|
a hash map containing `:next.jdbc/update-count` and the number of rows
|
|
updated, with the supplied function and initial value applied."
|
|
[^PreparedStatement stmt f init opts]
|
|
(if-let [rs (stmt->result-set stmt opts)]
|
|
(let [rs-map (mapify-result-set rs opts)]
|
|
(loop [init' init]
|
|
(if (.next rs)
|
|
(let [result (f init' rs-map)]
|
|
(if (reduced? result)
|
|
@result
|
|
(recur result)))
|
|
init')))
|
|
(f init {:next.jdbc/update-count (.getUpdateCount stmt)})))
|
|
|
|
(extend-protocol p/Executable
|
|
java.sql.Connection
|
|
(-execute [this sql-params opts]
|
|
(reify clojure.lang.IReduceInit
|
|
(reduce [_ f init]
|
|
(with-open [stmt (prepare/create this
|
|
(first sql-params)
|
|
(rest sql-params)
|
|
opts)]
|
|
(reduce-stmt stmt f init opts)))
|
|
(toString [_] "`IReduceInit` from `plan` -- missing reduction?")))
|
|
(-execute-one [this sql-params opts]
|
|
(with-open [stmt (prepare/create this
|
|
(first sql-params)
|
|
(rest sql-params)
|
|
opts)]
|
|
(if-let [rs (stmt->result-set stmt opts)]
|
|
(let [builder-fn (get opts :builder-fn as-maps)
|
|
builder (builder-fn rs opts)]
|
|
(when (.next rs)
|
|
(datafiable-row (row-builder builder) this opts)))
|
|
{:next.jdbc/update-count (.getUpdateCount stmt)})))
|
|
(-execute-all [this sql-params opts]
|
|
(with-open [stmt (prepare/create this
|
|
(first sql-params)
|
|
(rest sql-params)
|
|
opts)]
|
|
(if-let [rs (stmt->result-set stmt opts)]
|
|
(datafiable-result-set rs this opts)
|
|
[{:next.jdbc/update-count (.getUpdateCount stmt)}])))
|
|
|
|
javax.sql.DataSource
|
|
(-execute [this sql-params opts]
|
|
(reify clojure.lang.IReduceInit
|
|
(reduce [_ f init]
|
|
(with-open [con (p/get-connection this opts)
|
|
stmt (prepare/create con
|
|
(first sql-params)
|
|
(rest sql-params)
|
|
opts)]
|
|
(reduce-stmt stmt f init opts)))
|
|
(toString [_] "`IReduceInit` from `plan` -- missing reduction?")))
|
|
(-execute-one [this sql-params opts]
|
|
(with-open [con (p/get-connection this opts)
|
|
stmt (prepare/create con
|
|
(first sql-params)
|
|
(rest sql-params)
|
|
opts)]
|
|
(if-let [rs (stmt->result-set stmt opts)]
|
|
(let [builder-fn (get opts :builder-fn as-maps)
|
|
builder (builder-fn rs opts)]
|
|
(when (.next rs)
|
|
(datafiable-row (row-builder builder) this opts)))
|
|
{:next.jdbc/update-count (.getUpdateCount stmt)})))
|
|
(-execute-all [this sql-params opts]
|
|
(with-open [con (p/get-connection this opts)
|
|
stmt (prepare/create con
|
|
(first sql-params)
|
|
(rest sql-params)
|
|
opts)]
|
|
(if-let [rs (stmt->result-set stmt opts)]
|
|
(datafiable-result-set rs this opts)
|
|
[{:next.jdbc/update-count (.getUpdateCount stmt)}])))
|
|
|
|
java.sql.PreparedStatement
|
|
;; we can't tell if this PreparedStatement will return generated
|
|
;; keys so we pass a truthy value to at least attempt it if we
|
|
;; do not get a ResultSet back from the execute call
|
|
(-execute [this _ opts]
|
|
(reify clojure.lang.IReduceInit
|
|
(reduce [_ f init]
|
|
(reduce-stmt this f init (assoc opts :return-keys true)))
|
|
(toString [_] "`IReduceInit` from `plan` -- missing reduction?")))
|
|
(-execute-one [this _ opts]
|
|
(if-let [rs (stmt->result-set this (assoc opts :return-keys true))]
|
|
(let [builder-fn (get opts :builder-fn as-maps)
|
|
builder (builder-fn rs opts)]
|
|
(when (.next rs)
|
|
(datafiable-row (row-builder builder)
|
|
(.getConnection this) opts)))
|
|
{:next.jdbc/update-count (.getUpdateCount this)}))
|
|
(-execute-all [this _ opts]
|
|
(if-let [rs (stmt->result-set this opts)]
|
|
(datafiable-result-set rs (.getConnection this) opts)
|
|
[{:next.jdbc/update-count (.getUpdateCount this)}]))
|
|
|
|
Object
|
|
(-execute [this sql-params opts]
|
|
(p/-execute (p/get-datasource this) sql-params opts))
|
|
(-execute-one [this sql-params opts]
|
|
(p/-execute-one (p/get-datasource this) sql-params opts))
|
|
(-execute-all [this sql-params opts]
|
|
(p/-execute-all (p/get-datasource this) sql-params opts)))
|
|
|
|
(defn- default-schema
|
|
"The default schema lookup rule for column names.
|
|
|
|
If a column name ends with `_id` or `id`, it is assumed to be a foreign key
|
|
into the table identified by the first part of the column name."
|
|
[col]
|
|
(let [[_ table] (re-find #"(?i)^(.+?)_?id$" (name col))]
|
|
(when table
|
|
[(keyword table) :id])))
|
|
|
|
(defn- navize-row
|
|
"Given a connectable object, return a function that knows how to turn a row
|
|
into a `nav`igable object.
|
|
|
|
A `:schema` option can provide a map from qualified column names
|
|
(`:<table>/<column>`) to tuples that indicate for which table they are a
|
|
foreign key, the name of the key within that table, and (optionality) the
|
|
cardinality of that relationship (`:many`, `:one`).
|
|
|
|
If no `:schema` item is provided for a column, the convention of `<table>id` or
|
|
`<table>_id` is used, and the assumption is that such columns are foreign keys
|
|
in the `<table>` portion of their name, the key is called `id`, and the
|
|
cardinality is `:one`.
|
|
|
|
Rows are looked up using `-execute-all` or `-execute-one`, and the `:table-fn`
|
|
option, if provided, is applied to both the assumed table name and the
|
|
assumed foreign key column name."
|
|
[connectable opts]
|
|
(fn [row]
|
|
(with-meta row
|
|
{`core-p/nav (fn [coll k v]
|
|
(try
|
|
(let [[table fk cardinality] (or (get-in opts [:schema k])
|
|
(default-schema k))]
|
|
(if fk
|
|
(let [entity-fn (:table-fn opts identity)
|
|
exec-fn! (if (= :many cardinality)
|
|
p/-execute-all
|
|
p/-execute-one)]
|
|
(exec-fn! connectable
|
|
[(str "SELECT * FROM "
|
|
(entity-fn (name table))
|
|
" WHERE "
|
|
(entity-fn (name fk))
|
|
" = ?")
|
|
v]
|
|
opts))
|
|
v))
|
|
(catch Exception _
|
|
;; assume an exception means we just cannot
|
|
;; navigate anywhere, so return just the value
|
|
v)))})))
|