simon/adl
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Added volatility to entities, to enable cacheing.

Browse source
This commit is contained in:
Simon Brooke 2018-06-30 12:53:08 +01:00
parent 7ea6b5f299
commit a4e0fd1c9a
5 changed files with 87 additions and 141 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
resources/schemas/adl-1.4.1.dtd
View file

@ -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 an entity which has properties and relationships; maps onto a database
table or a Java serialisable class - or, of course, various other things 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 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 a natural primary key [NOTE: Only partly implemented. NOTE: much of
the present implementation assumes all primary keys will be the present implementation assumes all primary keys will be
@ -254,21 +254,27 @@ that we can allow HTML block level entities within content elements -->
'key' element, below. 'key' element, below.
table: the name of the table in which this entity is stored. Defaults to same 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 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 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 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 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?, <!ELEMENT entity ( documentation?, prompt*, content?, key?,
property*, permission*, (form | page | list)*)> property*, permission*, (form | page | list)*)>
<!ATTLIST entity <!ATTLIST entity
name CDATA #REQUIRED name CDATA #REQUIRED
natural-key CDATA #IMPLIED natural-key CDATA #IMPLIED
table CDATA #IMPLIED table CDATA #IMPLIED
foreign %Boolean; #IMPLIED foreign %Boolean; #IMPLIED
magnitude CDATA #IMPLIED> magnitude CDATA #IMPLIED
volatility CDATA #IMPLIED>
<!-- <!--
contains documentation on the element which immediately contains it. TODO: contains documentation on the element which immediately contains it. TODO:

19
resources/transforms/adl2canonical.xslt
View file

@ -82,22 +82,25 @@
</xsl:template> </xsl:template>
<!-- an entity which already has a key tag - just copy it through --> <!-- an entity which already has a key tag - just copy it through -->
<xsl:template match="adl:entity[adl:key]"> <xsl:template match="adl:entity[adl:key]">
<xsl:comment> <xsl:comment>
entity <xsl:value-of select="@name"/> already has a key - not generating one entity <xsl:value-of select="@name"/> already has a key - not generating one
</xsl:comment> </xsl:comment>
<entity> <entity>
<xsl:if test="not(@magnitude)"> <xsl:if test="not(@magnitude)">
<xsl:attribute name="magnitude">6</xsl:attribute> <xsl:attribute name="magnitude">6</xsl:attribute>
</xsl:if> </xsl:if>
<xsl:if test="not(@volatility)">
<xsl:attribute name="volatility">0</xsl:attribute>
</xsl:if>
<xsl:if test="not( @table)"> <xsl:if test="not( @table)">
<xsl:attribute name="table"> <xsl:attribute name="table">
<xsl:value-of select="concat( $tablename-prefix, @name)"/> <xsl:value-of select="concat( $tablename-prefix, @name)"/>
</xsl:attribute> </xsl:attribute>
</xsl:if> </xsl:if>
<xsl:apply-templates select="@* | node()"/> <xsl:apply-templates select="@* | node()"/>
</entity> </entity>
</xsl:template> </xsl:template>
<!-- an entity which has a '@natural-key' attribute. <!-- an entity which has a '@natural-key' attribute.
Since we've got the key tag, I think this should be disallowed --> Since we've got the key tag, I think this should be disallowed -->

74
src/adl/to_hugsql_queries.clj
View file

@ -321,80 +321,6 @@
})) }))
links)))) 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] (defn delete-query [entity]
"Generate an appropriate `delete` query for this `entity`" "Generate an appropriate `delete` query for this `entity`"

112
src/adl/to_json_routes.clj
View file

@ -48,6 +48,7 @@
:require :require
'[adl-support.core :as support] '[adl-support.core :as support]
'[clojure.java.io :as io] '[clojure.java.io :as io]
'[clojure.core.memoize :as memo]
'[compojure.core :refer [defroutes GET POST]] '[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql] '[hugsql.core :as hugsql]
'[noir.response :as nresponse] '[noir.response :as nresponse]
@ -60,24 +61,45 @@
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map))))) (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 (defn generate-handler-src
"Generate and return the handler for this `query`."
[handler-name query-map method doc] [handler-name query-map method doc]
(hash-map (hash-map
:method method :method method
:src :src (remove
(remove nil?
nil? (if
(list (or
'defn (zero? (volatility (:entity query-map)))
handler-name (#{:delete-1 :insert-1 :update-1} (:type query-map)))
(str "Auto-generated method to " doc) (concat
[{:keys ['params]}] (list
(list 'do (list (symbol (str "db/" (:name query-map))) 'params)) 'defn
(case handler-name
(:type query-map) (str "Auto-generated method to " doc))
(:delete-1 :update-1) (generate-handler-body query-map))
'(response/found "/") (concat
nil))))) (list
'def
handler-name
(list
'memo/ttl
(cons 'fn (generate-handler-body query-map))
:ttl/threshold
(* (volatility (:entity query-map)) 1000))))))))
(defn handler (defn handler
@ -100,7 +122,7 @@
(str "delete one record from the `" (str "delete one record from the `"
(-> query :entity :attrs :name) (-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `" "` table. Expects the following key(s) to be present in `params`: `"
(doall (-> query :entity :content :key :content keys)) (-> query :entity key-names)
"`.")) "`."))
:insert-1 :insert-1
(generate-handler-src (generate-handler-src
@ -108,9 +130,12 @@
(str "insert one record to the `" (str "insert one record to the `"
(-> query :entity :attrs :name) (-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `" "` 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 `" "`. Returns a map containing the keys `"
(pr-str (-> query :entity :content :key :content keys)) (-> query :entity key-names)
"` identifying the record created.")) "` identifying the record created."))
:update-1 :update-1
(generate-handler-src (generate-handler-src
@ -121,10 +146,12 @@
(pr-str (pr-str
(distinct (distinct
(sort (sort
(flatten (map
(cons #(keyword (:name (:attrs %)))
(-> query :entity :content :properties keys) (flatten
(-> query :entity :content :key :content keys)))))) (cons
(-> query :entity key-properties)
(-> query :entity insertable-properties)))))))
"`.")) "`."))
:select-1 :select-1
(generate-handler-src (generate-handler-src
@ -132,15 +159,9 @@
(str "select one record from the `" (str "select one record from the `"
(-> query :entity :attrs :name) (-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `" "` 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: `" "`. Returns a map containing the following keys: `"
(pr-str (map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
(distinct
(sort
(flatten
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`.")) "`."))
:select-many :select-many
(generate-handler-src (generate-handler-src
@ -149,26 +170,21 @@
(-> query :entity :attrs :name) (-> 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: `" "` 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 (pr-str
(distinct (map
(sort #(keyword (:name (:attrs %)))
(flatten (-> query :entity all-properties)))
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`.")) "`."))
:text-search :text-search
(generate-handler-src (generate-handler-src
handler-name query :get handler-name query :get
(str "select all records from the `" (str "select all records from the `"
(-> query :entity :attrs :name) (-> 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: `" "` 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 (pr-str
(distinct (map
(sort #(keyword (:name (:attrs %)))
(flatten (-> query :entity all-properties)))
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`.")) "`."))
(:select-many-to-many (:select-many-to-many
:select-one-to-many) :select-one-to-many)
@ -226,22 +242,16 @@
(try (try
(with-open [output (writer filepath)] (with-open [output (writer filepath)]
(binding [*out* output] (binding [*out* output]
(doall (pprint (file-header application))
(map (println)
(fn [f]
(pprint f)
(println "\n"))
(list
(file-header application)
(declarations handlers-map)
(defroutes handlers-map))))
(doall (doall
(map (map
(fn [h] (fn [h]
(pprint (:src (handlers-map h))) (pprint (:src (handlers-map h)))
(println) (println)
h) h)
(sort (keys handlers-map)))))) (sort (keys handlers-map))))
(pprint (defroutes handlers-map))))
(if (> *verbosity* 0) (if (> *verbosity* 0)
(println (str "\tGenerated " filepath))) (println (str "\tGenerated " filepath)))
(catch (catch

1
src/adl/to_selmer_routes.clj
View file

@ -198,6 +198,7 @@
(l/render (l/render
(support/resolve-template (support/resolve-template
"application-index.html") "application-index.html")
(:session r)
{:title "Administrative menu"}))) {:title "Administrative menu"})))
(println) (println)
(doall (doall