Separated caching into new namespace.
This commit is contained in:
parent
da5d884605
commit
2df3444090
|
|
@ -1,7 +1,8 @@
|
|||
(ns ^{:doc "Application Description Language - command line invocation."
|
||||
:author "Simon Brooke"}
|
||||
adl.main
|
||||
(:require [adl.to-hugsql-queries :as h]
|
||||
(:require [adl.to-cache :as c]
|
||||
[adl.to-hugsql-queries :as h]
|
||||
[adl.to-json-routes :as j]
|
||||
[adl.to-psql :as p]
|
||||
[adl.to-selmer-routes :as s]
|
||||
|
|
@ -52,8 +53,7 @@
|
|||
:default "generated"]
|
||||
["-v" "--verbosity [LEVEL]" nil "Verbosity level - integer value required"
|
||||
:parse-fn #(Integer/parseInt %)
|
||||
:default 0]
|
||||
])
|
||||
:default 0]])
|
||||
|
||||
|
||||
(defn usage
|
||||
|
|
@ -105,6 +105,7 @@
|
|||
#(if
|
||||
(.exists (java.io.File. %))
|
||||
(let [application (x/parse (canonicalise %))]
|
||||
(c/to-cache application)
|
||||
(h/to-hugsql-queries application)
|
||||
(j/to-json-routes application)
|
||||
(p/to-psql application)
|
||||
|
|
|
|||
124
src/adl/to_cache.clj
Normal file
124
src/adl/to_cache.clj
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
(ns ^{:doc "Application Description Language: generate caching layer for database requests."
|
||||
:author "Simon Brooke"}
|
||||
adl.to-cache
|
||||
(:require [adl-support.core :refer :all]
|
||||
[adl-support.utils :refer :all]
|
||||
[adl.to-hugsql-queries :refer [generate-documentation queries]]
|
||||
[clj-time.core :as t]
|
||||
[clj-time.format :as f]
|
||||
[clojure.java.io :refer [file make-parents writer]]
|
||||
[clojure.pprint :refer [pprint]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; adl.to-cache: generate caching layer for database requests.
|
||||
;;;;
|
||||
;;;; 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
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; You can't cache the actual HugSQL functions (or at least, I don't know how
|
||||
;;; you would); there's no point caching JSON requests because the request data
|
||||
;;; will be different every time.
|
||||
|
||||
;;; 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.
|
||||
|
||||
;;; TODO: memoisation of handlers probably doesn't make sense, because every request
|
||||
;;; will be different. I don't think we can memoise HugSQL, at least not without
|
||||
;;; hacking the library (might be worth doing that and contributing a patch).
|
||||
;;; So the solution may be to an intervening namespace 'cache', which has one
|
||||
;;; memoised function for each hugsql query.
|
||||
|
||||
(defn file-header
|
||||
"Generate an appropriate file header for JSON routes for this `application`."
|
||||
[application]
|
||||
(list
|
||||
'ns
|
||||
(symbol (str (safe-name (:name (:attrs application))) ".cache"))
|
||||
(str "Caching wrappers for queries for " (:name (:attrs application))
|
||||
" auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at "
|
||||
(f/unparse (f/formatters :basic-date-time) (t/now)))
|
||||
(list
|
||||
:require
|
||||
'[adl-support.core :refer :all]
|
||||
'[adl-support.rest-support :refer :all]
|
||||
'[clojure.core.memoize :as memo]
|
||||
'[clojure.java.io :as io]
|
||||
'[clojure.tools.logging :as log]
|
||||
'[compojure.core :refer [defroutes GET POST]]
|
||||
'[hugsql.core :as hugsql]
|
||||
'[noir.response :as nresponse]
|
||||
'[noir.util.route :as route]
|
||||
'[ring.util.http-response :as response]
|
||||
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
|
||||
|
||||
|
||||
(defn handler
|
||||
"Generate declarations for handlers for this `query`. Cache handlers are needed only for select queries."
|
||||
[query]
|
||||
(let [handler-name (symbol (:name query))
|
||||
v (volatility (:entity query))]
|
||||
(if (and
|
||||
(number? v)
|
||||
(> v 0)
|
||||
(#{:select-1 :select-many :text-search}(:type query)))
|
||||
(list
|
||||
'def
|
||||
handler-name
|
||||
(str
|
||||
"Auto-generated function to "
|
||||
(generate-documentation query))
|
||||
(list
|
||||
'memo/ttl
|
||||
(list
|
||||
'fn
|
||||
['connection 'params]
|
||||
(list
|
||||
(symbol (str "db/" (:name query)))
|
||||
'connection 'params))
|
||||
{}
|
||||
:ttl/threshold
|
||||
(* v 1000))))))
|
||||
|
||||
|
||||
(defn to-cache
|
||||
"Generate a `/cache.clj` file for this `application`."
|
||||
[application]
|
||||
(let [queries-map (queries application)
|
||||
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/cache.clj")]
|
||||
(make-parents filepath)
|
||||
(do-or-warn
|
||||
(with-open [output (writer filepath)]
|
||||
(binding [*out* output]
|
||||
(pprint (file-header application))
|
||||
(println)
|
||||
(doall
|
||||
(map
|
||||
(fn [k]
|
||||
(let [k (handler (queries-map k))]
|
||||
(if k
|
||||
(do
|
||||
(pprint k)
|
||||
(println)))
|
||||
k))
|
||||
(sort (keys queries-map)))))))
|
||||
(if (pos? *verbosity*)
|
||||
(*warn* (str "\tGenerated " filepath)))))
|
||||
|
||||
|
|
@ -48,12 +48,12 @@
|
|||
property-names (map #(:name (:attrs %)) properties)]
|
||||
(if-not (empty? property-names)
|
||||
(str
|
||||
"WHERE "
|
||||
(s/join
|
||||
"\n\tAND "
|
||||
(map
|
||||
#(str entity-name "." (safe-name % :sql) " = :" %)
|
||||
property-names)))))))
|
||||
"WHERE "
|
||||
(s/join
|
||||
"\n\tAND "
|
||||
(map
|
||||
#(str entity-name "." (safe-name % :sql) " = :" %)
|
||||
property-names)))))))
|
||||
|
||||
|
||||
(defn order-by-clause
|
||||
|
|
@ -63,26 +63,26 @@
|
|||
([entity prefix]
|
||||
(order-by-clause entity prefix false))
|
||||
([entity prefix expanded?]
|
||||
(let
|
||||
[entity-name (safe-name entity :sql)
|
||||
preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
|
||||
(descendants-with-tag entity :property))]
|
||||
(if
|
||||
(empty? preferred)
|
||||
""
|
||||
(str
|
||||
"ORDER BY " prefix entity-name "."
|
||||
(s/join
|
||||
(str ",\n\t" prefix entity-name ".")
|
||||
(map
|
||||
#(if
|
||||
(and expanded? (= "entity" (-> % :attrs :type)))
|
||||
(str (safe-name % :sql) expanded-token)
|
||||
(safe-name % :sql))
|
||||
(order-preserving-set
|
||||
(concat
|
||||
preferred
|
||||
(key-properties entity))))))))))
|
||||
(let
|
||||
[entity-name (safe-name entity :sql)
|
||||
preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
|
||||
(descendants-with-tag entity :property))]
|
||||
(if
|
||||
(empty? preferred)
|
||||
""
|
||||
(str
|
||||
"ORDER BY " prefix entity-name "."
|
||||
(s/join
|
||||
(str ",\n\t" prefix entity-name ".")
|
||||
(map
|
||||
#(if
|
||||
(and expanded? (= "entity" (-> % :attrs :type)))
|
||||
(str (safe-name % :sql) expanded-token)
|
||||
(safe-name % :sql))
|
||||
(order-preserving-set
|
||||
(concat
|
||||
preferred
|
||||
(key-properties entity))))))))))
|
||||
|
||||
;; (def a (x/parse "../youyesyet/youyesyet.adl.xml"))
|
||||
;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name))))
|
||||
|
|
@ -131,31 +131,31 @@
|
|||
(defn update-query
|
||||
"Generate an appropriate `update` query for this `entity`"
|
||||
[entity]
|
||||
(let [entity-name (safe-name entity :sql)
|
||||
pretty-name (singularise entity-name)
|
||||
property-names (map
|
||||
#(-> % :attrs :name)
|
||||
(insertable-properties entity))
|
||||
query-name (str "update-" pretty-name "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity
|
||||
: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
|
||||
(let [entity-name (safe-name entity :sql)
|
||||
pretty-name (singularise entity-name)
|
||||
property-names (map
|
||||
#(-> % :attrs :name)
|
||||
(insertable-properties entity))
|
||||
query-name (str "update-" pretty-name "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity
|
||||
: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 (safe-name % :sql) " = " (keyword %))
|
||||
property-names))
|
||||
"\n"
|
||||
(where-clause entity))})))
|
||||
"\n"
|
||||
(where-clause entity))})))
|
||||
|
||||
|
||||
(defn search-query [entity application]
|
||||
|
|
@ -193,29 +193,29 @@
|
|||
#(let
|
||||
[sn (safe-name % :sql)]
|
||||
(str
|
||||
"(if (:" (-> % :attrs :name) " params) (str \"AND "
|
||||
(case (-> % :attrs :type)
|
||||
("string" "text")
|
||||
(str
|
||||
sn
|
||||
" LIKE '%\" (:" (-> % :attrs :name) " params) \"%' ")
|
||||
("date" "time" "timestamp")
|
||||
(str
|
||||
sn
|
||||
" = ':" (-> % :attrs :name) "'")
|
||||
"entity"
|
||||
(str
|
||||
sn
|
||||
"_expanded LIKE '%\" (:" (-> % :attrs :name) " params) \"%'")
|
||||
(str
|
||||
sn
|
||||
" = :"
|
||||
(-> % :attrs :name)))
|
||||
"\"))"))
|
||||
"(if (:" (-> % :attrs :name) " params) (str \"AND "
|
||||
(case (-> % :attrs :type)
|
||||
("string" "text")
|
||||
(str
|
||||
sn
|
||||
" LIKE '%\" (:" (-> % :attrs :name) " params) \"%' ")
|
||||
("date" "time" "timestamp")
|
||||
(str
|
||||
sn
|
||||
" = ':" (-> % :attrs :name) "'")
|
||||
"entity"
|
||||
(str
|
||||
sn
|
||||
"_expanded LIKE '%\" (:" (-> % :attrs :name) " params) \"%'")
|
||||
(str
|
||||
sn
|
||||
" = :"
|
||||
(-> % :attrs :name)))
|
||||
"\"))"))
|
||||
properties))))
|
||||
(order-by-clause entity "lv_" true)
|
||||
"--~ (if (:offset params) \"OFFSET :offset \")"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
|
||||
(order-by-clause entity "lv_" true)
|
||||
"--~ (if (:offset params) \"OFFSET :offset \")"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
|
||||
|
||||
;; (search-query e a)
|
||||
|
||||
|
|
@ -345,11 +345,11 @@
|
|||
(str "\tAND " link-table-name "." (singularise entity-safe) "_id = :id")
|
||||
(order-by-clause far-entity "lv_" false)))
|
||||
"list" (list
|
||||
(str "-- :name " query-name " " signature)
|
||||
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
|
||||
(str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far)
|
||||
(str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id")
|
||||
(order-by-clause far-entity "lv_" false))
|
||||
(str "-- :name " query-name " " signature)
|
||||
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
|
||||
(str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far)
|
||||
(str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id")
|
||||
(order-by-clause far-entity "lv_" false))
|
||||
(list (str "ERROR: unexpected type " link-type " of property " %)))))
|
||||
}))
|
||||
links))))
|
||||
|
|
@ -403,23 +403,94 @@
|
|||
(let [filepath (str *output-path* "resources/sql/queries.auto.sql")]
|
||||
(make-parents filepath)
|
||||
(do-or-warn
|
||||
(do
|
||||
(spit
|
||||
filepath
|
||||
(s/join
|
||||
"\n\n"
|
||||
(cons
|
||||
(emit-header
|
||||
"--"
|
||||
"File queries.sql"
|
||||
(str "autogenerated by adl.to-hugsql-queries at " (t/now))
|
||||
"See [Application Description Language](https://github.com/simon-brooke/adl).")
|
||||
(map
|
||||
:query
|
||||
(sort
|
||||
#(compare (:name %1) (:name %2))
|
||||
(vals
|
||||
(queries application)))))))
|
||||
(if (pos? *verbosity*)
|
||||
(*warn* (str "\tGenerated " filepath)))))))
|
||||
(do
|
||||
(spit
|
||||
filepath
|
||||
(s/join
|
||||
"\n\n"
|
||||
(cons
|
||||
(emit-header
|
||||
"--"
|
||||
"File queries.sql"
|
||||
(str "autogenerated by adl.to-hugsql-queries at " (t/now))
|
||||
"See [Application Description Language](https://github.com/simon-brooke/adl).")
|
||||
(map
|
||||
:query
|
||||
(sort
|
||||
#(compare (:name %1) (:name %2))
|
||||
(vals
|
||||
(queries application)))))))
|
||||
(if (pos? *verbosity*)
|
||||
(*warn* (str "\tGenerated " filepath)))))))
|
||||
|
||||
|
||||
(defn generate-documentation
|
||||
"Generate, as a string, appropriate documentation for a function wrapping this `query` map."
|
||||
[query]
|
||||
(let [v (volatility (:entity query))]
|
||||
(s/join
|
||||
" "
|
||||
(list
|
||||
(case
|
||||
(:type query)
|
||||
:delete-1
|
||||
(str "delete one record from the `"
|
||||
(-> query :entity :attrs :name)
|
||||
"` table. Expects the following key(s) to be present in `params`: `"
|
||||
(-> query :entity key-names)
|
||||
"`.")
|
||||
:insert-1
|
||||
(str "insert one record to the `"
|
||||
(-> query :entity :attrs :name)
|
||||
"` table. Expects the following key(s) to be present in `params`: `"
|
||||
(pr-str
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity insertable-properties )))
|
||||
"`. Returns a map containing the keys `"
|
||||
(-> query :entity key-names)
|
||||
"` identifying the record created.")
|
||||
:select-1
|
||||
(str "select one record from the `"
|
||||
(-> query :entity :attrs :name)
|
||||
"` table. Expects the following key(s) to be present in `params`: `"
|
||||
(-> query :entity key-names)
|
||||
"`. Returns a map containing the following keys: `"
|
||||
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
|
||||
"`.")
|
||||
:select-many
|
||||
(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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity all-properties)))
|
||||
"`.")
|
||||
:text-search
|
||||
(str "select all records from the `"
|
||||
(-> query :entity :attrs :name)
|
||||
;; TODO: this doc-string is out of date
|
||||
"` table with any text field matching the value of the key `:pattern` which should be in the request. 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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity all-properties)))
|
||||
"`.")
|
||||
:update-1
|
||||
(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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(flatten
|
||||
(cons
|
||||
(-> query :entity key-properties)
|
||||
(-> query :entity insertable-properties)))))))
|
||||
"`."))
|
||||
(if-not
|
||||
(zero? v)
|
||||
(str "Results will be held in cache for " v " seconds."))))))
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
adl.to-json-routes
|
||||
(:require [adl-support.core :refer :all]
|
||||
[adl-support.utils :refer :all]
|
||||
[adl.to-hugsql-queries :refer [queries]]
|
||||
[adl.to-hugsql-queries :refer [generate-documentation queries]]
|
||||
[clj-time.core :as t]
|
||||
[clj-time.format :as f]
|
||||
[clojure.java.io :refer [file make-parents writer]]
|
||||
|
|
@ -65,6 +65,7 @@
|
|||
'[noir.response :as nresponse]
|
||||
'[noir.util.route :as route]
|
||||
'[ring.util.http-response :as response]
|
||||
(vector (symbol (str (safe-name (:name (:attrs application))) ".cache")) :as 'cache)
|
||||
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
|
||||
|
||||
|
||||
|
|
@ -79,79 +80,82 @@
|
|||
"Generate and return the function body for the handler for this `query`."
|
||||
[query]
|
||||
(list
|
||||
['request]
|
||||
(list
|
||||
'let
|
||||
['params (list
|
||||
'merge
|
||||
(apply hash-map
|
||||
(interleave
|
||||
(map
|
||||
#(keyword (column-name %))
|
||||
(descendants-with-tag
|
||||
(:entity query)
|
||||
:property
|
||||
#(not (= (-> % :attrs :required) "true"))))
|
||||
(repeat nil)))
|
||||
'(massage-params request))]
|
||||
(list
|
||||
'valid-user-or-forbid
|
||||
(list
|
||||
'with-params-or-error
|
||||
['request]
|
||||
(let
|
||||
[v (volatility (:entity query))
|
||||
function (symbol (str
|
||||
(if
|
||||
(and
|
||||
(number? v)
|
||||
(> v 0)
|
||||
(#{:select-1 :select-many :text-search} (:type query)))
|
||||
"cache"
|
||||
"db")
|
||||
"/"
|
||||
(:name query)))]
|
||||
|
||||
(list
|
||||
'do-or-server-fail
|
||||
(list
|
||||
(symbol (str "db/" (:name query)))
|
||||
'db/*db* 'params)
|
||||
(case (:type query)
|
||||
:insert-1 201 ;; created
|
||||
:delete-1 204 ;; no content
|
||||
;; default
|
||||
200)) ;; OK
|
||||
'params
|
||||
(set
|
||||
(map
|
||||
#(keyword (column-name %))
|
||||
(case (:type query)
|
||||
:insert-1
|
||||
(-> query :entity required-properties)
|
||||
:update-1 (concat
|
||||
(-> query :entity key-properties)
|
||||
(-> query :entity required-properties))
|
||||
(:select-1 :delete-1)
|
||||
(-> query :entity key-properties)
|
||||
;; default
|
||||
nil))))
|
||||
'request))))
|
||||
'let
|
||||
['params (list
|
||||
'merge
|
||||
(apply hash-map
|
||||
(interleave
|
||||
(map
|
||||
#(keyword (column-name %))
|
||||
(descendants-with-tag
|
||||
(:entity query)
|
||||
:property
|
||||
#(not (= (-> % :attrs :required) "true"))))
|
||||
(repeat nil)))
|
||||
'(massage-params request))]
|
||||
(list
|
||||
'valid-user-or-forbid
|
||||
(list
|
||||
'with-params-or-error
|
||||
(list
|
||||
'do-or-server-fail
|
||||
(list
|
||||
function
|
||||
'db/*db* 'params)
|
||||
(case (:type query)
|
||||
:insert-1 201 ;; created
|
||||
:delete-1 204 ;; no content
|
||||
;; default
|
||||
200)) ;; OK
|
||||
'params
|
||||
(set
|
||||
(map
|
||||
#(keyword (column-name %))
|
||||
(case (:type query)
|
||||
:insert-1
|
||||
(-> query :entity required-properties)
|
||||
:update-1 (concat
|
||||
(-> query :entity key-properties)
|
||||
(-> query :entity required-properties))
|
||||
(:select-1 :delete-1)
|
||||
(-> query :entity key-properties)
|
||||
;; default
|
||||
nil))))
|
||||
'request)))))
|
||||
|
||||
|
||||
(defn generate-handler-src
|
||||
"Generate and return the handler for this `query`."
|
||||
[handler-name query-map method doc]
|
||||
(hash-map
|
||||
:method method
|
||||
:src (remove
|
||||
nil?
|
||||
(if
|
||||
(or
|
||||
(zero? (volatility (:entity query-map)))
|
||||
(#{:delete-1 :insert-1 :update-1} (:type query-map)))
|
||||
[handler-name query-map method]
|
||||
(let [doc (str
|
||||
"Auto-generated function to "
|
||||
(generate-documentation query-map))
|
||||
v (volatility (:entity query-map))]
|
||||
(hash-map
|
||||
:method method
|
||||
:src (remove
|
||||
nil?
|
||||
(concat
|
||||
(list
|
||||
'defn
|
||||
handler-name
|
||||
(str "Auto-generated method to " doc))
|
||||
(generate-handler-body query-map))
|
||||
(concat
|
||||
(list
|
||||
'def
|
||||
handler-name
|
||||
(list
|
||||
'memo/ttl
|
||||
(cons 'fn (generate-handler-body query-map))
|
||||
{}
|
||||
:ttl/threshold
|
||||
(* (volatility (:entity query-map)) 1000))))))))
|
||||
doc
|
||||
(generate-handler-body query-map)))))))
|
||||
|
||||
|
||||
(defn handler
|
||||
|
|
@ -168,78 +172,14 @@
|
|||
:route (str "/json/" handler-name)}
|
||||
(case
|
||||
(:type query)
|
||||
:delete-1
|
||||
(:delete-1 :insert-1 :update-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`: `"
|
||||
(-> query :entity key-names)
|
||||
"`."))
|
||||
:insert-1
|
||||
handler-name query :post)
|
||||
(:select-1 :select-many :text-search)
|
||||
(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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity insertable-properties )))
|
||||
"`. Returns a map containing the keys `"
|
||||
(-> query :entity key-names)
|
||||
"` 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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(flatten
|
||||
(cons
|
||||
(-> query :entity key-properties)
|
||||
(-> query :entity insertable-properties)))))))
|
||||
"`."))
|
||||
:select-1
|
||||
(generate-handler-src
|
||||
handler-name query :get
|
||||
(str "select one record from the `"
|
||||
(-> query :entity :attrs :name)
|
||||
"` table. Expects the following key(s) to be present in `params`: `"
|
||||
(-> query :entity key-names)
|
||||
"`. Returns a map containing the following keys: `"
|
||||
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
|
||||
"`."))
|
||||
:select-many
|
||||
(generate-handler-src
|
||||
handler-name query :get
|
||||
(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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity all-properties)))
|
||||
"`."))
|
||||
:text-search
|
||||
(generate-handler-src
|
||||
handler-name query :get
|
||||
(str "select all records from the `"
|
||||
(-> query :entity :attrs :name)
|
||||
;; TODO: this doc-string is out of date
|
||||
"` table with any text field matching the value of the key `:pattern` which should be in the request. 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
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity all-properties)))
|
||||
"`."))
|
||||
handler-name query :get)
|
||||
(:select-many-to-many
|
||||
:select-one-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))))
|
||||
|
|
@ -249,26 +189,6 @@
|
|||
(str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
|
||||
|
||||
|
||||
(defn defroutes
|
||||
"Generate JSON routes for all queries implied by this ADL `application` spec."
|
||||
[handlers-map]
|
||||
(cons
|
||||
'defroutes
|
||||
(cons
|
||||
'auto-rest-routes
|
||||
(map
|
||||
#(let [handler (handlers-map %)]
|
||||
(list
|
||||
(symbol (s/upper-case (name (:method handler))))
|
||||
(str "/json/auto/" (safe-name (:name handler)))
|
||||
'request
|
||||
(list
|
||||
'route/restricted
|
||||
(list (:name handler) 'request))))
|
||||
(sort
|
||||
(keys handlers-map))))))
|
||||
|
||||
|
||||
(defn make-handlers-map
|
||||
"Analyse this `application` and generate from it a map of the handlers to be output."
|
||||
[application]
|
||||
|
|
@ -288,6 +208,26 @@
|
|||
(children-with-tag application :entity))))
|
||||
|
||||
|
||||
(defn defroutes
|
||||
"Generate JSON routes for all queries implied by this ADL `application` spec."
|
||||
[handlers-map]
|
||||
(cons
|
||||
'defroutes
|
||||
(cons
|
||||
'auto-rest-routes
|
||||
(map
|
||||
#(let [handler (handlers-map %)]
|
||||
(list
|
||||
(symbol (s/upper-case (name (:method handler))))
|
||||
(str "/json/auto/" (safe-name (:name handler)))
|
||||
'request
|
||||
(list
|
||||
'route/restricted
|
||||
(list (:name handler) 'request))))
|
||||
(sort
|
||||
(keys handlers-map))))))
|
||||
|
||||
|
||||
(defn to-json-routes
|
||||
"Generate a `/routes/auto-json.clj` file for this `application`."
|
||||
[application]
|
||||
|
|
@ -306,8 +246,8 @@
|
|||
(println)
|
||||
h)
|
||||
(sort (keys handlers-map))))
|
||||
(pprint (defroutes handlers-map))))
|
||||
(if (pos? *verbosity*)
|
||||
(*warn* (str "\tGenerated " filepath))))))
|
||||
(pprint (defroutes handlers-map)))))
|
||||
(if (pos? *verbosity*)
|
||||
(*warn* (str "\tGenerated " filepath)))))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue