diff --git a/src/squirrel_parse/to_hugsql_queries.clj b/src/squirrel_parse/to_hugsql_queries.clj index 9518016..dacd1f8 100644 --- a/src/squirrel_parse/to_hugsql_queries.clj +++ b/src/squirrel_parse/to_hugsql_queries.clj @@ -39,10 +39,10 @@ (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)))] + preferred (map + #(:name (:attrs %)) + (filter #(= (-> % :attrs :distinct) "user") + (-> entity-map :content :properties vals)))] (str "ORDER BY " entity-name "." (s/join @@ -52,20 +52,28 @@ (defn insert-query [entity-map] (let [entity-name (:name (:attrs entity-map)) - pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "") + pretty-name (singularise entity-name) all-property-names (map #(:name (:attrs %)) (vals (:properties (:content entity-map)))) - ] - (str "-- :name create-" pretty-name "! : % :attrs :entity) (-> entity-map :content :properties vals))] (apply - str + 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)] - (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")) + 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)))) @@ -145,16 +198,26 @@ 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"))) + 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] @@ -164,9 +227,9 @@ (remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals)))) pairs (combinations entities 2)] (apply - str + merge (map - #(str + #(merge (link-table-query (nth % 0) entity-map (nth % 1)) (link-table-query (nth % 1) entity-map (nth % 0))) pairs)))) @@ -177,24 +240,34 @@ (if (has-primary-key? entity-map) (let [entity-name (:name (:attrs entity-map)) - pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")] - (str "-- :name delete-" pretty-name "! :! :n\n" - "-- :doc updates an existing " pretty-name " record\n" - "DELETE FROM " entity-name "\n" - (where-clause entity-map) - "\n\n")))) + 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] - (str + (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) - (str + (merge (select-query entity-map) (list-query entity-map) (foreign-queries entity-map entities-map))))) @@ -206,6 +279,15 @@ ([migrations-path output] (let [adl-struct (migrations-to-xml migrations-path "Ignored") - file-content (apply str (map #(queries % adl-struct) (vals adl-struct)))] + file-content (apply + str + (doall (map + #(:query %) + (vals + (apply + merge + (map + #(queries % adl-struct) + (vals adl-struct)))))))] (spit output file-content) file-content))) diff --git a/src/squirrel_parse/to_json_routes.clj b/src/squirrel_parse/to_json_routes.clj new file mode 100644 index 0000000..fe74533 --- /dev/null +++ b/src/squirrel_parse/to_json_routes.clj @@ -0,0 +1,225 @@ +(ns ^{:doc "A parser for SQL: generate JSON routes." + :author "Simon Brooke"} + squirrel-parse.to-json-routes + (:require [clojure.java.io :refer [file]] + [clojure.math.combinatorics :refer [combinations]] + [clojure.pprint :refer [pprint write]] + [clojure.string :as s] + [squirrel-parse.to-adl :refer [migrations-to-xml]] + [squirrel-parse.to-hugsql-queries :refer [queries]] + [squirrel-parse.utils :refer [is-link-table? singularise]])) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; squirrel-parse.to-json-routes: generate JSON routes. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2018 Simon Brooke +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; The overall structure of this has quite closely to follow the structure of +;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap +;;; each query. + +(defn file-header [parent-name this-name] + (list + 'ns + ^{:doc "JSON routes auto-generated by squirrel-parse"} + (symbol (str parent-name "." this-name)) + (list + 'require + '[noir.response :as nresponse] + '[noir.util.route :as route] + '[compojure.core :refer [defroutes GET POST]] + '[ring.util.http-response :as response] + '[clojure.java.io :as io] + '[hugsql.core :as hugsql] + (vector (symbol (str parent-name ".db.core")) :as 'db)))) + + +(defn make-safe-name [string] + (s/replace string #"[^a-zA-Z0-9-]" "")) + + +(defn declarations [handlers-map] + (cons 'declare (sort (map #(symbol (make-safe-name (name %))) (keys handlers-map))))) + + +(defn generate-handler-src + [handler-name query-map method doc] + (hash-map + :method method + :src + (remove + nil? + (list + 'defn + handler-name + (str "Auto-generated method to " doc) + [{:keys ['params]}] + (list 'do (list (symbol (str "db/" (:name query-map))) 'params)) + (case + (:type query-map) + (:delete-1 :update-1) + '(response/found "/") + nil))))) + + +(defn handler + "Generate declarations for handlers from query with this `query-key` in this `queries-map` taken from within + this `entities-map`. This method must follow the structure of + `to-hugsql-queries/queries` quite closely, because we must generate the same names." + [query-key queries-map entities-map] + (let [query (query-key queries-map) + handler-name (symbol (make-safe-name (name query-key)))] + (hash-map + (keyword handler-name) + (merge + {:name handler-name + :route (str "/json/" handler-name)} + (case + (:type query) + :delete-1 + (generate-handler-src + handler-name query :post + (str "delete one record from the " + (-> query :entity :attrs :name) + " table. Expects the following key(s) to be present in `params`: " + (doall (-> query :entity :content :key :content keys)) + ".")) + :insert-1 + (generate-handler-src + handler-name query :post + (str "insert one record to the " + (-> query :entity :attrs :name) + " table. Expects the following key(s) to be present in `params`: " + (pr-str (-> query :entity :content :properties keys)) + ". Returns a map containing the keys " + (pr-str (-> query :entity :content :key :content keys)) + " identifying the record created.")) + :update-1 + (generate-handler-src + handler-name query :post + (str "update one record in the " + (-> query :entity :attrs :name) + " table. Expects the following key(s) to be present in `params`: " + (pr-str + (distinct + (sort + (flatten + (cons + (-> query :entity :content :properties keys) + (-> query :entity :content :key :content keys)))))) + ".")) + :select-1 + (generate-handler-src + handler-name query :post + (str "select one record from the " + (-> query :entity :attrs :name) + " table. Expects the following key(s) to be present in `params`: " + (pr-str (-> query :entity :content :key :content keys)) + ". Returns a map containing the following keys: " + (pr-str + (distinct + (sort + (flatten + (cons + (-> query :entity :content :properties keys) + (-> query :entity :content :key :content keys)))))) + ".")) + :select-many + (generate-handler-src + handler-name query :post + (str "select all records from the " + (-> query :entity :attrs :name) + " table. If the keys (:limit :offset) are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: " + (pr-str + (distinct + (sort + (flatten + (cons + (-> query :entity :content :properties keys) + (-> query :entity :content :key :content keys)))))) + ".")) + + (:select-many-to-many + :select-one-to-many) + (hash-map :method :get + :src (list 'defn handler-name [{:keys ['params]}] + (list 'do (list (symbol (str "db/" (:name query))) 'params)))) + ;; default + (hash-map + :src + (str ";; don't know what to do with query " :key " of type " (:type query)))))))) + + +(defn defroutes [handlers-map] + (cons + 'defroutes + (cons + 'auto-rest-routes + (map + #(let [handler (handlers-map %)] + (list + (s/upper-case (name (:method handler))) + (str "/json/auto/" (:name handler)) + 'request + (list + 'route/restricted + (list (:name handler) 'request)))) + (sort + (keys handlers-map)))))) + + +(defn migrations-to-json-routes + ([migrations-path parent-namespace-name] + (migrations-to-json-routes migrations-path parent-namespace-name "auto-json-routes")) + ([migrations-path parent-namespace-name namespace-name] + (let [output (str (s/replace namespace-name #"-" "_") ".clj") + adl-struct (migrations-to-xml migrations-path "Ignored") + q (reduce + merge + {} + (map + #(queries % adl-struct) + (vals adl-struct))) + h (reduce + merge + {} + (map + #(handler % q adl-struct) + (keys q))) + f (cons + (file-header parent-namespace-name namespace-name) + ;; (pre-declare + (cons + (declarations h) + (cons + (defroutes h) + (map #(:src (h %)) (sort (keys h))))))] + (spit + output + (with-out-str + (doall + (for [expr f] + (do + (pprint expr) + (print "\n\n")))))) + f + ))) diff --git a/src/squirrel_parse/utils.clj b/src/squirrel_parse/utils.clj index a23d2a9..7298858 100644 --- a/src/squirrel_parse/utils.clj +++ b/src/squirrel_parse/utils.clj @@ -213,5 +213,5 @@ (defn singularise [string] - (s/replace (s/replace string #"_" "-") #"s$" "")) + (s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))