/src/lobos/backends/sqlite.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.sqlite
 10  "Compiler implementation for SQLite."
 11  (:refer-clojure :exclude [compile defonce])
 12  (:require (lobos [schema :as schema]))
 13  (:use (lobos analyzer compiler connectivity internal metadata utils))
 14  (:import (lobos.ast AlterTableStatement
 15                      AutoIncClause
 16                      CreateSchemaStatement
 17                      CreateTableStatement
 18                      DataTypeClause
 19                      DropStatement
 20                      IdentifierExpression)
 21           (lobos.schema DataType
 22                         ForeignKeyConstraint
 23                         Schema
 24                         UniqueConstraint)))
 25
 26;; -----------------------------------------------------------------------------
 27
 28;; ## Analyzer
 29
 30(def ^{:private true} analyzer-data-type-aliases
 31  {:time-with-time-zone :time
 32   :timestamp-with-time-zone :timestamp})
 33
 34(defmethod analyze [:sqlite DataType]
 35  [_ column-meta]
 36  (let [dtype (-> column-meta :type_name as-keyword)
 37        tz? #{:time-with-time-zone :timestamp-with-time-zone}
 38        [dtype options] (if (tz? dtype)
 39                          [dtype {:time-zone true}]
 40                          [dtype nil])
 41        dtype (first (replace analyzer-data-type-aliases [dtype]))
 42        args (analyze-data-type-args dtype column-meta)]
 43    (schema/data-type
 44     dtype
 45     (if (#{:decimal :numeric} dtype)
 46       [(first args)]
 47       args)
 48     options)))
 49
 50(defmethod analyze [:sqlite UniqueConstraint]
 51  [_ sname tname cname index-meta]
 52  (let [columns (vec (map #(-> % :column_name keyword)
 53                          index-meta))]
 54    (UniqueConstraint.
 55     (make-index-name tname :unique columns)
 56     :unique
 57     columns)))
 58
 59(defn- analyze-primary-keys [tname]
 60  (let [columns (reduce
 61                 #(conj %1 (-> %2 :column_name keyword))
 62                 []
 63                 (resultset-seq
 64                  (.getPrimaryKeys (db-meta) nil nil (name tname))))]
 65    (when (not-empty columns)
 66      [(UniqueConstraint.
 67        (make-index-name tname :primary-key columns)
 68        :primary-key
 69        columns)])))
 70
 71(defn- analyze-foreign-keys [tname]
 72  (let [fks (group-by :id  (try
 73                             (raw-query (format "pragma foreign_key_list(%s);"
 74                                                (name tname)))
 75                             (catch Exception _)))]
 76    (for [fk fks]
 77      (let [fk (second fk)
 78            pcolumns (reduce #(conj %1 (-> %2 :to keyword)) [] fk)
 79            fcolumns (reduce #(conj %1 (-> %2 :from keyword)) [] fk)
 80            fk (first fk)
 81            ptable (keyword (:table fk))
 82            match (as-keyword (:match fk))
 83            match (when-not (= match :none) match)
 84            on-delete (as-keyword (:on_delete fk))
 85            on-delete (when-not (= on-delete :no-action) on-delete)
 86            on-delete (when on-delete [:on-delete on-delete])
 87            on-update (as-keyword (:on_update fk))
 88            on-update (when-not (= on-update :no-action) on-update)
 89            on-update (when on-delete [:on-update on-update])]
 90        (ForeignKeyConstraint.
 91         (make-index-name tname :fkey fcolumns)
 92         fcolumns
 93         ptable
 94         pcolumns
 95         match
 96         (into {} [on-delete on-update]))))))
 97
 98(defn- analyze-unique [sname tname]
 99  (map (fn [[cname meta]] (analyze UniqueConstraint sname tname cname meta))
100       (indexes-meta sname tname #(let [nu (:non_unique %)]
101                                    (or (false? nu) (= nu 0))))))
102
103(defmethod analyze [:sqlite :constraints]
104  [_ sname tname]
105  (concat (analyze-unique sname tname)
106          (analyze-primary-keys tname)
107          (analyze-foreign-keys tname)))
108
109(defmethod analyze [:sqlite Schema]
110  [_ sname]
111  (let [db-spec (db-meta-spec)
112        sname (or sname
113                  (->> db-spec
114                       :subname
115                       (re-find #"^\./(.*)\.\w+$")
116                       second))]
117    (analyze [:lobos.analyzer/standard Schema] sname)))
118
119;; -----------------------------------------------------------------------------
120
121;; ## Compiler
122
123(defmethod compile [:sqlite IdentifierExpression]
124  [identifier]
125  (as-str (:name identifier)))
126
127(defmethod compile [:sqlite DataTypeClause]
128  [expression]
129  (let [{:keys [dtype args options]} expression
130        {:keys [collate time-zone]} options]
131    (unsupported (and (#{:decimal :numeric} dtype) (= (count args) 2))
132      "Doesn't support scale argument.")
133    (join \space
134      (str (as-sql-keyword dtype) (as-list args))
135      (when collate (str "COLLATE " (as-str collate)))
136      (when time-zone "WITH TIME ZONE"))))
137
138(defmethod compile [:sqlite AutoIncClause]
139  [_]
140  nil)
141
142(defmethod compile [:sqlite CreateSchemaStatement]
143  [statement]
144  (let [{:keys [db-spec sname elements]} statement]
145    (map compile elements)))
146
147(defn- drop-schema [db-spec]
148  (map (comp compile
149             #(schema/build-drop-statement % :cascade db-spec)
150             #(schema/table %)
151             :name)
152       (with-connection db-spec
153         (raw-query
154          (format "select name from sqlite_master where type <> 'index';")))))
155
156(defmethod compile [:sqlite DropStatement]
157  [statement]
158  (let [{:keys [db-spec otype oname behavior]} statement]
159    (if (= otype :schema)
160      (drop-schema db-spec)
161      (join \space
162        "DROP"
163        (as-sql-keyword otype)
164        (as-identifier db-spec oname)))))
165
166(defmethod compile [:sqlite AlterTableStatement]
167  [statement]
168  (unsupported "Alter statement unsupported."))