Pull to refresh

Пишем свой DSL на Clojure для работы с БД

Reading time18 min
Views10K

Давайте напишем Clojure-библиотеку для работы с реляционными БД. Заодно потренируемся в написании макросов, попробуем использовать протоколы и мультиметоды. Ведь нету лучшего способа узнать язык, нежели что-то на нем написать. Ну… или почитать, как написал кто-то другой.

Зачем?
В свое время мне понадобилась такая библиотека для личных нужд. На тот момент существовало два распространенных решения — ClojureQL и Korma. По тем или иным причинам они мне не понравились (да да, фатальный недостаток), было решено сделать свой велосипед. Велосипед вполне рабочий, я доволен. Из внешних отличий — выше расширяемость, упор делался на легкость добавления новых операторов и функций, была важна поддержка подзапросов и вставок из голого SQL.

В статье описывается общая структура этого велосипеда, правда, в несколько упрощенной форме. Некоторых фич нету, код обычно разрабатывался в иной последовательности, за бортом осталось много промежуточных вариантов API. Но, в целом, основные архитектурные идеи описаны точно. Надеюсь, кому-нибудь статья окажется полезной.

Так а что мы пишем?


Создаем DSL (не ORM). В отличие от ORM:
— никаких «умных объектов» — только функции и встроенные структуры данных (включая records);
— никаких «ленивых» связей, магической подгрузки записей и прочих «гадостей»;
— мы хотим четко контролировать время возникновения побочных эффектов — они должны происходить только в строго ожидаемых местах.

Добавим еще несколько требований:
— схожесть с SQL;
— прозрачность, чем меньше «магии» — тем лучше;
— никакой валидации запросов, схем и подобного — оставляем на совести БД;
— автоматическое квотирование идентификаторов и аргументов;
— обеспечение независимости от конкретной базы (но без фанатизма);
— иногда нам нужно писать БД-зависымый код (хранимки, триггеры и т.п.).

Что понимается под «мало магии»? Грубо говоря, подобной библиотеке не следует заниматься оптимизацией запросов, да и любой подобной деятельностью. Теоретически это, быть может, и позволит несколько (ну чуть-чуть) разгрузить БД, на практике дела обычно ухудшаются. Ведь только БД и программист (изредка), обладают достаточными знаниями, чтобы правильно выполнить нужную оптимизацию. Плохой вариант: разработчик пишет запрос, затем очень тщательно изучает логи приложения, дабы выяснить, какой же SQL на самом деле посылается в БД. Перепроверять логи приходится регулярно, ведь после нового релиза библиотека может неожиданно стать «умнее»!

Итак, наш DSL по возможностям будет достаточно глупым прозрачным — семантически мы работаем с голым SQL, но пользуемся синтаксисом Clojure. Что-то вроде записи SQL посредством S-выражений с учетом специфики нашего языка. Выглядеть все будет примерно так:

(select
  (fields [:name :role_name])
  (from :Users)
  (join-inner :Roles (== :Users.role_id :Roles.id))
  (where (= :Roles.name "admin"))
  (order :Users.name)
  (limit 100))


Для этого кода нужно будет породить запрос:

SELECT `name`, `role_name`
FROM `Users` INNER JOIN `Roles` ON `Users`.`role_id` = `Roles`.`id`
WHERE `Roles`.`name` = ?
ORDER BY `Users`.`name`
LIMIT ?


Все имена мы экранируем при помощи обратных кавычек. По-хорошему надо бы использовать двойные кавычки (а еще лучше учитывать тип БД), но в целях читабельности в примерах будем пользоваться MySQL-стилем. Константы заменяются на ? — jdbc-драйвер конкретной БД будет сам заниматься передачей и экранированием параметров.

Непосредственным выполнением SELECT запросов у нас будут заниматься отдельные функции: fetch-all, fetch-one, with-fetch. Все они принимают на вход параметры подключения к БД и запрос, который мы хотим выполнить:

(def db
  {:classname "com.mysql.jdbc.Driver"
   :subprotocol "mysql"
   :user "test"
   :password "test"
   :subname "//localhost/test"})

; вытаскиваем ровно 1 запись из таблицы Users
(fetch-one db
  (select
    (from :Users)
    (where (== :id 123))))

; все записи из таблицы в виде вектора
(fetch-all db
  (select (from :Users)))

(with-fetch db [rows (select (from :Users))]
  ; тут мы работаем с *ленивой* последовательностью `rows`
  (doseq [r rows]
    (print ">" r)))


Генерируем SQL


Для начала определимся, как будем хранить запросы внутри нашей библиотеки.

(def raw-select
  ['SELECT :name :role_name
     ['FROM :Users ['JOIN :Roles ['ON :Users.role_id :Roles_id]]]
     ['WHERE ['LIKE :Users.name "And%"]
     ['LIMIT 100]]])


В этом примере мы имеем дерево из векторов, символов и ключей. При помощи символов будем обозначать ключевые слова SQL, при помощи ключей — имена таблиц и полей, значения (строки, числа, даты и прочее) оставляем «как есть». Скомпилированный запрос представим в виде пары: SQL код (строка) и вектор аргументов. Заводим отдельный тип:

(defrecord Sql [sql args])

;; запросы после компиляции будут выглядеть так:
(Sql. "SELECT * FROM `Users` WHERE `id` = ?" [123])


Это нижнее представление в нашей библиотеке. Реализуем преобразование из одного представления в другое. Для этого нужен некий универсальный способ преобразовывать любую сущность в запись Sql. Отлично подойдут протоколы:

(defprotocol SqlLike
  (as-sql [this]))

; вспомогательная функция
(defn quote-name
  [s]
  (let [x (name s)]
    (if (= "*" x)
      x
      (str \` x \`))))

(extend-protocol SqlLike

  ; для любого `x` (= (as-sql (as-sql x)) (as-sql x))
  Sql
  (as-sql [this] this)

  ; по умолчанию считаем все объекты параметрами для запросов
  Object
  (as-sql [this] (Sql. "?" [this]))

  ; экранируем имена таблиц и столбцов
  clojure.lang.Keyword
  (as-sql [this] (Sql. (quote-name this) nil))

  ; символами обозначаем ключевые слова SQL
  clojure.lang.Symbol
  (as-sql [this] (Sql. (name this) nil))

  ; для nil специальное ключевое слово
  nil
  (as-sql [this] (Sql. "NULL" nil)))


Вместо протоколов можно было бы воспользоваться набором if-ов, или вообще pattern matching. Но у протоколов есть неоспоримый плюс: пользователи библиотеки могут сами реализовать специфическое преобразование для любых типов. Например, кто-то может захотеть автомагически извлекать значения из ссылок:

(extend-protocol SqlLike
  clojure.lang.ARef
  (as-sql [this] (as-sql @this)))

; теперь вместо констант можно передавать
; ссылки (ref, agent, var, atom)
(def a (atom 123))
(assert
  (=
    (as-sql a)
    (as-sql @a)
    (Sql. "?" [123])))


Реализуем наш протокол для векторов и списков:

; вспомогательная функция, объединяет 2 sql-объекта в один
(defn- join-sqls
  ([] (Sql. "" nil))
  ([^Sql s1 ^Sql s2]
    (Sql. (str (.sql s1) " " (.sql s2)) (concat (.args s1) (.args s2)))))

(extend-protocol SqlLike
  clojure.lang.Sequential
  (as-sql [this]
    (reduce join-sqls (map as-sql this))))


С эффективностью алгоритма тут не очень хорошо, можно написать код и побыстрее. Зато теперь:

(as-sql ['SELECT '* ['FROM :Users] ['WHERE :id '= 1 'AND :name 'IS 'NOT nil]])
; => #user.Sql{:sql "SELECT * FROM `Users` WHERE `id` = ? AND `name` IS NOT NULL" :args (1)}


Отлично! Определим еще парочку функций…

(require '[clojure.java.jdbc :as jdbc])

(defn- to-sql-params
  [relation]
  (let [{s :sql p :args} (as-sql relation)]
    (vec (cons s p))))

(defn fetch-all
  [db relation]
    (jdbc/query
     db
     (to-sql-params relation)
     :result-set-fn vec))

; аналогично реализуем `fetch-one`


Работать напрямую с JDBC утомитильно, поэтому хитрим — всю грязную работу за нас делает clojure.java.jdbc. Наконец у нас уже есть вполне приемлемые результаты, библиотекой даже можно пользоваться:

; параметры подключения к БД
(def db
  {:classname "com.mysql.jdbc.Driver"
   :subprotocol "mysql"
   :user "test"
   :password "test"
   :subname "//localhost/test"})

; делаем запрос к БД
(fetch-all
  db
  (as-sql '[SELECT * FROM :users ORDER BY :name]))


Ах да, мы же забыли про with-fetch. Реализуем:

(defmacro with-fetch
  [db [v rel :as vr] & body]
  `(let [params# (to-sql-params ~rel)
         rsf# (fn [~v] ~@body)]
    (jdbc/query
      ~db
      params#
      :result-set-fn rsf#  ; весь RS передаем в функцию rsf#
      :row-fn identity)))  ; строки никак не обрабатываем


Наращиваем запросы итеративно


У выбранного представления есть серъезные минусы — запросы сложно наращивать итеративно. Допустим, у нас есть дерево для запроса SELECT FROM `Users` LIMIT 10, а мы хотим в него добавить секцию WHERE. В общем случае, для подобного придется заниматься разбором синтаксиса SQL (анализировать AST-дерево), чего, по правде говоря, очень хотелось бы избежать.

Зачем нам «итеративно наращивать» запросы? Ну, во-первых, это полезная опция сама по себе. При написании программы частенько мы заранее не знаем, какие запросы будем выполнять. Пример: динамически строим произвольные условия для секций WHERE и ORDER BY в админке.

Но гораздо важнее то, что это хорошая практика при написании программ на Clojure. Мы разбиваем работу на множество небольших кусочков, итеративно делающих свою работу. Каждый такой кирпичик (чистая функция) принимает данные на вход и возвращает «подправленный» результат. Кирпичики легко тестировать и разрабатывать. А под конец такие кусочки легко собираются вместе.

Запросы представляем в виде хеш-таблицы. Пример:

(def some-query-example
  {
   ; отображение "алиас таблицы - имя талицы"
   :tables {:r :Roles, :u :Users},

   ; список [алиас таблицы, тип джоина, выражение для секции ON]
   ; первый элемент -- [исходная таблица, nil, nil]
   ; используем список, т.к. нам важен порядок join'ов
   :joins
     [[:u nil nil]
      [:r :inner ['= :Users.role_id :Roles.id]]]

   ; ast-дерево выражения
   :where [:= :u.name "Ivan"],

   ; отображение "алиас столбца - имя столбца"
   :fields {:name :name, :role_name :role_name},

   ; просто числа
   :offset 1000,
   :limit 100,

   ; order, group, having, etc...
   })


Для секций WHERE, ORDER BY и т.п. мы храним AST-дерево выражения — так проще. Для списка таблиц и полей мы храним словари, ключи — имена алиасов, значения — выражения или имена таблиц. В рамках такой структуры реализуем необходимые функции:

; для `limit` & `offset` тривиально
(defn limit
  [relation v]
  (assoc relation :limit v))

; *пока* сойдут и такие реализации
(defn fields
  [query fd]
  (assoc query :fields fd))

(defn where
  [query wh]
  (assoc query :where wh))

; helper-функция
(defn join*
  [{:keys [tables joins] :as q} type alias table on]
  (let [a (or alias table)]
    (assoc
      q
      :tables (assoc tables a table)
      :joins (conj (or joins []) [a type on]))))

(defn from
  ([q table] (join* q nil table table nil))
  ([q table alias] (join* q nil table alias nil)))

(defn join-cross
  ([q table] (join* q :cross table table nil))
  ([q table alias] (join* q :cross table alias nil)))

;; для других join-ов (left, right, full) нужны макросы - пока опустим


Итак, у нас есть много функций (where, fields, from, join, limit и другие), умеющих «подправлять» запросы. Точка отправления — пустой запрос.

(def empty-select {})


Теперь мы можем записывать:

(-> empty-select
  (fields [:name :role_name])
  (from :Users)
  (limit 100))


Этот код использует макрос ->, который разворачивается во что-то вроде:

(limit
  (from
    (fields
      empty-select
      [:name :role_name])
    :Users)
  100)


Для красоты определяем свой макрос select, который ведет себя подобно ->:

(defmacro select
  [& body]
   `(-> empty-select ~@body))


Осталось научить нашу библиотеку конвертировать одно представление в другое.

; пустой SQL, поскольку nil преобразуется в "NULL"
(def NONE (Sql. "" nil))

; большинство фукнций реализуется тривиально
(defn render-limit [s]
  (if-let [l (:limit s)]
    ['LIMIT l]
    NONE))

(defn render-fields [s] '*)  ; пока будем возвращать все столбцы

; эти функции реализуем чуть позже
(defn render-where [s] NONE)
(defn render-order [s] NONE)
(defn render-expression [s] NONE)

; а эти выходят за рамки статьи
(defn render-group [s] NONE)
(defn render-having [s] NONE)
(defn render-offset [s] NONE)

; вспомогательная функция
(defn render-table
  [[alias table]]
  (if (= alias table)
    ; если алиас и таблица совпадают, то не выводим 'AS'
    table
    [table 'AS alias]))

(defn render-join-type
  [jt]
  (get
    {nil (symbol ",")
     :cross '[CROSS JOIN],
     :left '[LEFT OUTER JOIN],
     :right '[RIGHT OUTER JOIN],
     :inner '[INNER JOIN],
     :full '[FULL JOIN],
     } jt jt))

; некоторые функции довольно сложные
(defn render-from
  [{:keys [tables joins]}]
  ; секции FROM может и не быть!
  (if (not (empty? joins))
    ['FROM
     ; первый джоин
     (let [[a jn] (first joins)
           t (tables a)]
       ; первый джоин должен делаться при помощи `(from ..)`
       (assert (nil? jn))
       (render-table [a t]))
     ; перебираем оставшиеся джоины
     (for [[a jn c] (rest joins)
           :let [t (tables a)]]
       [(render-join-type jn) ; связка JOIN XX или запятая
        (render-table [a t])  ; имя таблицы и алиас
        (if c ['ON (render-expression c)] NONE) ; секция 'ON'
        ])]
    NONE))

(defn render-select
  [select]
  ['SELECT
   (mapv
     #(% select)
     [render-fields
      render-from
      render-where
      render-group
      render-having
      render-order
      render-limit
      render-offset])])


Пользователи библиотеки могут вообще не знать про протокол SqlLike и функцию as-sql. Хорошая практика. Для сравнения, в Java интерфейсы часто определяют API модуля/библиотеки. В Clojure протоколы обычно создаются для самых низкоуровневых операций, некоего базиса, над которым уже работает набор helper-функций. И вот уже эти helper-ы предоcтавляют публичный API библиотеки. Пробуем сгенерировать простой запрос:

(fetch-all db
  (render-select
    (select
      (from :Users)
      (limit 10)))


Готово! Правда вызывать render-select вручную утомительно. Исправляем:

(declare render-select)

; все поля объявлять не обязательно
; record поддерживает установку ключей, не перечисленных при объявлении типа
(defrecord Select [fields where order joins tables offet limit]
  SqlLike
  (as-sql [this] (as-sql (render-select this))))

(def empty-select (map->Select {}))


Теперь при выполнении (as-sql (select ...)) автоматически будет вызываться и render-select:

(fetch-all db
  (select
    (from :Users)
    (limit 10)))

; если мы хотим просто посмотреть SQL без выполнения запроса
(as-sql
  (select
   (from :Table)
   (limit 10)))

; или даже так
(select
 (from :Table)
 (limit 10)
 (as-sql))


Поддержка выражений


Приступим к написанию функции where. Мы хотим иметь возможность использовать ее так:

(select
 (from :Table)
 (where (and (> :x 1) (== :y "z"))))


Очевидно, что нельзя вычислять (> :x 1) в момент вызова where — нужен макрос. Построенное выражения будем хранить в виде AST-дерева: узлы — операторы, листья — константы и поля. Для начала напишем вспомогательную функцию where*:

; склеиваем 2 выражения вместе при помощи AND
(defn- conj-expression
  [e1 e2]
  (cond
    (not (seq e1)) e2
    (= 'and (first e1)) (conj (vec e1) e2)
    :else (vector 'and e1 e2)))

(conj-expression '[> 1 2] '[< "a" "b"])
; => '[and [> 1 2] [< "a" "b"]])

(conj-expression '[and [> 1 [+ 2 3]] [= :x :y]] '[<> "a" "b"])
; => '[and [> 1 [+ 2 3]] [= :x :y] [<> "a" "b"]]

(defn where*
  [query expr]
    (assoc query :where (conj-expression (:where query) expr)))


Теперь пришла пора для render-where:

; взаимнорекурсивные функции
(declare render-operator)
(declare render-expression)

; функция или оператор?
(defn- function-symbol? [s]
  (re-matches #"\w+" (name s)))

; форматируем вызов функции или оператора
(defn render-operator
  [op & args]
  (let [ra (map render-expression args)
        lb (symbol "(")
        rb (symbol ")")]
    (if (function-symbol? op)
      ; функция (count, max, ...)
      [op lb (interpose (symbol ",") ra) rb]
      ; оператор (+, *, ...)
      [lb (interpose op (map render-expression args)) rb])))

(defn render-expression
  [etree]
  (if (and (sequential? etree) (symbol? (first etree)))
    (apply render-operator etree)
    etree))

(defn render-where
  [{:keys [where]}]
  (if where
    ['WHERE (render-expression where)]
    NONE))


Отлично, теперь мы можем записывать простейшие выражения:

(select
  (from :Users)
  (where* ['= :id 1])
  (as-sql))
; => (Sql. "SELECT * FROM `Users` WHERE ( `id` = ? )" [1])


Получилось некрасиво, поправим это несложным макросом:

(defn prepare-expression
  [e]
  (if (seq? e)
    `(vector
       (quote ~(first e))
       ~@(map prepare-expression (rest e)))
    e))

(defmacro where
  [q body]
  `(where* ~q ~(prepare-expression body)))


Заменяем все последовательности (списки) на вектора. Остальные значения оставляем как есть. Мы пропустили важный момент — некоторые операторы в Clojure и SQL называются по-разному, например <&gt и not=. Вопрос философский, какой же вариант лучше использовать. С одной стороны, мы решили оставлять библиотеку максимально «глупой», с другой — гораздо приятнее видеть «родные» для Clojure функции. Давайте разрешим оба варианта:

(defn- canonize-operator-symbol
  [op]
  (get '{not= <>, == =} op op))

; перепишем функцию
(defn prepare-expression
  [e]
  (if (seq? e)
    `(vector
       (quote ~(canonize-operator-symbol (first e)))
       ~@(map prepare-expression (rest e)))
    e))


Хорошо, при использовании макроса where можно писать оба варианта, но внутри нашего представления запросов будет только один. То что надо. У нас остался небольшой должок — не работают джоины.

(defmacro join-left
  ([q table cond] `(let [t# ~table] (join-left ~q t# t# ~cond)))
  ([q table alias cond] (join* ~q :cross ~table ~alias ~(prepare-expression cond))))
; аналогично для других джоинов, меняется только ключ...


Писать несколько одинаковых макросов — неблагородное дело:

; импортируем очень полезный макрос `do-template`
(use 'clojure.template)

; этот код разворачивается в 5 объявлений макросов
(do-template
  [join-name join-key]  ; параметры для шаблона

  ; сам шаблон
  (defmacro join-name
   ([relation alias table cond]
     `(join* ~relation ~join-key ~alias ~table ~(prepare-expression cond)))
   ([relation table cond]
     `(let [table# ~table]
        (join* ~relation ~join-key nil table# ~(prepare-expression cond)))))

  ; значения для параметров
  join-inner :inner,
  join :inner,
  join-right :right,
  join-left :left,
  join-full :full)


Больше возможностей


Пока мы умеем выполнять только простейшие запросы. Сделаем поддержку выражений в перечислении столбцов.

; применяем `f` к значениям `m` (не ключам)
(defn- map-vals
  [f m]
  (into (if (map? m) (empty m) {}) (for [[k v] m] [k (f v)])))

; счетчик для генерации уникальных идентификаторов
(def surrogate-alias-counter (atom 0))

; генерируем идентификаторы вида :__00001234
(defn generate-surrogate-alias
  []
  (let [k (swap! surrogate-alias-counter #(-> % inc (mod 1000000)))]
    (keyword (format "__%08d" k))))

; преобразуем произвольное выражение в "алиас"
(defn as-alias
  [n]
  (cond
    (keyword? n) n               ; имя столбца/таблицы оставляем как есть
    (string? n) (keyword n)      ; аналогично для строк
    :else (generate-surrogate-alias)))  ; для выражений генерируем суррогатный алиас

; список столбцов для запроса -- словарь "алиас - выражение" или вектор столбцов
(defn- prepare-fields
  [fs]
  (if (map? fs)
    (map-vals prepare-expression fs)
    (into {} (map (juxt as-alias prepare-expression) fs))))

(defn fields*
  [query fd]
  (assoc query :fields fd))

(defmacro fields
  [query fd]
  `(fields* ~query ~(prepare-fields fd)))

(defn render-field
  [[alias nm]]
  (if (= alias nm)
    nm  ; просто имя столбца
    [(render-expression nm) 'AS alias]))

(defn render-fields
  [{:keys [fields]}]
  (if (or (nil? fields) (= fields :*))
    '*
    (interpose (symbol ",") (map render-field fields))))


Неплохо. Теперь можно писать так:

(select
  (fields {:n :name, :a :age})  ; алиасы для столбцов
  (from :users))

; или так
(select
  (fields {:cnt (count :*), :max-age (max :age)})
  (from :users))

; или даже так
(select
  (fields [(count :*)])  (from :users))


Добавляем сортировку. Уже привычный порядок действий: создаем функцию order* и макрос order, реализуем render-order:

(defn order*
  ([relation column] (order* relation column nil))
  ([{order :order :as relation} column dir]
    (assoc
      relation
      :order (cons [column dir] order))))

(defmacro order
  ([relation column]
     `(order* ~relation
              ~(prepare-expression column)))
  ([relation column dir]
     `(order* ~relation
              ~(prepare-expression column) ~dir)))

(defn render-order
  [{order :order}]
  (let [f (fn [[c d]]
            [(render-expression c)
             (get {nil [] :asc 'ASC :desc 'DESC} d d)])]
    (if order
      ['[ORDER BY] (interpose (symbol ",") (map f order))]
      [])))


Появилась возможность сортировать выборку в наших запросах, в том числе по произвольному выражению:

(select
  (from :User)
  (order (+ :message_cnt :post_cnt)))


Аналогичным способом можем добавить поддержку группировок, подзапросов и подобного… Вот так, например, может выглядеть реализация для UNION ALL:

; вспомогательная функция-рендер
(defn render-union-all
  [{ss :selects}]
  (interpose ['UNION 'ALL] (map render-select ss)))

; отдельный тип, просто храним список всех селектов
(defrecord UnionAll [selects]
  SqlLike
  (as-sql [this] (as-sql (render-union-all this))))

; тут нам *не* нужна пара функция-макрос
(defn union-all
  [& ss]
  (->UnionAll ss))

;; пользуемся ...
(as-sql
  (union-all
    (select (from :Users) (fields [:email]))
    (select (from :Accounts) (fields [:email]))))


Поддержка нескольких БД — диалекты


Добавим поддержку нескольких баз данных. Идея проста: ряд функций в нашей библиотеке может менять свое поведение в зависимости от того, какую базу мы используем. Организуем древовидную иерархию диалектов:

; самый общий диалект
(def ^:const default-dialect ::sql92)

; тут мы будем хранить диалект для текущего соединения с БД
(def ^:dynamic *dialect* nil)

; а это иерархия диалектов
(def dialects-hierarchy (make-hierarchy))

; функция, чтобы регестрировать диалекты было удобнее
(defn register-dialect
  ([dialect parent]
    (alter-var-root #'dialects-hierarchy derive dialect parent))
  ; по умолчанию диалекты наследуются от ::sql92
  ([dialect]
    (register-dialect dialect default-dialect)))

; пример
(register-dialect ::pgsql)
(register-dialect ::pgsql92 ::pgsql)

; postgresql позволяет определять свои операторы
; можно создавать ad-hoc диалекты для конкретных баз 
(register-dialect ::my-custom-db-with-extra-functions ::pgsql92)


Теперь определим небольшой макрос defndialect:

; просто возвращаем текущий диалект
; игнорируем все параметры
(defn current-dialect
  [& _]
  (or *dialect* default-dialect))

; макрос для определения "обычных" функций
(defmacro defndialect
  [name & args-and-body]
  `(do
     ; определяем мультиметод
     (defmulti ~name current-dialect :hierarchy #'dialects-hierarchy)
     ; реализация для диалекта `sql92`
     (defmethod ~name default-dialect ~@args-and-body)))


Теперь нужно не забыть занести значение диалекта в переменную *dialect*:

(defmacro with-db-dialect
  [db & body]
  ; диалект нужно прописать в параметры подключения к БД
  `(binding [*dialect* (:dialect ~db)]
    ~@body))


Отлично. Остался последний шаг: переписываем все определения функций для рендеринга, заменяя defn на defndialect. Тело функций менять не надо. И теперь нас появилась возможность генерировать разный SQL в зависимости от базы:

(defndialect quote-name
  [s]
  (let [x (name s)]
    (if (= "*" x) x (str "\"" x "\""))))

; MySQL использует обратные кавычки
(defmethod quote-name ::mysql
  [s]
  (let [x (name s)]
    (if (= "*" x) x (str "`" x "`"))))


Напоследок замечаем, что вовсе нет необходимости вызывать with-db-dialect вручную, можно переписать наши функции fetch-*:

(defn fetch-all
  [db relation]
    (jdbc/query
     db
     (with-db-dialect db (to-sql-params relation))
     :result-set-fn vec))
; аналогично переписываем остальные функции fetch-*


RAW запросы


Иногда нужно использовать слишком специфические запросы — их проще записывать в виде строки, минуя DSL. Не проблема:

(require '[clojure.string :as s])

(defn format-sql
  [raw-sql args]
    (let [; находим все плейсхолдеры вида :x
          al (map
               (comp keyword second)
               (re-seq #":([\w.-]+)" raw-sql))
          ; заменяем все плейсхолдеры на "?"
	  pq (s/replace raw-sql #":[\w.-]+" "?")]
      (->Sql pq (map args al))))

; пользуемся...
(fetch-all db
  (format-sql
    "SELECT * FROM Users WHERE role = :rl AND age < :age"
    {:rl "admin" :age 18}))


Кстати, сформированные таким образом запросы можно использовать в UNION ALL, который мы реализовали чуть выше. К сожалению, инкрементально изменять их не получится — для этого пришлось бы парсить строку с SQL-кодом. Обходной путь — подзапросы:

(defn users-by-role
  [r]
  (format-sql "SELECT * FROM Users WHERE role = :r" {:r r}))

; вот так нельзя
(->
  (users-by-role "ADMIN")
  (order :name)
  (as-sql))

; а вот так можно..?
(select
  (from :x (users-by-role "ADMIN"))
  (order :name)
  (as-sql))
; => #user.Sql{:sql "SELECT * FROM SELECT * FROM Users WHERE role = ? AS `x` ORDER BY `name`", :args ("ADMIN")}


Упс, в сгенерированном SQL не хватает круглых скобочек. Устраняем оплошность, вот исправленная версия render-table:

(defn render-table
  [[alias table]]
  (if (= alias table)
    ; если алиас и таблица совпадают, то не выводим 'AS'
    table
    ; если таблица - это sql - добавляем скобочки
    (if (or (instance? Sql table) (instance? Select table))
      [(symbol "(") table (symbol ")") 'AS alias]
      [table 'AS alias])))

; вот теперь работает как положено
(select
  (from :x (users-by-role "ADMIN"))
  (order :name)
  (as-sql))


Постоянное соединение с БД


Разумеется, открывать каждый раз новое соединение внутри функций fetch-* не вариант. Снова макрос:

(defn with-connection*
  [db body-fn]
  (assert (nil? (jdbc/db-find-connection db)))
  (with-open [conn (jdbc/get-connection db)]
    (body-fn (jdbc/add-connection db conn))))

(defmacro with-connection
  [binding & body]
  `(with-connection* ~(second binding) (fn [~(first binding)] ~@body)))


Тут мы проверяем что открытого соединения еще нету, открываем новое и «прикрепляем» к словарю с параметрами БД. Пользоваться нужно так:

(def db {...})

(with-connection [c db]
  ; в параметрe `c` хранятся параметры из `db` + открытое соединение
  (fetch-all c (select (from :B)))
  ; ...
  (fetch-all c (select (from :A))))


Аналогичным способом можно добавить поддержку транзакций.

Небольшой бонус - больше скорости с элементами ненормального программирования
Очевидно, что библиотека вносит дополнительные расходы: нужно сформировать исходный запрос в самом высокоуровневом представлении, преобразовать его при помощи render-select, результат пропустить через as-sql. В добавок ко всему, многие функции у нас реализованы через defndialect, что тоже отрицательно сказывается на производительности. Особенно обидно повторять такие операции для простейших запросов вроде «вытащить запись по id». По правде говоря, оверхед совсем незначительный по сравнению со временем работы БД… Но при сильном желании можно добавить еще больше скорости. Итак, наша цель:

; специальный макрос, который компилирует SQL только один раз
(defselect get-user-by-id [x]
  (from :Users)
  (where (= :id x))))

; или так, особенно удобно оформлять legacy запросы
(defselect get-user-by-id [x]
  "SELECT * FROM `Users` WHERE `id` = :x")

; используем
(fetch-one db (get-user-by-id 123))


Есть проблемка — диалекты. Мы не можем вычислить запрос на этапе компиляции программы (в теле макроса), поскольку не знаем какой же диалект будет активен при выполнении. Можно предвычислять запрос для всех доступных диалектов, но они ведь могут добавляться динамически (в рантайме) — скорее всего мы пропустим нужный, плохо.

Альтернативное решение — кешировать вычисленные запросы. Т.е. каждый такой defselect хранит в себе кеш — словарь «диалект — SqlLike-объект». Таким образом, для каждого диалекта мы выполняем компиляцию (потенциально дорогую для сложных запросов) один раз для каждого диалекта. После извлечения записи Sql мы просто подставляем нужные аргументы в поле :args, никак не изменяя :sql.

; ленивый запрос - просто храним функцию для вычисления SQL кода
(defrecord LazySelect [content-fn]
  SqlLike
  (as-sql [this] (content-fn)))

; уже готовый запрос в виде строки
(defrecord RenderedSelect [content]
  SqlLike
  (as-sql [this] (as-sql content)))

; вспомогательный тип
(defrecord SurrogatedArg [symbol]
  SqlLike
  (as-sql [this] (Sql. symbol "?")))

(defn emit-precompiled-select
  [name args body]

  (let [; тут args - имена параметров функции
        sargs (map ->SurrogatedArg args)
        ; отображение суррогатных аргументов в символы
        sargs-args (into {} (map vector sargs args))]

    `(let [sqls# (atom {})  ; тут храним вычисленые запросы

           ; "оригинальная" функция
           original# (fn ~name ~args (as-sql (select ~@body)))

           ; вычисляем оригинальную функцию,
           ; но с суррогатными параметрами
           compile# (fn [] (apply original# (list ~@sargs)))]

       (defn ~name ~args
         (->LazySelect
          (fn []
            (let [; берем диалект, проверяем есть ли
                  ; вычисленный запрос
                  dialect# (current-dialect)
                  cached-sql# (get @sqls# dialect#)

                  ; если нет - вычисляем новый
                  sql# (if cached-sql#
                         cached-sql#

                         ; синхронизация упрощена
                         ; запрос может скомпилироваться несколько раз,
                         ; но нам это не страшно - игнорируем
                         (let [new-sql# (compile#)]
                           (swap! sqls# assoc dialect# new-sql#)
                           new-sql#))

                  ; извлекаем вектор с суррогатными параметрами
                  args# (:args sql#)]

              ; заменяем суррогатные параметры на настоящие
              (assoc sql# :args (replace ~sargs-args args#)))))))))

; запрос задан в виде строки
(defn emit-raw-select
  [name args sql]
  ; вычисляем список параметров
  (let [args-map (into {} (map (juxt keyword identity) args))]
    ; определяем функцию, порождающую RenderedSelect
    `(defn ~name ~args
       (->RenderedSelect
         (format-sql ~sql ~args-map)))))

(defmacro defselect
  [name args & body]
    (if (and (== 1 (count body)) (string? (first body)))
      (emit-raw-select name args (first body))
      (emit-precompiled-select name args body)))



В завершение


В статье не затронута реализация функций для модификации БД: вставка, удаление, обновление записей. Нету инструментов для работы с DDL, транзакциями да и много чего еще. Зато новую функциональность добавить довольно легко, часто даже без модификации существующего кода. Предложенный способ — один из многих, не без недостатов, но вполне имеющий право на жинь. Напоследок оставляю ссылку на код полной версии, по мотивам которой и была написана эта статья.
Tags:
Hubs:
Total votes 20: ↑19 and ↓1+18
Comments4

Articles