simple `q` and `transact!` for postgres for people that know what they're doing and just want help with super simple CRUD

postgres-functions.clj

(defn q
  "Queries a database by asking for a vector of namespaced keywords. Namespace = table, name = column. Snake/Kebab-cases where appropriate. Allows simple join maps, with the foreign key coming first. Allows :where, which is either a string, or a sql-vector for parameterized values [sql-expression val1 val2...], and :order-by which is a simple string, and :limit which takes an integer.

  Example:

  (q *db* [:customers/name :customers/address :invoice/id :invoice/date]
  {:joins {:invoice/customerid :customers/id}
  :where [\"customers.name like ? \" \"Max\"]
  :order-by \"invoicd.date desc\"
  :limit 2})

  ;;; Intermediate query
  SELECT
    customers.name as customers$name,
    customers.address as customers$address,
    invoice.id as invoice$id,
    invoice.date as invoice$date
  FROM customers
  JOIN invoice ON invoice.customerid = customers.id
  WHERE customers.name like 'Max'
  ORDER BY invoice.date desc
  LIMIT 2;

  ;;; Result
  [{:customers/name \"Maximilian\"
  :customers/address \"1234 Main Str\"
  :invoice/id 3
  :invoice/date #inst \"2018-12-12\"}
  {:customers/name \"Maximilian\"
  :customers/address \"1234 Main Str\"
  :invoice/id 2
  :invoice/date #inst \"2018-10-10\"}] "

  ([db select {:keys [where joins order-by limit debug?] :as opts}]
   (let [kebab-case       #(-> % name (clojure.string/replace #"_" "-"))
         snake-case       #(-> % name  (clojure.string/replace #"-" "_"))
         map-keys         (fn [f m]
                            (into {} (map (fn [[key value]]
                                            [(f key) value])
                                          m)))
         colify           (fn colify*
                            ([kw sep]
                             (str ((comp snake-case namespace) kw) sep ((comp snake-case name) kw)))
                            ([kw]
                             (colify* kw ".")))
         tables           (into #{} (map (comp snake-case namespace) select))
         rename-table-key (fn [key]
                            (str (colify key ".") " as " (colify key "$")))
         sql-keys         (map rename-table-key select)
         columns          (str/join ",\n  " sql-keys)
         from-tables      (first tables)
         join-fn          (fn [[join1 join2]]
                            (let [table (-> join1 namespace snake-case)]
                              (str "JOIN " table " ON " (colify join1) " = " (colify join2))))
         join-clauses     (str/join "\n" (map join-fn (seq joins)))
         where-str        (cond
                            (string? where) (str "\n WHERE " where)        ; no parameterized values
                            (coll? where)   (str "\nWHERE " (first where)) ; parameterized values
                            :else           "")
         where-vals       (when (coll? where)
                            (rest where))
         order-by-str     (if order-by (str "\nORDER BY " order-by) "")
         limit-str        (if limit (str "\nLIMIT " limit) "")
         sql-str          (format "SELECT \n  %s\n FROM %s\n%s %s %s %s;" columns from-tables join-clauses where-str order-by-str limit-str)
         sql-vec          (into [] (concat [sql-str] where-vals))
         row-fn           (fn [row] (map-keys (fn [key]
                                               (let [[table kw] (str/split key #"\$")]
                                                 (keyword (kebab-case table) (kebab-case kw))))
                                             row))]

     (and debug? (println sql-str))

     (let [result (jdbc/query db sql-vec {:row-fn row-fn :keywordize? false :return-keys [:id]})]
       (case (count result)
         0 nil
         1 (first result)
         result))))

  ([db select]
   (q db select {})))


(def transact!
  "Upserts (and plain updates where appropriate!) fields in a postgres DB.

  Example:
  (transact! *db* #:uses{:customer-id \"test\" :event \"hello world\" :appointment-id 5})
  "
  (let [unique-cols-cache (atom {})]
    (fn
      ([db m {:keys [debug?] :as opts}]
       (assert (every? qualified-keyword? (keys m)) "You must qualify all keys")
       (let [kebab-case            #(-> % name (clojure.string/replace #"_" "-"))
             snake-case            #(-> % name  (clojure.string/replace #"-" "_"))
             map-keys              (fn [f m]
                                     (into {} (map (fn [[key value]]
                                                     [(f key) value])
                                                   m)))
             cols                  (map (fn [k] (-> k name snake-case)) (keys m))
             cols-str              (str/join ", " cols)
             vals                  (vals m)
             excluded-strs         (str/join ",\n  " (map (fn [c] (format "%s = excluded.%s" c c)) cols))
             placeholders          (str/join ", " (repeat (count vals) "?"))
             tables                (into #{} (map (comp snake-case namespace) (keys m)))
             table                 (first tables)
             conflict-cols-sql-vec ["SELECT DISTINCT a.attname AS unique_columns
                                FROM   pg_class t,
                                      pg_class i,
                                      pg_index ix,
                                      pg_attribute a
                                WHERE  t.oid = ix.indrelid
                                      AND i.oid = ix.indexrelid
                                      AND a.attrelid = t.oid
                                      AND a.attnum = ANY ( ix.indkey )
                                      AND t.relkind = 'r'
                                      AND t.relname = ?;" table]
             conflict-cols         (if-let [res (get @unique-cols-cache table)]
                                     res
                                     (let [res (jdbc/query db conflict-cols-sql-vec {:row-fn :unique_columns})]
                                       (swap! unique-cols-cache assoc table res)
                                       res))
             conflict-cols-str     (str/join ", " conflict-cols)
             conflict-clause       (when conflict-cols-str
                                     (format "ON CONFLICT (%s) DO UPDATE \n SET \n %s" conflict-cols-str excluded-strs))
             sql-str               (format "INSERT INTO %s (%s) VALUES (%s) \n %s \n RETURNING *;" table cols-str placeholders conflict-clause)
             sql-vec               (into [] (concat [sql-str] vals))
             row-fn                (partial map-keys #(keyword (kebab-case table) (kebab-case %)))]

         (assert (= 1 (count tables)) "You can only transact into one table at a time")

         (and debug? (println (first sql-vec) "\n" (str (rest sql-vec))))

         (try
           (first (jdbc/query db sql-vec {:row-fn row-fn}))
           (catch org.postgresql.util.PSQLException e ; postgres will not upsert if non-null fields are missing, even if it's technically an update
             (and debug? (println "Failed, updating instead: "))

             (let [update-col     (first conflict-cols)
                   update-col-kw  (keyword (kebab-case table) (kebab-case update-col))
                   update-sets    (str/join "  ,\n" (map (fn [col ] (str col " = ?")) cols))
                   update-where   (get m update-col-kw)
                   update-clause  (format "UPDATE %s\n SET\n %s\n WHERE %s = ?\n RETURNING *;" table update-sets update-col update-where)
                   update-sql-vec (into [] (concat [update-clause] vals [update-where]))]

               (and debug? (println update-clause "\n" (str(rest update-sql-vec))))

               (let [res (first (jdbc/query db update-sql-vec))]
                 (if (nil? res)
                   (throw (ex-info (str "Could not upsert record. This happens if the unique fields don't yet exist, but not all NOT NULL constraints are satisfied!" )
                                   {:transact-map      m
                                    :insert-sql-vector sql-vec
                                    :update-sql-vector update-sql-vec
                                    :unique-cols-cache @unique-cols-cache}))
                   res)))))))
      ([db m]
       (transact! db m {})))))