sql generation for sequelize-loaded tables with some level of auto-join discovery

sqlstuff.cljs

;; messy but potentially useful


;; UTIL
(defn wrap-quote [s]
  (str "\"" s "\""))

(defn wrap-single-quote [s]
  (str "'" s "'"))

(defn is-valid-fieldname-set? [maybe-fieldname-set]
  (and (vector? maybe-fieldname-set)
       (keyword? (first maybe-fieldname-set))
       (every? string?
               (rest maybe-fieldname-set))))

(defn derive-joins-for-sequelize-table [source-table]
  ;; for a given join, create bidirectional foreign key relationship definitions
  (let [sequelize-field-attributes-obj (-<>> source-table
                                             (path.join $MODEL-DIRECTORY)
                                             (.import sequelize)
                                             (aget <> "fieldRawAttributesMap"))]
    (->> (js/Object.keys sequelize-field-attributes-obj)
         (map (fn [col-name]
                (let [col-object (aget sequelize-field-attributes-obj col-name)]
                  (if-let [fk-spec (aget col-object "references")]
                    (let [target-table (aget fk-spec "model")
                          fk-name (aget fk-spec "key")]
                      [source-table
                       target-table
                       [(sql-keyword-fieldify source-table col-name)
                        (sql-keyword-fieldify target-table fk-name)]])))))
         (remove empty?)
         (reduce (fn [a path]
                   (-> a
                       (assoc-in (drop-last path)
                                 (last path))
                       (assoc-in (reverse (drop-last path))
                                 (-> (last path)
                                     (reverse)
                                     (vec)))))
                 {}))))

(def $tables
  (->> (.readdirSync fs $MODEL-DIRECTORY)
       (map (fn [fname]
              (clojure.string/replace fname #"\.js$" "")))
       ;; set explicitly?
       (concat
        ;; ["table_1"
        ;;  "table_2"
        ;;  ]
        )
       (map (fn [table-name]
              [table-name
               (load-sequelize-table-to-node-define table-name)]))
       
       (into {})))

(def $joins
  (->> (keys $tables)
       (map derive-joins-for-sequelize-table)
       (apply merge-with merge)))

(defn is-valid-table? [table-name]
  ($tables table-name))

(defn resolve-field
  [maybe-fieldnames]
  (cond (keyword? maybe-fieldnames)
        (-> maybe-fieldnames
            (name)
            (clojure.string/split ".")
            ((fn [[table-name table-field]]
               [(keyword table-name)
                table-field]))
            (resolve-field))

        (and (is-valid-fieldname-set? maybe-fieldnames))
        (let [table-name (name (first maybe-fieldnames))]
          (if-let [table ($tables table-name)]
            (loop [remain (rest maybe-fieldnames)
                   out []]
              (if (empty? remain)
                (->> out
                     (interpose ",")
                     (apply str))
                (recur (rest remain)
                       (conj out
                             (str
                              (wrap-quote table-name)
                              "."
                              (wrap-quote (first remain)))))))))
        
        :else
        (str "something else")))

(defn find-possible-join-paths
  "given source-table (str) target-table (str) names,
     find possible routes through the join definitions.
     return a vector of vectors, where each inner vector is a join path fashioned as:
     [:source_table.field_name :target_table.field_name]"
  ([source-table target-table]
   (find-possible-join-paths
    source-table target-table $tables $joins 3))
  ([source-table target-table table-definitions join-definitions max-depth]
   #_(println "FROM " source-table " TO " target-table " max-depth " max-depth)
   (let [find-joinable-target (fn find-joinable-target
                                ([source target]
                                 (find-joinable-target
                                  source target [] #{source}))
                                ([source target
                                  join-path visited-tables]
                                 (if (= max-depth (count join-path))
                                   nil ;; dead end for this join path
                                   (let [candidates (->> (get join-definitions source)
                                                         (remove
                                                          (fn [[k _]]
                                                            (visited-tables k))))
                                         matches (->> candidates
                                                      (filter (fn [[t _]]
                                                                (= t target))))]
                                     (if (empty? matches)
                                       (->> candidates
                                            (mapv (fn [[t field-pair]]
                                                    (find-joinable-target
                                                     t
                                                     target
                                                     (conj join-path field-pair)
                                                     (conj visited-tables source))))
                                            (apply concat))
                                       (->> matches
                                            (map (fn [[t field-pair]]
                                                   (conj join-path field-pair)))))))))]
     (find-joinable-target source-table target-table))))

(defn select-best-join-path-candidate
  "given a sequable of join-paths (i.e. [:source_table.field_name :target_table.field_name]),
  first sort and collection of join paths with the minimal hops,
  then sort by the tables that maximize use of tables within `requested-tables`"
  [join-path-candidates tables-requested]
  (comment
    (let [tables-requested ["table_1" "table_2" "table_3"]
          target-table "table_3"
          join-path-candidates (->> tables-requested
                                    (map (fn [source-table]
                                           (->> (find-possible-join-paths
                                                 source-table
                                                 target-table))))
                                    (remove empty?)
                                    (apply concat))
        
          ]
      (select-best-join-path-candidate
       join-path-candidates tables-requested)))
  (->> join-path-candidates
       (group-by count)
       (sort-by first)
       (first)
       (last)
       (sort-by
        (fn [join-path]
          (-<>> join-path
                (map (fn [tfields]
                       (map sql-keyword-fieldify tfields)))
                (flatten)
                (set)
                (map <> tables-requested)
                (count))))
       (first)))

(defn render-join-statement-from-tables
  [tables-requested & [preferred-tables]]
  (comment
    (let [tables-requested ["table_1"
                            "table_2"
                            "table_3"
                            ]]
      (->> (render-join-statement-from-tables
            tables-requested)
           (println))))
  (let [join-paths
        (loop [remain (rest tables-requested)
               source-table (first tables-requested)
               visited-pairs #{} ;; prevent cycles
               out-join-paths []]
          (if (empty? remain)
            out-join-paths
            (let [target-table (first remain)
                  best-candidate-join-path (-> (find-possible-join-paths
                                                source-table
                                                target-table)
                                               (select-best-join-path-candidate
                                                (concat tables-requested
                                                        preferred-tables)))
                  ;; look from within the already-used tables
                  ;; to see if there is also a direct join possible
                  alternative-join-paths (->> visited-pairs
                                              (apply concat)
                                              (set)
                                              (map (fn [src]
                                                     (find-possible-join-paths src target-table)))
                                              (remove empty?)
                                              (map (fn [candidates]
                                                     (select-best-join-path-candidate
                                                      candidates
                                                      (concat tables-requested
                                                              preferred-tables)))))

                  best-alternative-join-path (->> alternative-join-paths
                                                  (group-by count)
                                                  (sort-by first)
                                                  (first)
                                                  (last)
                                                  (first))

                  best-join-path (if (< 0
                                        (count best-alternative-join-path)
                                        (count best-candidate-join-path))
                                   best-alternative-join-path
                                   best-candidate-join-path)]
              (recur (rest remain)
                     target-table
                     (->> best-join-path
                          (map (fn [join-pair]
                                 (let [table-pair (map sql-keyword-to-table join-pair)]
                                   [table-pair
                                    (reverse table-pair)])))
                          (apply concat)
                          (apply conj visited-pairs))
                     (->> best-join-path
                          (remove (fn [join-pair]
                                    (->> join-pair
                                         (map sql-keyword-to-table)
                                         (visited-pairs))))
                          (concat out-join-paths))))))]
    (loop [remain join-paths
           visited #{(->> remain
                          (first)
                          (first)
                          (sql-keyword-to-table))}
           out []]
      (if (empty? remain)
        (->> out
             (map (fn [[l r]]
                    (str "\nJOIN "
                         (sql-keyword-to-table r)
                         " ON "
                         (sql-string-fieldify l)
                         " = "
                         (sql-string-fieldify r))))
             (apply str "FROM " (->> join-paths
                                     (first)
                                     (first)
                                     (sql-keyword-to-table))))
        (let [join-path (first remain)
              target-table-name (sql-keyword-to-table
                                 (last join-path))]
          (recur (rest remain)
                 (conj visited target-table-name)
                 (if (visited target-table-name)
                   out
                   (conj out join-path))))))))

(defn build-sql
  [& {:keys [select where order-by limit]}]
  (let [build-select (fn [selector-groups & [additional-tables]]
                       (loop [groups-remain selector-groups
                              groups-out []
                              tables-requested []]
                         (if (empty? groups-remain)
                           (do
                             (let [join-statement (render-join-statement-from-tables
                                                   ;; dedupe
                                                   (loop [t-remain tables-requested
                                                          to-skip #{}
                                                          order-out []]
                                                     (if (empty? t-remain)
                                                       (concat order-out
                                                               additional-tables)
                                                       (let [t-name (first t-remain)]
                                                         (recur (rest t-remain)
                                                                (conj to-skip t-name)
                                                                (if (to-skip t-name)
                                                                  order-out
                                                                  (conj order-out t-name)))))))]
                               (str "SELECT "
                                    (->> groups-out
                                         (interpose ",\n       ")
                                         (apply str))
                                    "\n"
                                    join-statement)))
                           (let [selector-group (first groups-remain)
                                 table-name (-> selector-group
                                                (first)
                                                (name))
                                 table-fields (rest selector-group)
                                 selection-string
                                 (loop [fields-remain table-fields
                                        fields-out []]
                                   (if (empty? fields-remain)
                                     (->> fields-out
                                          (interpose ", ")
                                          (apply str))
                                     (let [maybe-field-name (first fields-remain)]
                                       (if (and (keyword? maybe-field-name)
                                                (= :as maybe-field-name))
                                         (recur (drop 2 fields-remain)
                                                (conj (vec (drop-last fields-out))
                                                      (str (last fields-out)
                                                           " AS "
                                                           (->> fields-remain
                                                                (drop 1)
                                                                (first)
                                                                (wrap-quote)))))
                                         (recur (rest fields-remain)
                                                (conj fields-out
                                                      (str (wrap-quote table-name)
                                                           "."
                                                           (wrap-quote maybe-field-name))))))))]
                             (recur (rest groups-remain)
                                    (conj groups-out selection-string)
                                    (conj tables-requested
                                          table-name))))))
        
        build-where (fn [conditions]
                      (loop [remain conditions
                             out []]
                        (if (empty? remain)
                          (->> out
                               (interpose "\n  AND ")
                               (apply str)
                               (str "WHERE "))
                          (let [condition (first remain)
                                field-string (resolve-field (first condition))]
                            (recur (rest remain)
                                   (conj out (str field-string " "
                                                  (->> (rest condition)
                                                       (interpose " ")
                                                       (apply str)))))))))
        
        build-order-by (fn [order-field & [monotonicity]]
                         (str "ORDER BY "
                              (resolve-field order-field)
                              " "
                              (or monotonicity
                                  "ASC")))]
    (->> [(build-select select
                        (->> where
                             (map first)
                             (map sql-keyword-to-table)))
          (build-where where)
          (apply build-order-by order-by)
          (str "LIMIT " limit)]
         (interpose "\n")
         (apply str))))