(ns ^{:doc "A parser for SQL: generate HUGSQL queries file." :author "Simon Brooke"} squirrel-parse.to-hugsql-queries (:require [clojure.java.io :refer [file]] [clojure.math.combinatorics :refer [combinations]] [clojure.string :as s] [clj-time.core :as t] [clj-time.format :as f] [squirrel-parse.to-adl :refer [migrations-to-xml]] [squirrel-parse.utils :refer [is-link-table? singularise]])) (defn key-names [entity-map] (remove nil? (map #(:name (:attrs %)) (vals (:content (:key (:content entity-map))))))) (defn has-primary-key? [entity-map] (> (count (key-names entity-map)) 0)) (defn has-non-key-properties? [entity-map] (> (count (vals (:properties (:content entity-map)))) (count (key-names entity-map)))) (defn where-clause [entity-map] (let [entity-name (:name (:attrs entity-map))] (str "WHERE " entity-name "." (s/join (str " AND\n\t" entity-name ".") (map #(str % " = " (keyword %)) (key-names entity-map)))))) (defn order-by-clause [entity-map] (let [entity-name (:name (:attrs entity-map)) preferred (map #(:name (:attrs %)) (filter #(= (-> % :attrs :distinct) "user") (-> entity-map :content :properties vals)))] (str "ORDER BY " entity-name "." (s/join (str ",\n\t" entity-name ".") (doall (flatten (cons preferred (key-names entity-map)))))))) (defn insert-query [entity-map] (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) all-property-names (map #(:name (:attrs %)) (vals (:properties (:content entity-map)))) query-name (str "create-" pretty-name "!") signature " :! :n"] (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :insert-1 :query (str "-- :name " query-name " " signature "\n" "-- :doc creates a new " pretty-name " record\n" "INSERT INTO " entity-name " (" (s/join ",\n\t" all-property-names) ")\nVALUES (" (s/join ",\n\t" (map keyword all-property-names)) ")" (if (has-primary-key? entity-map) (str "\nreturning " (s/join ",\n\t" (key-names entity-map)))) "\n\n")}))) (defn update-query [entity-map] (if (and (has-primary-key? entity-map) (has-non-key-properties? entity-map)) (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) property-names (remove nil? (map #(if (= (:tag %) :property) (:name (:attrs %))) (vals (:properties (:content entity-map))))) query-name (str "update-" pretty-name "!") signature ":! :n"] (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :update-1 :query (str "-- :name " query-name " " signature "\n" "-- :doc updates an existing " pretty-name " record\n" "UPDATE " entity-name "\n" "SET " (s/join ",\n\t" (map #(str % " = " (keyword %)) property-names)) "\n" (where-clause entity-map) "\n\n")})) {})) (defn search-query [entity-map] (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) query-name (str "search-strings-" pretty-name) signature ":? :1" string-fields (filter #(= (-> % :attrs :type) "string") (-> entity-map :content :properties vals))] (if (empty? string-fields) {} (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :text-search :query (str "-- :name " query-name " " signature "\n" "-- :doc selects existing " entity-name " records having any string field matching `:pattern` by substring match\n" "SELECT * FROM " entity-name "\n" "WHERE " (s/join "\n\tOR " (map #(str (-> % :attrs :name) " LIKE '%:pattern%'") string-fields)) "\n" (order-by-clause entity-map) "\n" "--~ (if (:offset params) \"OFFSET :offset \") \n" "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")" "\n\n")})))) (defn select-query [entity-map] (if (has-primary-key? entity-map) (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) query-name (str "get-" pretty-name) signature ":? :1"] (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :select-1 :query (str "-- :name " query-name " " signature "\n" "-- :doc selects an existing " pretty-name " record\n" "SELECT * FROM " entity-name "\n" (where-clause entity-map) "\n" (order-by-clause entity-map) "\n\n")})) {})) (defn list-query "Generate a query to list records in the table represented by this `entity-map`. Parameters `:limit` and `:offset` may be supplied. If not present limit defaults to 100 and offset to 0." [entity-map] (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) query-name (str "list-" entity-name) signature ":? :*"] (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :select-many :query (str "-- :name " query-name " " signature "\n" "-- :doc lists all existing " pretty-name " records\n" "SELECT * FROM " entity-name "\n" (order-by-clause entity-map) "\n" "--~ (if (:offset params) \"OFFSET :offset \") \n" "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")" "\n\n")}))) (defn foreign-queries [entity-map entities-map] (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))] (apply merge (map #(let [far-name (-> % :attrs :entity) far-entity ((keyword far-name) entities-map) pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "") farkey (-> % :attrs :farkey) link-field (-> % :attrs :name) query-name (str "list-" entity-name "-by-" pretty-far) signature ":? :*"] (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :select-one-to-many :far-entity far-entity :query (str "-- :name " query-name " " signature "\n" "-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n" "SELECT * \nFROM " entity-name "\n" "WHERE " entity-name "." link-field " = :id\n" (order-by-clause entity-map) "\n\n")})) links)))) (defn link-table-query [near link far] (let [properties (-> link :content :properties vals) links (apply merge (map #(hash-map (keyword (-> % :attrs :entity)) %) (filter #(-> % :attrs :entity) properties))) near-name (-> near :attrs :name) link-name (-> link :attrs :name) far-name (-> far :attrs :name) pretty-far (singularise far-name) query-name (str "list-" link-name "-" near-name "-by-" pretty-far) signature ":? :*"] (hash-map (keyword query-name) {:name query-name :signature signature :entity link :type :select-many-to-many :near-entity near :far-entity far :query (str "-- :name " query-name " " signature " \n" "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n" "SELECT "near-name ".*\n" "FROM " near-name ", " link-name "\n" "WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t" "AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n" (order-by-clause near) "\n\n")}))) (defn link-table-queries [entity-map entities-map] (let [entities (map #((keyword %) entities-map) (remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals)))) pairs (combinations entities 2)] (apply merge (map #(merge (link-table-query (nth % 0) entity-map (nth % 1)) (link-table-query (nth % 1) entity-map (nth % 0))) pairs)))) (defn delete-query [entity-map] (if (has-primary-key? entity-map) (let [entity-name (:name (:attrs entity-map)) pretty-name (singularise entity-name) query-name (str "delete-" pretty-name "!") signature ":! :n"] (hash-map (keyword query-name) {:name query-name :signature signature :entity entity-map :type :delete-1 :query (str "-- :name " query-name " " signature "\n" "-- :doc updates an existing " pretty-name " record\n" "DELETE FROM " entity-name "\n" (where-clause entity-map) "\n\n")})))) (defn queries [entity-map entities-map] (merge {} (insert-query entity-map) (update-query entity-map) (delete-query entity-map) (if (is-link-table? entity-map) (link-table-queries entity-map entities-map) (merge (select-query entity-map) (list-query entity-map) (search-query entity-map) (foreign-queries entity-map entities-map))))) (defn migrations-to-queries-sql ([migrations-path] (migrations-to-queries-sql migrations-path "queries.auto.sql")) ([migrations-path output] (let [adl-struct (migrations-to-xml migrations-path "Ignored") file-content (apply str (cons (str "-- " output " autogenerated by \n-- [squirrel-parse](https://github.com/simon-brooke/squirrel-parse)\n-- at " (f/unparse (f/formatters :basic-date-time) (t/now)) "\n\n") (doall (map #(:query %) (sort #(compare (:name %1) (:name %2)) (vals (apply merge (map #(queries % adl-struct) (vals adl-struct)))))))))] (spit output file-content) file-content)))