Added volatility to entities, to enable cacheing.
This commit is contained in:
parent
7ea6b5f299
commit
a4e0fd1c9a
|
|
@ -246,7 +246,7 @@ that we can allow HTML block level entities within content elements -->
|
|||
an entity which has properties and relationships; maps onto a database
|
||||
table or a Java serialisable class - or, of course, various other things
|
||||
|
||||
name: obviously, the name of this entity
|
||||
name: obviously, the name of this entity.
|
||||
natural-key: if present, the name of a property of this entity which forms
|
||||
a natural primary key [NOTE: Only partly implemented. NOTE: much of
|
||||
the present implementation assumes all primary keys will be
|
||||
|
|
@ -254,12 +254,17 @@ that we can allow HTML block level entities within content elements -->
|
|||
'key' element, below.
|
||||
table: the name of the table in which this entity is stored. Defaults to same
|
||||
as name of entity. Strongly recommend this is not used unless it needs
|
||||
to be different from the name of the entity
|
||||
to be different from the name of the entity.
|
||||
foreign: this entity is part of some other system; no code will be generated
|
||||
for it, although code which links to it will be generated
|
||||
for it, although code which links to it will be generated.
|
||||
magnitude: The power of ten which approximates the expected number of records; thus
|
||||
if ten records are expected, the magnitude is 1; if a million, the
|
||||
magnitude is 6
|
||||
magnitude is 6.
|
||||
volatility: Number representing the anticipated rate of change of records in this
|
||||
entity; if 0, results should never be cached; otherwise, a power of
|
||||
10 representing the number of seconds the data may safely be cached.
|
||||
thus 5 represents a cach time to live of 100,000 seconds, or slightly
|
||||
more than one day.
|
||||
-->
|
||||
<!ELEMENT entity ( documentation?, prompt*, content?, key?,
|
||||
property*, permission*, (form | page | list)*)>
|
||||
|
|
@ -268,7 +273,8 @@ that we can allow HTML block level entities within content elements -->
|
|||
natural-key CDATA #IMPLIED
|
||||
table CDATA #IMPLIED
|
||||
foreign %Boolean; #IMPLIED
|
||||
magnitude CDATA #IMPLIED>
|
||||
magnitude CDATA #IMPLIED
|
||||
volatility CDATA #IMPLIED>
|
||||
|
||||
<!--
|
||||
contains documentation on the element which immediately contains it. TODO:
|
||||
|
|
|
|||
|
|
@ -90,6 +90,9 @@
|
|||
<xsl:if test="not(@magnitude)">
|
||||
<xsl:attribute name="magnitude">6</xsl:attribute>
|
||||
</xsl:if>
|
||||
<xsl:if test="not(@volatility)">
|
||||
<xsl:attribute name="volatility">0</xsl:attribute>
|
||||
</xsl:if>
|
||||
<xsl:if test="not( @table)">
|
||||
<xsl:attribute name="table">
|
||||
<xsl:value-of select="concat( $tablename-prefix, @name)"/>
|
||||
|
|
|
|||
|
|
@ -321,80 +321,6 @@
|
|||
}))
|
||||
links))))
|
||||
|
||||
(defn link-table-query
|
||||
"Generate a query which links across the entity passed as `link`
|
||||
from the entity passed as `near` to the entity passed as `far`.
|
||||
TODO: not working?"
|
||||
[near link far]
|
||||
(if
|
||||
(and
|
||||
(entity? near)
|
||||
(entity? link)
|
||||
(entity? 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
|
||||
(s/join
|
||||
"\n"
|
||||
(remove
|
||||
empty?
|
||||
(list
|
||||
(str "-- :name " query-name " " signature)
|
||||
(str "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far )
|
||||
(str "SELECT DISTINCT "near-name ".*")
|
||||
(str "FROM " near-name ", " link-name )
|
||||
(str "WHERE " near-name "." (first (key-names near)) " = " link-name "." (singularise near-name) "_id" )
|
||||
("\tAND " link-name "." (singularise far-name) "_id = :id")
|
||||
(order-by-clause near))))}))))
|
||||
|
||||
|
||||
(defn link-table-queries [entity application]
|
||||
"Generate all the link queries in this `application` which link via this `entity`."
|
||||
(let
|
||||
[entities (map
|
||||
;; find the far-side entities
|
||||
(fn
|
||||
[far-name]
|
||||
(children
|
||||
application
|
||||
(fn [x]
|
||||
(and
|
||||
(= (:tag x) :entity)
|
||||
(= (:name (:attrs x)) far-name)))))
|
||||
;; of those properties of this `entity` which are of type `entity`
|
||||
(remove
|
||||
nil?
|
||||
(map
|
||||
#(-> % :attrs :entity)
|
||||
(children entity #(= (:tag %) :property)))))
|
||||
pairs (combinations entities 2)]
|
||||
(apply
|
||||
merge
|
||||
(map
|
||||
#(merge
|
||||
(link-table-query (nth % 0) entity (nth % 1))
|
||||
(link-table-query (nth % 1) entity (nth % 0)))
|
||||
pairs))))
|
||||
|
||||
|
||||
|
||||
(defn delete-query [entity]
|
||||
"Generate an appropriate `delete` query for this `entity`"
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@
|
|||
:require
|
||||
'[adl-support.core :as support]
|
||||
'[clojure.java.io :as io]
|
||||
'[clojure.core.memoize :as memo]
|
||||
'[compojure.core :refer [defroutes GET POST]]
|
||||
'[hugsql.core :as hugsql]
|
||||
'[noir.response :as nresponse]
|
||||
|
|
@ -60,24 +61,45 @@
|
|||
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map)))))
|
||||
|
||||
|
||||
(defn generate-handler-body
|
||||
"Generate and return the function body for the handler for this `query`."
|
||||
[query]
|
||||
(list
|
||||
[{:keys ['params]}]
|
||||
(list 'do (list (symbol (str "db/" (:name query))) 'params))
|
||||
(case
|
||||
(:type query)
|
||||
(:delete-1 :update-1)
|
||||
'(response/found "/")
|
||||
nil)))
|
||||
|
||||
|
||||
(defn generate-handler-src
|
||||
"Generate and return the handler for this `query`."
|
||||
[handler-name query-map method doc]
|
||||
(hash-map
|
||||
:method method
|
||||
:src
|
||||
(remove
|
||||
:src (remove
|
||||
nil?
|
||||
(if
|
||||
(or
|
||||
(zero? (volatility (:entity query-map)))
|
||||
(#{:delete-1 :insert-1 :update-1} (:type query-map)))
|
||||
(concat
|
||||
(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)))))
|
||||
(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))))))))
|
||||
|
||||
|
||||
(defn handler
|
||||
|
|
@ -100,7 +122,7 @@
|
|||
(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))
|
||||
(-> query :entity key-names)
|
||||
"`."))
|
||||
:insert-1
|
||||
(generate-handler-src
|
||||
|
|
@ -108,9 +130,12 @@
|
|||
(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))
|
||||
(pr-str
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity insertable-properties )))
|
||||
"`. Returns a map containing the keys `"
|
||||
(pr-str (-> query :entity :content :key :content keys))
|
||||
(-> query :entity key-names)
|
||||
"` identifying the record created."))
|
||||
:update-1
|
||||
(generate-handler-src
|
||||
|
|
@ -121,10 +146,12 @@
|
|||
(pr-str
|
||||
(distinct
|
||||
(sort
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(flatten
|
||||
(cons
|
||||
(-> query :entity :content :properties keys)
|
||||
(-> query :entity :content :key :content keys))))))
|
||||
(-> query :entity key-properties)
|
||||
(-> query :entity insertable-properties)))))))
|
||||
"`."))
|
||||
:select-1
|
||||
(generate-handler-src
|
||||
|
|
@ -132,15 +159,9 @@
|
|||
(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))
|
||||
(-> query :entity key-names)
|
||||
"`. Returns a map containing the following keys: `"
|
||||
(pr-str
|
||||
(distinct
|
||||
(sort
|
||||
(flatten
|
||||
(cons
|
||||
(-> query :entity :content :properties keys)
|
||||
(-> query :entity :content :key :content keys))))))
|
||||
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
|
||||
"`."))
|
||||
:select-many
|
||||
(generate-handler-src
|
||||
|
|
@ -149,26 +170,21 @@
|
|||
(-> 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))))))
|
||||
(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
|
||||
(distinct
|
||||
(sort
|
||||
(flatten
|
||||
(cons
|
||||
(-> query :entity :content :properties keys)
|
||||
(-> query :entity :content :key :content keys))))))
|
||||
(map
|
||||
#(keyword (:name (:attrs %)))
|
||||
(-> query :entity all-properties)))
|
||||
"`."))
|
||||
(:select-many-to-many
|
||||
:select-one-to-many)
|
||||
|
|
@ -226,22 +242,16 @@
|
|||
(try
|
||||
(with-open [output (writer filepath)]
|
||||
(binding [*out* output]
|
||||
(doall
|
||||
(map
|
||||
(fn [f]
|
||||
(pprint f)
|
||||
(println "\n"))
|
||||
(list
|
||||
(file-header application)
|
||||
(declarations handlers-map)
|
||||
(defroutes handlers-map))))
|
||||
(pprint (file-header application))
|
||||
(println)
|
||||
(doall
|
||||
(map
|
||||
(fn [h]
|
||||
(pprint (:src (handlers-map h)))
|
||||
(println)
|
||||
h)
|
||||
(sort (keys handlers-map))))))
|
||||
(sort (keys handlers-map))))
|
||||
(pprint (defroutes handlers-map))))
|
||||
(if (> *verbosity* 0)
|
||||
(println (str "\tGenerated " filepath)))
|
||||
(catch
|
||||
|
|
|
|||
|
|
@ -198,6 +198,7 @@
|
|||
(l/render
|
||||
(support/resolve-template
|
||||
"application-index.html")
|
||||
(:session r)
|
||||
{:title "Administrative menu"})))
|
||||
(println)
|
||||
(doall
|
||||
|
|
|
|||
Loading…
Reference in a new issue