From f22781edf3d62ed1175c7448c99fcc106bb58fe0 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 16 Mar 2018 16:21:29 +0000 Subject: [PATCH] Now generating useful hugsql queries for link tables. --- project.clj | 1 + src/squirrel_parse/to_adl.clj | 3 +- src/squirrel_parse/to_hugsql_queries.clj | 117 +++++++++++++++++++++-- src/squirrel_parse/utils.clj | 24 ++--- 4 files changed, 123 insertions(+), 22 deletions(-) diff --git a/project.clj b/project.clj index 8e9329a..8479349 100644 --- a/project.clj +++ b/project.clj @@ -4,5 +4,6 @@ :license {:name "GNU General Public License,version 2.0 or (at your option) any later version" :url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"} :dependencies [[org.clojure/clojure "1.8.0"] + [org.clojure/math.combinatorics "0.1.4"] [clj-time "0.14.2"] [instaparse "1.4.8"]]) diff --git a/src/squirrel_parse/to_adl.clj b/src/squirrel_parse/to_adl.clj index c3ca709..937cc91 100644 --- a/src/squirrel_parse/to_adl.clj +++ b/src/squirrel_parse/to_adl.clj @@ -222,12 +222,13 @@ (map #(apply function (list entity-map %)) statements)))) +;; TODO: link tables are not entities, and should be removed from the entities map. ;; (defn fixup-many-to-many ;; [entities-map] ;; (let [entities (filter #(not (is-link-table? %)) (vals entities-map)) ;; link-tables (filter is-link-table? (vals entities-map))] -;; (reduce #() entities-map))) +;; (reduce #() entities-map link-tables))) (defn table-definitions-to-entities diff --git a/src/squirrel_parse/to_hugsql_queries.clj b/src/squirrel_parse/to_hugsql_queries.clj index d82bd94..9518016 100644 --- a/src/squirrel_parse/to_hugsql_queries.clj +++ b/src/squirrel_parse/to_hugsql_queries.clj @@ -2,8 +2,10 @@ :author "Simon Brooke"} squirrel-parse.to-hugsql-queries (:require [clojure.java.io :refer [file]] + [clojure.math.combinatorics :refer [combinations]] [clojure.string :as s] - [squirrel-parse.to-adl :refer [migrations-to-xml]])) + [squirrel-parse.to-adl :refer [migrations-to-xml]] + [squirrel-parse.utils :refer [is-link-table? singularise]])) (defn key-names [entity-map] @@ -25,9 +27,27 @@ (defn where-clause [entity-map] - (str - "WHERE " - (s/join " AND\n\t" (map #(str % " = " (keyword %)) (key-names 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] @@ -76,12 +96,83 @@ (let [entity-name (:name (:attrs entity-map)) pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")] (str "-- :name get-" pretty-name " :? :1\n" - "-- :doc updates an existing " pretty-name " record\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 [entity-map] + (let [entity-name (:name (:attrs entity-map)) + pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")] + (str "-- :name list-" pretty-name " :? :*\n" + "-- :doc lists all existing " pretty-name " records\n" + "SELECT * FROM " entity-name "\n" + (order-by-clause entity-map) + "\n\n"))) + + +(defn foreign-queries [entity-map entities-map] + (let [entity-name (:name (:attrs entity-map)) + pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "") + links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))] + (apply + str + (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)] + (str "-- :name list-" entity-name "-by-" pretty-far " :? :*\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)] + (println links) + (str "-- :name list-" link-name "-" near-name "-by-" pretty-far " :? :*\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 + str + (map + #(str + (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) @@ -95,20 +186,26 @@ (defn queries - [entity-map] + [entity-map entities-map] (str (insert-query entity-map) (update-query entity-map) - (select-query entity-map) - (delete-query entity-map))) + (delete-query entity-map) + (if + (is-link-table? entity-map) + (link-table-queries entity-map entities-map) + (str + (select-query entity-map) + (list-query entity-map) + (foreign-queries entity-map entities-map))))) (defn migrations-to-queries-sql ([migrations-path] - (migrations-to-queries-sql migrations-path "queries.sql")) + (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 (map queries (vals adl-struct)))] + file-content (apply str (map #(queries % adl-struct) (vals adl-struct)))] (spit output file-content) file-content))) diff --git a/src/squirrel_parse/utils.clj b/src/squirrel_parse/utils.clj index f0ead6d..a23d2a9 100644 --- a/src/squirrel_parse/utils.clj +++ b/src/squirrel_parse/utils.clj @@ -1,7 +1,7 @@ (ns ^{:doc "A parser for SQL: utility functions." :author "Simon Brooke"} squirrel-parse.utils - (:require [clojure.string :refer [join split trim triml upper-case]])) + (:require [clojure.string :as s])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -45,14 +45,14 @@ without the terminal semi-colon. Keywords may always optionally be preceded by whitespace and are usually succeeded by whitespace." [token] - (let [subtokens (split token #"\s+") - name (join "-" subtokens)] + (let [subtokens (s/split token #"\s+") + name (s/join "-" subtokens)] (apply str (flatten (list - (upper-case name) + (s/upper-case name) " := OPT-SPACE " - (join " SPACE " (map #(str "#'(?i)" % "'") subtokens)) + (s/join " SPACE " (map #(str "#'(?i)" % "'") subtokens)) " OPT-SPACE "))))) @@ -79,7 +79,7 @@ (defn- make-timezone-clause [match with-tz? with-precision?] - (join + (s/join " " (list (if with-precision? (str match " LPAR INT-VAL RPAR") match) @@ -92,16 +92,16 @@ "Make a rule which matches this `datatype`, for datatypes which may optionally take 'with (or without) time zone'." [token] - (let [subtokens (split token #"\s+") - name (join "-" subtokens) - match (join " SPACE " (map #(str "#'(?i)" % "'") subtokens))] + (let [subtokens (s/split token #"\s+") + name (s/join "-" subtokens) + match (s/join " SPACE " (map #(str "#'(?i)" % "'") subtokens))] (apply str (flatten (list "DT-" - (upper-case name) + (s/upper-case name) " := " - (join + (s/join " | " (list match @@ -212,4 +212,6 @@ (if name-elt (second name-elt)))) +(defn singularise [string] + (s/replace (s/replace string #"_" "-") #"s$" ""))