/src/lobos/backends/h2.clj

  1; Copyright (c) Nicolas Buduroi. All rights reserved.
  2; The use and distribution terms for this software are covered by the
  3; Eclipse Public License 1.0 which can be found in the file
  4; epl-v10.html at the root of this distribution. By using this software
  5; in any fashion, you are agreeing to be bound by the terms of this
  6; license.
  7; You must not remove this notice, or any other, from this software.
  8
  9(ns lobos.backends.h2
 10  "Compiler implementation for H2."
 11  (:refer-clojure :exclude [compile defonce])
 12  (:require (lobos [schema :as schema]))
 13  (:use (clojure [string :only [split]])
 14        (lobos analyzer compiler connectivity internal metadata utils))
 15  (:import (lobos.ast AlterRenameAction
 16                      AutoIncClause
 17                      CreateSchemaStatement
 18                      DataTypeClause
 19                      DropStatement)
 20           (lobos.schema ForeignKeyConstraint
 21                         UniqueConstraint)))
 22
 23;; -----------------------------------------------------------------------------
 24
 25;; ## Analyzer
 26
 27(defmethod analyze [:h2 UniqueConstraint]
 28  [_ sname tname cname meta]
 29  (let [columns (split (:column_list meta) #",")
 30        ctype (-> meta :constraint_type as-keyword)]
 31    (UniqueConstraint.
 32     (make-index-name tname ctype columns)
 33     ctype
 34     (map as-keyword columns))))
 35
 36(defmethod analyze [:h2 :constraints]
 37  [_ sname tname]
 38  (let [db-spec (db-meta-spec)]
 39    (concat
 40     (map (fn [meta] (analyze UniqueConstraint sname tname
 41                              (-> meta :constraint_name keyword)
 42                              meta))
 43          (query db-spec
 44                 :INFORMATION_SCHEMA
 45                 :CONSTRAINTS
 46                 (and (or (= :CONSTRAINT_TYPE "UNIQUE")
 47                          (= :CONSTRAINT_TYPE "PRIMARY KEY"))
 48                      (= :TABLE_SCHEMA (as-str sname))
 49                      (= :TABLE_NAME (as-str tname)))))
 50     (map (fn [[cname meta]] (analyze ForeignKeyConstraint cname meta))
 51          (references-meta sname tname)))))
 52
 53;; -----------------------------------------------------------------------------
 54
 55;; ## Compiler
 56
 57(defmethod compile [:h2 DataTypeClause]
 58  [expression]
 59  (let [{:keys [dtype args options]} expression]
 60    (unsupported (= dtype :binary)
 61      "Use varbinary instead.")
 62    (unsupported (:time-zone options)
 63      "Time zones not supported.")
 64    (str (as-sql-keyword dtype) (as-list args))))
 65
 66(defmethod compile [:h2 AutoIncClause]
 67  [_]
 68  "AUTO_INCREMENT")
 69
 70(defmethod compile [::standard CreateSchemaStatement]
 71  [statement]
 72  (let [{:keys [db-spec sname elements]} statement
 73        [elements foreign-keys] (extract-foreign-keys elements)
 74        alters (map compile (build-alter-add-statements
 75                             (assoc db-spec :schema sname)
 76                             foreign-keys))]
 77    (conj alters
 78          (str "CREATE SCHEMA "
 79               (apply join "\n" (conj (map compile elements)
 80                                      (as-identifier db-spec sname)))))))
 81
 82(defmethod compile [:h2 CreateSchemaStatement]
 83  [statement]
 84  (let [{:keys [db-spec sname elements]} statement
 85        [elements foreign-keys] (extract-foreign-keys elements)
 86        alters (map compile (build-alter-add-statements
 87                             (assoc db-spec :schema sname)
 88                             foreign-keys))]
 89    (conj (concat (map (comp compile
 90                             #(assoc-in % [:db-spec :schema] sname))
 91                       elements)
 92                  alters)
 93          (str "CREATE SCHEMA "
 94               (as-identifier db-spec sname)))))
 95
 96(defmethod compile [:h2 DropStatement]
 97  [statement]
 98  (let [{:keys [db-spec otype oname behavior]} statement]
 99    (join \space
100      "DROP"
101      (as-sql-keyword otype)
102      (as-identifier db-spec oname (:schema db-spec))
103      (when (and behavior (#{:table} otype))
104        (as-sql-keyword behavior)))))
105
106(defmethod compile [:h2 AlterRenameAction]
107  [action]
108  (let [{:keys [db-spec element]} action
109        old-name (:cname element)
110        new-name (:others element)]
111    (format "ALTER COLUMN %s RENAME TO %s"
112            (as-identifier db-spec old-name)
113            (as-identifier db-spec new-name))))