format.cljc

(ns ^{:doc "Extension of the honeysql format functions specifically for postgreSQL"}
 honeysql-postgres.format
  (:require [clojure.string :as string]
            [honeysql.format :as sqlf :refer [fn-handler format-clause format-modifiers]] ;; multi-methods
            [honeysql-postgres.util :as util]))

(def ^:private custom-additions
  {:create-table 10
   :drop-table 10
   :create-extension 10
   :drop-extension 10
   :alter-table 20
   :add-column 30
   :drop-column 40
   :create-view 40
   :filter 55
   :within-group 55
   :over 55
   :insert-into-as 60
   :with-columns 70
   :constraints 75
   :partition-by 165
   :window 195
   :upsert 225
   :on-conflict 230
   :on-conflict-constraint 230
   :do-update-set 235
   :do-update-set! 235
   :do-nothing 235
   :returning 240})

(def ^:private postgres-clause-priorities
  "Determines the order that clauses will be placed within generated SQL"
  (merge {:explain 20
          :with 30
          :with-recursive 40
          :except 45
          :except-all 45
          :select 50
          :insert-into 60
          :update 70
          :delete-from 80
          :columns 90
          :set 100
          :from 110
          :join 120
          :left-join 130
          :right-join 140
          :full-join 150
          :where 160
          :group-by 170
          :having 180
          :order-by 190
          :limit 200
          :offset 210
          :lock 215
          :values 220
          :query-values 221}
         custom-additions))

(defn override-default-clause-priority
  "Override the default cluse priority set by honeysql"
  []
  (doseq [[k v] postgres-clause-priorities]
    (sqlf/register-clause! k v)))

(defmethod fn-handler "not" [_ value]
  (str "NOT " (sqlf/to-sql value)))

(defmethod fn-handler "primary-key" [_ & args]
  (str "PRIMARY KEY" (util/comma-join-args args)))

(defmethod fn-handler "unique" [_ & args]
  (str "UNIQUE" (util/comma-join-args args)))

(defmethod fn-handler "foreign-key" [_ & args]
  (str "FOREIGN KEY" (util/comma-join-args args)))

(defmethod fn-handler "references" [_ reftable refcolumn]
  (str "REFERENCES " (sqlf/to-sql reftable) (sqlf/paren-wrap (sqlf/to-sql refcolumn))))

(defmethod fn-handler "constraint" [_ name]
  (str "CONSTRAINT " (sqlf/to-sql name)))

(defmethod fn-handler "default" [_ value]
  (str "DEFAULT " (sqlf/to-sql value)))

(defmethod fn-handler "nextval" [_ value]
  (str "nextval('" (sqlf/to-sql value) "')"))

(defmethod fn-handler "check" [_ & args]
  (let [preds (sqlf/format-predicate* (util/prep-check args))
        pred-string (if (= 1 (count args))
                      (sqlf/paren-wrap preds)
                      preds)]
    (str "CHECK" pred-string)))

(defmethod fn-handler "ilike" [_ field value]
  (str (sqlf/to-sql field) " ILIKE "
       (sqlf/to-sql value)))

(defmethod fn-handler "not-ilike" [_ field value]
  (str (sqlf/to-sql field) " NOT ILIKE "
       (sqlf/to-sql value)))

;; format-clause multimethods used to format various sql clauses as defined

(defmethod format-clause :on-conflict-constraint [[_ k] _]
  (str "ON CONFLICT ON CONSTRAINT " (-> k
                                        util/get-first
                                        sqlf/to-sql)))

(defmethod format-clause :on-conflict [[_ ids] _]
  (str "ON CONFLICT " (util/comma-join-args ids)))

(defmethod format-clause :do-nothing [_ _]
  "DO NOTHING")

(defmethod format-clause :do-update-set! [[_ values] _]
  (str "DO UPDATE SET " (sqlf/comma-join (for [[k v] values]
                                           (str (sqlf/to-sql k) " = " (sqlf/to-sql v))))))

(defmethod format-clause :filter [[_ expr] sql-map]
  (let [format (fn [expr]
                 (let [[expression clause alias] (mapv sqlf/to-sql expr)]
                   (->> alias
                        (str " AS ")
                        (when alias)
                        (str expression " FILTER " clause))))]
    (->> expr
         (map format)
         sqlf/comma-join
         (str (when (seq (:select sql-map)) ", ")))))

(defmethod format-clause :do-update-set [[_ values] _]
  (let [fields (or (:fields values) values)
        where  (:where values)]
    (str "DO UPDATE SET "
         (sqlf/comma-join (map #(str (sqlf/to-sql %) " = EXCLUDED." (sqlf/to-sql %)) fields))
         (when where
           (str " WHERE " (sqlf/format-predicate* where))))))

(defn- format-upsert-clause [upsert]
  (map #(format-clause % (find upsert %)) upsert))

(defmethod format-clause :upsert [[_ upsert] _]
  (sqlf/space-join (format-upsert-clause upsert)))

(defmethod format-clause :returning [[_ fields] _]
  (->> (flatten fields)
       (map sqlf/to-sql)
       (sqlf/comma-join)
       (str "RETURNING ")))

(defmethod format-clause :create-view [[_ viewname] _]
  (str "CREATE VIEW " (-> viewname
                          util/get-first
                          sqlf/to-sql) " AS"))

(defmethod format-clause :create-table [[_ [tablename if-not-exists]] _]
  (str "CREATE TABLE "
       (when if-not-exists "IF NOT EXISTS ")
       (-> tablename
           util/get-first
           sqlf/to-sql)))

(def ^:private constraints-format-map
  {:primary-key "PRIMARY KEY"
   :unique      "UNIQUE"})

(defn- format-constraint-clause
  [[constraint-type constraint-args]]
  (when (contains? constraints-format-map constraint-type)
    (str (get constraints-format-map constraint-type)
         (sqlf/paren-wrap (->> constraint-args
                               (map sqlf/to-sql)
                               sqlf/comma-join)))))

(defn- format-columns-clause
  [columns]
  (->> columns
       util/get-first
       (map #(sqlf/space-join (map sqlf/to-sql %)))
       sqlf/comma-join))

(defmethod format-clause :with-columns [[_ columns] complete-sql-map]
  (when-not (seq (:constraints complete-sql-map))
    (sqlf/paren-wrap (format-columns-clause columns))))

(defmethod format-clause :constraints [[_ [constraints]] complete-sql-map]
  (let [columns (:with-columns complete-sql-map)
        constraints (filter (fn [[constraint-type _]]
                              (contains? constraints-format-map constraint-type)) constraints)]
    (sqlf/paren-wrap
     (str (when (seq columns)
            (format-columns-clause columns))
          (when (seq constraints)
            (str ", "
                 (sqlf/comma-join (map format-constraint-clause constraints))))))))

(defmethod format-clause :drop-table [[_ params] _]
  (let [[if-exists & others] params
        tables (if-not (= :if-exists if-exists)
                 params
                 others)]
    (str "DROP TABLE "
         (when (= :if-exists if-exists) "IF EXISTS ")
         (->> tables
              (map sqlf/to-sql)
              sqlf/comma-join))))

(defn- format-over-clause [exp]
  (str
   (-> exp first sqlf/to-sql)
   " OVER "
   (-> exp second sqlf/to-sql)
   (when-let [alias (-> exp rest second)]
     (str " AS " (sqlf/to-sql alias)))))

(defmethod format-clause :over [[_ fields] complete-sql-map]
  (str
   ;; if the select clause has any columns in it then add a comma before the
   ;; window functions
   (when (seq (:select complete-sql-map)) ", ")
   (->> fields
        (map format-over-clause)
        sqlf/comma-join)))

(defmethod format-clause :window [[_ [window-name fields]] _]
  (str "WINDOW " (sqlf/to-sql window-name) " AS " (sqlf/to-sql fields)))

(defmethod format-clause :partition-by [[_ fields] _]
  (str "PARTITION BY " (->> fields
                            (map sqlf/to-sql)
                            sqlf/comma-join)))

(defmethod format-clause :alter-table [[_ tablename] _]
  (str "ALTER TABLE " (-> tablename
                          util/get-first
                          sqlf/to-sql)))

(defmethod format-clause :add-column [[_ fields] _]
  (str "ADD COLUMN " (->> fields
                          (map sqlf/to-sql)
                          sqlf/space-join)))

(defmethod format-clause :drop-column [[_ fields] _]
  (str "DROP COLUMN " (->> fields
                           util/get-first
                           sqlf/to-sql)))

(defmethod format-clause :rename-column [[_ [oldname newname]] _]
  (str "RENAME COLUMN " (sqlf/to-sql oldname) " TO " (sqlf/to-sql newname)))

(defmethod format-clause :rename-table [[_ newname] _]
  (str "RENAME TO " (-> newname
                        util/get-first
                        sqlf/to-sql)))

(defmethod format-clause :insert-into-as [[_ [table-name table-alias]] _]
  (str  "INSERT INTO " (sqlf/to-sql table-name) " AS " (sqlf/to-sql table-alias)))

(defmethod format-clause :except [[_ maps] _]
  (binding [sqlf/*subquery?* false]
    (string/join " EXCEPT " (map sqlf/to-sql maps))))

(defmethod format-clause :except-all [[_ maps] _]
  (binding [sqlf/*subquery?* false]
    (string/join " EXCEPT ALL " (map sqlf/to-sql maps))))

(defmethod format-clause :within-group [[_ expr] m]
  (let [format (fn [expr]
                 (let [[expression clause alias] (map sqlf/to-sql expr)]
                   (->> alias
                        (str " AS ")
                        (when alias)
                        (str expression " WITHIN GROUP " clause))))]
    (-> m
        :select
        seq
        (when ", ")
        (str (sqlf/comma-join (map format expr))))))

(override-default-clause-priority)

(defmethod format-modifiers :distinct-on [[_ & fields]]
  (str "DISTINCT ON(" (sqlf/comma-join (map sqlf/to-sql fields)) ")"))

(defmethod sqlf/format-clause :drop-extension [[_ [extension-name]] _]
  (str "DROP EXTENSION "
       (-> extension-name
           util/get-first
           sqlf/to-sql)))

(defmethod format-clause :create-extension [[_ [extension-name if-not-exists]] _]
  (str "CREATE EXTENSION "
       (when if-not-exists "IF NOT EXISTS ")
       (-> extension-name
           util/get-first
           sqlf/to-sql)))

(def ^:private explain-params->string
  {:costs "COSTS"
   :settings "SETTINGS"
   :buffers "BUFFERS"
   :wal "WAL"
   :timing "TIMING"
   :summary "SUMMARY"})

(def ^:private explain-format->string
  {:text "TEXT"
   :xml "XML"
   :json "JSON"
   :yaml "YAML"})

(defn- ->explain-boolean-param-string [param value]
  (when-let [param-string (explain-params->string param)]
    (sqlf/paren-wrap
     (sqlf/space-join [param-string (if (true? value) "TRUE" "FALSE")]))))

(defmethod format-clause :explain [[_ [params]] _]
  (if (empty? params)
    "EXPLAIN"
    (sqlf/space-join
     (remove nil?
             (concat ["EXPLAIN"
                      (when (:analyze params) "ANALYZE")
                      (when (:verbose params) "VERBOSE")
                      (when-let [format-type (:format params)]
                        (sqlf/paren-wrap (str "FORMAT" " " (explain-format->string format-type))))]
                     (map (partial apply ->explain-boolean-param-string) params))))))