(ns lobos.compiler
  (:refer-clojure :exclude [compile defonce replace])
  (:require (lobos [ast :as ast]))
  (:use (clojure [string :only [replace]])
        lobos.utils)
  (:import (java.lang UnsupportedOperationException)))

(ast/import-all)

(def backends-hierarchy
  (atom (-> (make-hierarchy)
            (derive :h2 ::standard)
            (derive :mysql ::standard)
            (derive :postgresql ::standard)
            (derive :sqlite ::standard)
            (derive :sqlserver ::standard))))

(defmulti compile
  (fn [o]
    [(-> o :db-spec :subprotocol (or ::standard) keyword)
     (type o)])
  :hierarchy backends-hierarchy)

(defn as-identifier
  [db-spec name & qualifiers]
  (compile (IdentifierExpression. db-spec name qualifiers)))

(defn unsupported
  ([msg] (unsupported true msg))
  ([cond msg]
     (when cond
       (throw (UnsupportedOperationException. (str msg))))))

(defn mode
  [db-spec]
  (Mode. db-spec))

(defn- extract-foreign-keys*
  [table]
  (let [fkey? #(instance? ForeignKeyConstraintDefinition %)
        foreign-keys (vector (:tname table)
                             (->> (:elements table)
                                  (filter fkey?)))
        table (update-in table [:elements]
               (fn [es] (filter #(not (fkey? %)) es)))]
    [table foreign-keys]))

(defn extract-foreign-keys
  [elements]
  (let [tables (filter #(instance? CreateTableStatement %) elements)
        others (filter #(not (instance? CreateTableStatement %)) elements)
        results (map extract-foreign-keys* tables)
        tables (map first results)
        foreign-keys (apply hash-map (apply concat (map second results)))]
    [(concat tables others)
     foreign-keys]))

(defn build-alter-add-statements
  [db-spec m]
  (for [[tname elements] m element elements]
    (AlterTableStatement. db-spec tname :add element)))

(defmethod compile [::standard Mode] [_] nil)

(defmethod compile [::standard ScalarExpression]
  [expression]
  (let [{:keys [scalar]} expression]
    (cond (keyword? scalar) (str (as-sql-keyword scalar))
          (string? scalar) (str "'" scalar "'")
          :else scalar)))

(defmethod compile [::standard IdentifierExpression]
  [identifier]
  (let [{:keys [db-spec name qualifiers]} identifier]
    (join* \. (->> (concat qualifiers [name])
                   (filter identity)
                   (map #(when % (as-str \" % \")))))))

(defmethod compile [::standard FunctionExpression]
  [function]
  (let [{:keys [db-spec name args]} function]
    (str (as-sql-keyword name)
         (as-list (map compile args)))))

(defmethod compile [::standard OperatorExpression]
  [operator]
  (let [{:keys [db-spec op left right]} operator]
    (if (vector? (first right))
      (str "("
           (compile left) " "
           (as-sql-keyword op) " "
           (as-list (map compile (first right)))
           ")")
      (str "(" (apply join
                      (str " " (as-sql-keyword op) " ")
                      (map compile (conj right left))) ")"))))

(defmethod compile [::standard DataTypeClause]
  [expression]
  (let [{:keys [dtype args options]} expression
        {:keys [encoding collate time-zone]} options]
    (join \space
      (str (as-sql-keyword dtype) (as-list args))
      (when encoding ["CHARACTER SET" (as-str encoding)])
      (when collate ["COLLATE" (as-str collate)])
      (when time-zone ["WITH TIME ZONE"]))))

(defmethod compile [::standard AutoIncClause]
  [_]
  "GENERATED ALWAYS AS IDENTITY")

(defmethod compile [::standard ColumnDefinition]
  [definition]
  (let [{:keys [db-spec cname data-type default
                auto-inc not-null others]} definition]
    (apply join \space
      (as-identifier db-spec cname)
      (compile data-type)
      (when default  (str "DEFAULT " (compile default)))
      (when auto-inc (compile auto-inc))
      (when not-null "NOT NULL")
      others)))

(defmethod compile [::standard UniqueConstraintDefinition]
  [definition]
  (let [{:keys [db-spec cname ctype columns]} definition]
    (join \space
      "CONSTRAINT"
      (as-identifier db-spec cname)
      (as-sql-keyword ctype)
      (as-list (map (partial as-identifier db-spec) columns)))))

(defmethod compile [::standard ForeignKeyConstraintDefinition]
  [definition]
  (let [{:keys [db-spec cname columns parent-table parent-columns match
                triggered-actions]} definition]
    (join \space
      "CONSTRAINT"
      (as-identifier db-spec cname)
      "FOREIGN KEY"
      (as-list (map (partial as-identifier db-spec) columns))
      "REFERENCES"
      (as-identifier db-spec parent-table (:schema db-spec))
      (as-list (map (partial as-identifier db-spec) parent-columns))
      (when match (str "MATCH " (as-sql-keyword match)))
      (when (contains? triggered-actions :on-delete)
        (str "ON DELETE " (as-sql-keyword (:on-delete triggered-actions))))
      (when (contains? triggered-actions :on-update)
        (str "ON UPDATE " (as-sql-keyword (:on-update triggered-actions)))))))

(defmethod compile [::standard CheckConstraintDefinition]
  [definition]
  (let [{:keys [db-spec cname condition]} definition]
    (join \space
      "CONSTRAINT"
      (as-identifier db-spec cname)
      "CHECK"
      (compile condition))))

(defmethod compile [::standard CreateSchemaStatement]
  [statement]
  (let [{:keys [db-spec sname elements]} statement
        [elements foreign-keys] (extract-foreign-keys elements)
        alters (map compile (build-alter-add-statements
                             (assoc db-spec :schema sname)
                             foreign-keys))]
    (conj alters
          (str "CREATE SCHEMA "
               (apply join "\n" (conj (map compile elements)
                                      (as-identifier db-spec sname)))))))

(defmethod compile [::standard CreateTableStatement]
  [statement]
  (let [{:keys [db-spec tname elements]} statement]
    (format "CREATE TABLE %s %s"
            (as-identifier db-spec tname (:schema db-spec))
            (or (as-list (map compile elements))
                "()"))))

(defmethod compile [::standard CreateIndexStatement]
  [statement]
  (let [{:keys [db-spec iname tname columns options]} statement
        index-column #(if (keyword? %)
                        (as-identifier db-spec %)
                        (let [col (first %)
                              options (set (rest %))]
                          (apply join \space
                            (as-identifier db-spec (first %))
                            (map as-sql-keyword options))))]
    (format "CREATE %sINDEX %s ON %s %s"
            (str (when ((set options) :unique) "UNIQUE "))
            (as-identifier db-spec iname)
            (as-identifier db-spec tname (:schema db-spec))
            (as-list (map index-column columns)))))

(defmethod compile [::standard DropStatement]
  [statement]
  (let [{:keys [db-spec otype oname behavior]} statement]
    (join \space
      "DROP"
      (as-sql-keyword otype)
      (as-identifier db-spec oname (:schema db-spec))
      (as-sql-keyword behavior))))

(defmethod compile [::standard AlterAddAction]
  [action]
  (let [{:keys [db-spec element]} action
        element (assoc element :db-spec db-spec)]
    (join \space
          "ADD"
          (compile element))))

(defmethod compile [::standard AlterDropAction]
  [action]
  (let [{:keys [db-spec element]} action
        is-column (instance? ColumnDefinition element)]
    (join \space
          "DROP"
          (if is-column
            "COLUMN"
            "CONSTRAINT")
          (as-identifier db-spec (:cname element)))))

(defmethod compile [::standard AlterModifyAction]
  [action]
  (let [{:keys [db-spec element]} action
        default (:default element)]
    (if default
      (join \space
            "ALTER COLUMN"
            (as-identifier db-spec (:cname element))
            (if (= default :drop)
              "DROP DEFAULT"
              (str "SET DEFAULT " (compile default))))
      (unsupported "Only set/drop default supported."))))

(defmethod compile [::standard AlterRenameAction]
  [action]
  (let [{:keys [db-spec element]} action]
     (unsupported "Rename action not supported.")))

(defmethod compile [::standard AlterTableStatement]
  [statement]
  (let [{:keys [db-spec tname action element]} statement
        element (assoc element :sname (:schema db-spec) :tname tname)]
    (join \space
          "ALTER TABLE"
          (as-identifier db-spec tname (:schema db-spec))
          (case action
            :add    (compile (AlterAddAction. db-spec element))
            :drop   (compile (AlterDropAction. db-spec element))
            :modify (compile (AlterModifyAction. db-spec element))
            :rename (compile (AlterRenameAction. db-spec element))))))

(ns lobos.backends.h2
  (:refer-clojure :exclude [compile defonce])
  (:require (lobos [schema :as schema]))
  (:use (clojure [string :only [split]])
        (lobos analyzer compiler connectivity internal metadata utils))
  (:import (lobos.ast AlterRenameAction
                      AutoIncClause
                      CreateSchemaStatement
                      DataTypeClause
                      DropStatement)
           (lobos.schema ForeignKeyConstraint
                         UniqueConstraint)))

(defmethod analyze [:h2 UniqueConstraint]
  [_ sname tname cname meta]
  (let [columns (split (:column_list meta) #",")
        ctype (-> meta :constraint_type as-keyword)]
    (UniqueConstraint.
     (make-index-name tname ctype columns)
     ctype
     (map as-keyword columns))))

(defmethod analyze [:h2 :constraints]
  [_ sname tname]
  (let [db-spec (db-meta-spec)]
    (concat
     (map (fn [meta] (analyze UniqueConstraint sname tname
                              (-> meta :constraint_name keyword)
                              meta))
          (query db-spec
                 :INFORMATION_SCHEMA
                 :CONSTRAINTS
                 (and (or (= :CONSTRAINT_TYPE "UNIQUE")
                          (= :CONSTRAINT_TYPE "PRIMARY KEY"))
                      (= :TABLE_SCHEMA (as-str sname))
                      (= :TABLE_NAME (as-str tname)))))
     (map (fn [[cname meta]] (analyze ForeignKeyConstraint cname meta))
          (references-meta sname tname)))))

(defmethod compile [:h2 DataTypeClause]
  [expression]
  (let [{:keys [dtype args options]} expression]
    (unsupported (= dtype :binary)
      "Use varbinary instead.")
    (unsupported (:time-zone options)
      "Time zones not supported.")
    (str (as-sql-keyword dtype) (as-list args))))

(defmethod compile [:h2 AutoIncClause]
  [_]
  "AUTO_INCREMENT")

(defmethod compile [::standard CreateSchemaStatement]
  [statement]
  (let [{:keys [db-spec sname elements]} statement
        [elements foreign-keys] (extract-foreign-keys elements)
        alters (map compile (build-alter-add-statements
                             (assoc db-spec :schema sname)
                             foreign-keys))]
    (conj alters
          (str "CREATE SCHEMA "
               (apply join "\n" (conj (map compile elements)
                                      (as-identifier db-spec sname)))))))

(defmethod compile [:h2 CreateSchemaStatement]
  [statement]
  (let [{:keys [db-spec sname elements]} statement
        [elements foreign-keys] (extract-foreign-keys elements)
        alters (map compile (build-alter-add-statements
                             (assoc db-spec :schema sname)
                             foreign-keys))]
    (conj (concat (map (comp compile
                             #(assoc-in % [:db-spec :schema] sname))
                       elements)
                  alters)
          (str "CREATE SCHEMA "
               (as-identifier db-spec sname)))))

(defmethod compile [:h2 DropStatement]
  [statement]
  (let [{:keys [db-spec otype oname behavior]} statement]
    (join \space
      "DROP"
      (as-sql-keyword otype)
      (as-identifier db-spec oname (:schema db-spec))
      (when (and behavior (#{:table} otype))
        (as-sql-keyword behavior)))))

(defmethod compile [:h2 AlterRenameAction]
  [action]
  (let [{:keys [db-spec element]} action
        old-name (:cname element)
        new-name (:others element)]
    (format "ALTER COLUMN %s RENAME TO %s"
            (as-identifier db-spec old-name)
            (as-identifier db-spec new-name))))

(ns lobos.backends.mysql
  (:refer-clojure :exclude [compile defonce])
  (:require (lobos [schema :as schema]
                   [ast :as ast]))
  (:use (lobos [schema :only [build-definition]]
               analyzer
               compiler
               metadata
               utils))
  (:import (lobos.schema Column
                         DataType
                         Schema
                         UniqueConstraint)))

(ast/import-all)

(def ^{:private true} analyzer-data-type-aliases
  {:bit :boolean
   :int :integer
   :text :clob
   :tinyblob :blob
   :tinytext :clob})

(defmethod analyze [:mysql DataType]
  [_ column-meta]
  (let [dtype (-> column-meta :type_name as-keyword)
        dtype (first (replace analyzer-data-type-aliases [dtype]))]
    (schema/data-type
     dtype
     (if (#{:time :timestamp} dtype)
       []
       (analyze-data-type-args dtype column-meta)))))

(defmethod analyze [:mysql UniqueConstraint]
  [_ sname tname cname index-meta]
  (let [pkeys (primary-keys sname tname)
        pkey (pkeys (keyword cname))
        columns (vec (map #(-> % :column_name keyword)
                          index-meta))]
    (UniqueConstraint.
     (if pkey
       (make-index-name tname :primary-key columns)
       (keyword cname))
     (if pkey
       :primary-key
       :unique)
     columns)))

(defn- analyze-column [sname tname cname]
  (analyze Column
    (first
     (resultset-seq
      (.getColumns (db-meta) (name sname) nil (name tname) (name cname))))))

(defmethod analyze [:mysql Schema]
  [_ sname]
  (let [db-spec (db-meta-spec)
        sname (or sname
                  (->> db-spec
                       :subname
                       (re-find #"//.*/(.+)$")
                       second))]
    (when-not sname
      (throw (java.sql.SQLException. "No database selected")))
    (analyze [:lobos.analyzer/standard Schema] sname)))

(defmethod compile [:mysql IdentifierExpression]
  [identifier]
  (let [{:keys [db-spec name qualifiers]} identifier]
    (join* \. (->> (concat qualifiers [name])
                   (filter identity)
                   (map #(when % (as-str \` % \`)))))))

(def ^{:private true} compiler-data-type-aliases
  {:clob :text
   :nclob :text})

(defmethod compile [:mysql DataTypeClause]
  [expression]
  (let [{:keys [dtype args options]} expression
        {:keys [encoding collate]} options
        encoding (when (= dtype :nclob) "UTF8")
        dtype (first (replace compiler-data-type-aliases [dtype]))
        args (if (#{:time :timestamp} dtype) [] args)]
    (unsupported (= dtype :real)
      "Use double instead.")
    (unsupported (:time-zone options)
      "Time zones not supported.")
    (join \space
      (str (as-sql-keyword dtype) (as-list args))
      (when encoding (str "CHARACTER SET " (as-str encoding)))
      (when collate (str "COLLATE " (as-str collate))))))

(defmethod compile [:mysql AutoIncClause]
  [_]
  "AUTO_INCREMENT")

(defmethod compile [:mysql CreateSchemaStatement]
  [statement]
  (let [{:keys [db-spec sname elements]} statement
        [elements foreign-keys] (extract-foreign-keys elements)
        alters (map compile (build-alter-add-statements
                             (assoc db-spec :schema sname)
                             foreign-keys))]
    (conj (concat (map (comp compile
                             #(assoc-in % [:db-spec :schema] sname))
                       elements)
                  alters)
          (str "CREATE SCHEMA "
               (as-identifier db-spec sname)))))

(defmethod compile [:mysql DropStatement]
  [statement]
  (let [{:keys [db-spec otype oname behavior options]} statement]
    (if (= otype :index)
      (join \space
        "DROP INDEX"
        (as-identifier db-spec oname)
        "ON"
        (as-identifier db-spec (:tname options) (:schema db-spec)))
      (join \space
        "DROP"
        (as-sql-keyword otype)
        (as-identifier db-spec oname (:schema db-spec))
        (when (and behavior (#{:table} otype))
          [(as-sql-keyword behavior)])))))

(defmethod compile [:mysql AlterDropAction]
  [action]
  (let [{:keys [db-spec element]} action
        is-unique (instance? UniqueConstraintDefinition element)
        is-pkey (and is-unique (= (:type element) :primary-key))]
    (join \space
          "DROP"
          (cond (instance? ColumnDefinition element) "COLUMN"
                (instance? ForeignKeyConstraintDefinition element) "FOREIGN KEY"
                (and is-unique (= (:ctype element) :unique)) "INDEX"
                is-pkey "PRIMARY KEY")
          (when-not is-pkey
            (as-identifier db-spec (:cname element))))))

(defmethod compile [:mysql AlterRenameAction]
  [action]
  (let [{:keys [db-spec element]} action
        old-name (:cname element)
        new-name (:others element)
        column (with-db-meta db-spec
                 (assoc (analyze-column (:sname element)
                                        (:tname element)
                                        old-name)
                   :cname new-name))]
    (join \space
          "CHANGE"
          (as-identifier db-spec old-name)
          (compile (build-definition column db-spec)))))

(ns lobos.backends.postgresql
  (:refer-clojure :exclude [compile defonce])
  (:require (lobos [schema :as schema]))
  (:use lobos.analyzer
        lobos.compiler
        lobos.utils)
  (:import (lobos.ast AlterRenameAction
                      ColumnDefinition
                      DataTypeClause)
           (lobos.schema DataType
                         Schema)))

(def ^{:private true} analyzer-data-type-aliases
  {:bool :boolean
   :bpchar :char
   :bytea :blob
   :float4 :real
   :float8 :double
   :int2 :smallint
   :int4 :integer
   :int8 :bigint
   :text :nclob
   :timestamptz :timestamp
   :timetz :time})

(defmethod analyze [:postgresql DataType]
  [_ column-meta]
  (let [dtype (-> column-meta :type_name as-keyword)
        options {:time-zone (#{:timetz :timestamptz} dtype)}
        dtype (first (replace analyzer-data-type-aliases
                              [dtype]))]
    (schema/data-type
     dtype
     (analyze-data-type-args dtype column-meta)
     options)))

(defmethod analyze [:postgresql Schema]
  [_ sname]
  (analyze [:lobos.analyzer/standard Schema] (or sname :public)))

(def ^{:private true} compiler-data-type-aliases
  {:blob :bytea
   :clob :text
   :double :double-precision
   :nclob :text
   :nvarchar :varchar})

(defmethod compile [:postgresql DataTypeClause]
  [expression]
  (let [{:keys [dtype args options]} expression
        {:keys [time-zone]} options
        dtype (first (replace compiler-data-type-aliases [dtype]))
        args (if (#{:bytea :text} dtype) [] args)]
    (unsupported (#{:binary :varbinary} dtype)
      "Use blob instead.")
    (join \space
      (str (as-sql-keyword dtype) (as-list args))
      (when time-zone "WITH TIME ZONE"))))

(defmethod compile [:postgresql ColumnDefinition]
  [definition]
  (let [{:keys [db-spec cname data-type default
                auto-inc not-null others]} definition]
    (apply join \space
      (as-identifier db-spec cname)
      (if auto-inc "SERIAL" (compile data-type))
      (when default (str "DEFAULT " (compile default)))
      (when not-null "NOT NULL")
      others)))

(defmethod compile [:postgresql AlterRenameAction]
  [action]
  (let [{:keys [db-spec element]} action
        old-name (:cname element)
        new-name (:others element)]
    (format "RENAME COLUMN %s TO %s"
            (as-identifier db-spec old-name)
            (as-identifier db-spec new-name))))

(ns lobos.backends.sqlite
  (:refer-clojure :exclude [compile defonce])
  (:require (lobos [schema :as schema]))
  (:use (lobos analyzer compiler connectivity internal metadata utils))
  (:import (lobos.ast AlterTableStatement
                      AutoIncClause
                      CreateSchemaStatement
                      CreateTableStatement
                      DataTypeClause
                      DropStatement
                      IdentifierExpression)
           (lobos.schema DataType
                         ForeignKeyConstraint
                         Schema
                         UniqueConstraint)))

(def ^{:private true} analyzer-data-type-aliases
  {:time-with-time-zone :time
   :timestamp-with-time-zone :timestamp})

(defmethod analyze [:sqlite DataType]
  [_ column-meta]
  (let [dtype (-> column-meta :type_name as-keyword)
        tz? #{:time-with-time-zone :timestamp-with-time-zone}
        [dtype options] (if (tz? dtype)
                          [dtype {:time-zone true}]
                          [dtype nil])
        dtype (first (replace analyzer-data-type-aliases [dtype]))
        args (analyze-data-type-args dtype column-meta)]
    (schema/data-type
     dtype
     (if (#{:decimal :numeric} dtype)
       [(first args)]
       args)
     options)))

(defmethod analyze [:sqlite UniqueConstraint]
  [_ sname tname cname index-meta]
  (let [columns (vec (map #(-> % :column_name keyword)
                          index-meta))]
    (UniqueConstraint.
     (make-index-name tname :unique columns)
     :unique
     columns)))

(defn- analyze-primary-keys [tname]
  (let [columns (reduce
                 #(conj %1 (-> %2 :column_name keyword))
                 []
                 (resultset-seq
                  (.getPrimaryKeys (db-meta) nil nil (name tname))))]
    (when (not-empty columns)
      [(UniqueConstraint.
        (make-index-name tname :primary-key columns)
        :primary-key
        columns)])))

(defn- analyze-foreign-keys [tname]
  (let [fks (group-by :id  (try
                             (raw-query (format "pragma foreign_key_list(%s);"
                                                (name tname)))
                             (catch Exception _)))]
    (for [fk fks]
      (let [fk (second fk)
            pcolumns (reduce #(conj %1 (-> %2 :to keyword)) [] fk)
            fcolumns (reduce #(conj %1 (-> %2 :from keyword)) [] fk)
            fk (first fk)
            ptable (keyword (:table fk))
            match (as-keyword (:match fk))
            match (when-not (= match :none) match)
            on-delete (as-keyword (:on_delete fk))
            on-delete (when-not (= on-delete :no-action) on-delete)
            on-delete (when on-delete [:on-delete on-delete])
            on-update (as-keyword (:on_update fk))
            on-update (when-not (= on-update :no-action) on-update)
            on-update (when on-delete [:on-update on-update])]
        (ForeignKeyConstraint.
         (make-index-name tname :fkey fcolumns)
         fcolumns
         ptable
         pcolumns
         match
         (into {} [on-delete on-update]))))))

(defn- analyze-unique [sname tname]
  (map (fn [[cname meta]] (analyze UniqueConstraint sname tname cname meta))
       (indexes-meta sname tname #(let [nu (:non_unique %)]
                                    (or (false? nu) (= nu 0))))))

(defmethod analyze [:sqlite :constraints]
  [_ sname tname]
  (concat (analyze-unique sname tname)
          (analyze-primary-keys tname)
          (analyze-foreign-keys tname)))

(defmethod analyze [:sqlite Schema]
  [_ sname]
  (let [db-spec (db-meta-spec)
        sname (or sname
                  (->> db-spec
                       :subname
                       (re-find #"^\./(.*)\.\w+$")
                       second))]
    (analyze [:lobos.analyzer/standard Schema] sname)))

(defmethod compile [:sqlite IdentifierExpression]
  [identifier]
  (as-str (:name identifier)))

(defmethod compile [:sqlite DataTypeClause]
  [expression]
  (let [{:keys [dtype args options]} expression
        {:keys [collate time-zone]} options]
    (unsupported (and (#{:decimal :numeric} dtype) (= (count args) 2))
      "Doesn't support scale argument.")
    (join \space
      (str (as-sql-keyword dtype) (as-list args))
      (when collate (str "COLLATE " (as-str collate)))
      (when time-zone "WITH TIME ZONE"))))

(defmethod compile [:sqlite AutoIncClause]
  [_]
  nil)

(defmethod compile [:sqlite CreateSchemaStatement]
  [statement]
  (let [{:keys [db-spec sname elements]} statement]
    (map compile elements)))

(defn- drop-schema [db-spec]
  (map (comp compile
             #(schema/build-drop-statement % :cascade db-spec)
             #(schema/table %)
             :name)
       (with-connection db-spec
         (raw-query
          (format "select name from sqlite_master where type <> 'index';")))))

(defmethod compile [:sqlite DropStatement]
  [statement]
  (let [{:keys [db-spec otype oname behavior]} statement]
    (if (= otype :schema)
      (drop-schema db-spec)
      (join \space
        "DROP"
        (as-sql-keyword otype)
        (as-identifier db-spec oname)))))

(defmethod compile [:sqlite AlterTableStatement]
  [statement]
  (unsupported "Alter statement unsupported."))

(ns lobos.backends.sqlserver
  (:refer-clojure :exclude [compile defonce])
  (:require clojure.string
            (lobos [schema :as schema]))
  (:use lobos.analyzer
        lobos.compiler
        lobos.metadata
        lobos.utils)
  (:import (lobos.ast AlterAddAction
                      AlterDropAction
                      AlterModifyAction
                      AlterRenameAction
                      AlterTableStatement
                      AutoIncClause
                      DataTypeClause
                      DropStatement
                      FunctionExpression
                      IdentifierExpression)
           (lobos.schema DataType
                         Expression
                         Schema)))

(defmethod analyze [:microsoft-sql-server Expression]
  [_ expr]
  (when expr
    (Expression.
     (cond (re-find #"^\(\((\d+)\)\)$" expr)
           (let [[[_ n]] (re-seq #"(\w+)(\(\))?" expr)]
             (Integer/parseInt n))))))

(def ^{:private true} analyzer-data-type-aliases
  {:bit :boolean
   :datetime2 :timestamp
   :image :blob
   :int :integer
   :ntext :nclob
   :text :clob})

(defmethod analyze [:microsoft-sql-server DataType]
  [_ column-meta]
  (let [dtype (-> column-meta :type_name as-keyword)
        [dtype options] (if (= dtype :datetimeoffset)
                          [:timestamp {:time-zone true}]
                          [dtype nil])
        dtype (first (replace analyzer-data-type-aliases
                              [dtype]))]
    (schema/data-type
     dtype
     (analyze-data-type-args dtype column-meta)
     options)))

(defmethod analyze [:microsoft-sql-server Schema]
  [_ sname]
  (analyze [:lobos.analyzer/standard Schema] (or sname :dbo)))

(defmethod compile [:sqlserver IdentifierExpression]
  [identifier]
  (let [{:keys [db-spec name qualifiers]} identifier]
    (join* \. (->> (concat qualifiers [name])
                   (filter identity)
                   (map #(when % (as-str \[ % \])))))))

(defmethod compile [:sqlserver FunctionExpression]
  [function]
  (let [{:keys [db-spec name args]} function
        name (if (= name :length)
               :len
               name)]
    (str (as-sql-keyword name)
         (as-list (map compile args)))))

(def ^{:private true} compiler-data-type-aliases
  {:blob      :image
   :boolean   :bit
   :clob      :text
   :double    :float
   :nclob     :ntext
   :timestamp :datetime2})

(defmethod compile [:sqlserver DataTypeClause]
  [expression]
  (let [{:keys [dtype args options]} expression
        {:keys [collate time-zone]} options
        dtype (if (and (= dtype :timestamp) time-zone)
                :datetimeoffset
                (first (replace compiler-data-type-aliases [dtype])))
        args (if (#{:image :ntext :text} dtype) [] args)]
    (unsupported (and (= dtype :time) time-zone)
      "Time zone unsupported for time data type.")
    (join \space
      (str (as-sql-keyword dtype) (as-list args))
      (when collate (str "COLLATE " (as-str collate))))))

(defmethod compile [:sqlserver AutoIncClause]
  [_]
  "IDENTITY")

(defn- drop-schema-cascade [db-spec sname]
  (vec (for [element (with-db-meta db-spec
                       (-> (analyze-schema sname) :elements keys))]
         (compile (schema/build-drop-statement
                   (schema/table element)
                   :cascade
                   (assoc db-spec :schema sname))))))

(defmethod compile [:sqlserver DropStatement]
  [statement]
  (let [{:keys [db-spec otype oname behavior options]} statement
        sql-string (join \space
                     "DROP"
                     (as-sql-keyword otype)
                     (as-identifier db-spec oname
                                    (when (not= otype :schema)
                                      (:schema db-spec))))]
    (if (= otype :index)
      (join \space
        "DROP INDEX"
        (as-identifier db-spec oname)
        "ON"
        (as-identifier db-spec (:tname options) (:schema db-spec)))
      (apply join \;
             (conj
              (when (and (= otype :schema)
                         (= behavior :cascade))
                (drop-schema-cascade db-spec oname))
              sql-string)))))

(defmethod compile [:sqlserver AlterModifyAction]
  [action]
  (let [{:keys [db-spec element]} action
        default (:default element)
        cname (when default
                (make-index-name (:tname element)
                                 "default"
                                 (list (:cname element))))]
    (cond (= default :drop)
          (join \space
                "DROP CONSTRAINT"
                (as-identifier db-spec cname))
          default
          (join \space
                "ADD CONSTRAINT"
                (as-identifier db-spec cname)
                "DEFAULT"
                (compile default)
                "FOR"
                (as-identifier db-spec (:cname element)))
          :else (unsupported "Only set/drop default supported."))))

(defmethod compile [:sqlserver AlterRenameAction]
  [action]
  (let [{:keys [db-spec element]} action]
    (format "EXEC sp_rename '%s', '%s', 'COLUMN';"
            (join \.
                  (as-identifier db-spec (:sname element))
                  (as-identifier db-spec (:tname element))
                  (as-identifier db-spec (:cname element)))
            (as-str (:others element)))))

(defmethod compile [:sqlserver AlterTableStatement]
  [statement]
  (let [{:keys [db-spec tname action element]} statement
        element (assoc element :sname (:schema db-spec) :tname tname)]
    (if (= action :rename)
      (compile (AlterRenameAction. db-spec element))
      (join \space
            "ALTER TABLE"
            (as-identifier db-spec tname (:schema db-spec))
            (case action
                  :add    (compile (AlterAddAction. db-spec element))
                  :drop   (compile (AlterDropAction. db-spec element))
                  :modify (compile (AlterModifyAction. db-spec element)))))))

(ns lobos.ast)

(defrecord Mode
  [db-spec])

(defrecord ScalarExpression
  [db-spec scalar])

(defrecord IdentifierExpression
  [db-spec name qualifiers])

(defrecord FunctionExpression
  [db-spec name args])

(defrecord OperatorExpression
  [db-spec op left right])

(defrecord AutoIncClause
  [db-spec])

(defrecord DataTypeClause
  [db-spec dtype args options])

(defrecord ColumnDefinition
  [db-spec cname data-type default auto-inc not-null others])

(defrecord ConstraintDefinition
  [db-spec cname])

(defrecord UniqueConstraintDefinition
  [db-spec cname ctype columns])

(defrecord ForeignKeyConstraintDefinition
  [db-spec cname columns parent-table parent-columns match triggered-actions])

(defrecord CheckConstraintDefinition
  [db-spec cname condition])

(defrecord CreateSchemaStatement
  [db-spec sname elements])

(defrecord CreateTableStatement
  [db-spec tname elements])

(defrecord CreateIndexStatement
  [db-spec iname tname columns options])

(defrecord DropStatement
  [db-spec otype oname behavior options])

(defrecord AlterTableStatement
  [db-spec tname action element])

(defrecord AlterAddAction
  [db-spec element])

(defrecord AlterDropAction
  [db-spec element])

(defrecord AlterModifyAction
  [db-spec element])

(defrecord AlterRenameAction
  [db-spec element])

(defn import-expressions
  []
  (import
   '(lobos.ast ScalarExpression
               IdentifierExpression
               FunctionExpression
               OperatorExpression)))

(defn import-clauses
  []
  (import
   '(lobos.ast AutoIncClause
               DataTypeClause)))

(defn import-definitions
  []
  (import
   '(lobos.ast ColumnDefinition
               ConstraintDefinition
               UniqueConstraintDefinition
               ForeignKeyConstraintDefinition
               CheckConstraintDefinition)))

(defn import-statements
  []
  (import
   '(lobos.ast CreateSchemaStatement
               CreateTableStatement
               CreateIndexStatement
               DropStatement
               AlterTableStatement)))

(defn import-actions
  []
  (import
   '(lobos.ast AlterAddAction
               AlterDropAction
               AlterModifyAction
               AlterRenameAction)))

(defn import-all
  []
  (import '(lobos.ast Mode))
  (import-expressions)
  (import-clauses)
  (import-definitions)
  (import-statements)
  (import-actions))