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

Improvements to menus and lists.

Browse source
This commit is contained in:
Simon Brooke 2018-07-17 09:01:27 +01:00
parent 8d32850b8f
commit 2ec8f4a928
6 changed files with 126 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
.gitignore vendored
View file

@ -20,3 +20,6 @@ generated/resources/templates/auto/
generated/src/clj/youyesyet/routes/
*.iml
node_modules/

10
resources/js/selectize-one.js
View file

@ -3,9 +3,9 @@
* and the current value for {{widget_value}}.
*/
$('#{{widget_id}}').selectize({
valueField: 'id',
labelField: 'name',
searchField: 'name',
valueField: '{{key}}',
labelField: '{{field}}',
searchField: '{{field}}',
hideSelected: false,
create: false,
@ -13,7 +13,7 @@ $('#{{widget_id}}').selectize({
console.log('Desperately seeking ' + query);
if (query === null || !query.length) return callback();
$.ajax({
url: '/json/auto/search-strings-electors?name=' + query,
url: '/json/auto/search-strings-{{entity}}?{{field}}=' + query,
type: 'GET',
dataType: 'jsonp',
error: function() {
@ -26,4 +26,4 @@ $('#{{widget_id}}').selectize({
}
});
}
})[0].selectize.setValue({{widget_value}}, true);
})[0].selectize.setValue('{{widget_value}}', true);

2
resources/js/text-area-md-support.js
View file

@ -1,7 +1,7 @@
var simplemde = new SimpleMDE({
autosave: {
enabled: true,
uniqueId: "Smeagol-{{page}}",
uniqueId: "adl-generated-{{page}}",
delay: 1000,
},
indentWithTabs: true,

51
src/adl/to_hugsql_queries.clj
View file

@ -32,6 +32,8 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def expanded-token "_expanded")
(defn where-clause
"Generate an appropriate `where` clause for queries on this `entity`;
@ -55,14 +57,14 @@
(defn order-by-clause
"Generate an appropriate `order by` clause for queries on this `entity`"
([entity]
(order-by-clause entity ""))
(order-by-clause entity "" false))
([entity prefix]
(order-by-clause entity prefix false))
([entity prefix expanded?]
(let
[entity-name (safe-name (:name (:attrs entity)) :sql)
preferred (map
#(safe-name (:name (:attrs %)) :sql)
(filter #(#{"user" "all"} (-> % :attrs :distinct))
(children entity #(= (:tag %) :property))))]
preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
(children entity #(= (:tag %) :property)))]
(if
(empty? preferred)
""
@ -71,8 +73,15 @@
(s/join
(str ",\n\t" prefix entity-name ".")
(map
#(safe-name % :sql)
(flatten (cons preferred (key-names entity))))))))))
#(if
(and expanded? (= "entity" (-> % :attrs :type)))
(str (safe-name % :sql) expanded-token)
(safe-name % :sql))
(flatten (cons preferred (key-properties entity))))))))))
;; (def a (x/parse "../youyesyet/youyesyet.adl.xml"))
;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name))))
;; (order-by-clause e "" true)
(defn insert-query
@ -163,35 +172,39 @@
(s/join
"\n\t--~ "
(cons
"WHERE false"
"WHERE true"
(filter
string?
(map
#(str
"(if (:" (-> % :attrs :name) " params) (str \"OR "
#(let
[sn (safe-name (-> % :attrs :name) :sql)]
(str
"(if (:" (-> % :attrs :name) " params) (str \"AND "
(case (-> % :attrs :type)
("string" "text")
(str
(safe-name (-> % :attrs :name) :sql)
" LIKE '%\" (:" (-> % :attrs :name) " params) \"%'")
sn
" LIKE '%\" (:" (-> % :attrs :name) " params) \"%' ")
("date" "time" "timestamp")
(str
(safe-name (-> % :attrs :name) :sql)
sn
" = ':" (-> % :attrs :name) "'")
"entity"
(str
(safe-name (-> % :attrs :name) :sql)
sn
"_expanded LIKE '%\" (:" (-> % :attrs :name) " params) \"%'")
(str
(safe-name (-> % :attrs :name) :sql)
sn
" = :"
(-> % :attrs :name)))
"\"))")
"\"))"))
properties))))
(order-by-clause entity "lv_")
(order-by-clause entity "lv_" true)
"--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
;; (search-query e a)
(defn select-query
"Generate an appropriate `select` query for this `entity`"
@ -257,7 +270,7 @@
(str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-name " records")
(str "SELECT DISTINCT * FROM lv_" entity-name)
(order-by-clause entity "lv_")
(order-by-clause entity "lv_" false)
"--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
@ -304,7 +317,7 @@
(str "WHERE lv_" entity-name "." (first (key-names entity)) " = "
entity-name "." (first (key-names entity))
"\n\tAND " entity-name "." link-field " = :id")
(order-by-clause entity "lv_"))
(order-by-clause entity "lv_" false))
"link" (let [link-table-name
(link-table-name % entity far-entity)]
(list

3
src/adl/to_json_routes.clj
View file

@ -85,10 +85,13 @@
(:delete-1 :update-1)
(list
action
`(log/debug (str ~(:name query) " called with params " ~'params "."))
'(response/found "/"))
(list
'let
(vector 'result action)
`(log/debug (~(symbol (str "db/" (:name query) "-sqlvec")) ~'params))
`(log/debug (str ~(str "'" (:name query) "' with params ") ~'params " returned " (count ~'result) " records."))
(list 'response/ok 'result))))))

158
src/adl/to_selmer_templates.clj
View file

@ -1,7 +1,8 @@
(ns ^{:doc "Application Description Language - generate Selmer templates for the HTML pages implied by an ADL file."
:author "Simon Brooke"}
adl.to-selmer-templates
(:require [adl-support.utils :refer :all]
(:require [adl.to-hugsql-queries :refer [expanded-token]]
[adl-support.utils :refer :all]
[clojure.java.io :refer [file make-parents]]
[clojure.pprint :as p]
[clojure.string :as s]
@ -70,7 +71,7 @@
(with-out-str
(x/emit-element content))
(seq? content)
(map emit-content content)
(map emit-content (remove nil? content))
true
(str "<!-- don't know what to do with '" content "' -->"))
(catch Exception any
@ -80,8 +81,8 @@
"';\n"
(-> any .getClass .getName)
": "
(-> any .getMessage
" -->")))))
(-> any .getMessage)
" -->"))))
([filename application k]
(emit-content filename nil nil application k))
([filename spec entity application k]
@ -140,26 +141,6 @@
(emit-content filename spec entity application :foot))))))
(defn prompt
"Return an appropriate prompt for the given `field-or-property` taken from this
`form` of this `entity` of this `application`, in the context of the current
binding of `*locale*`. TODO: something more sophisticated about i18n"
([field-or-property form entity application]
(prompt field-or-property))
([field-or-property]
(capitalise
(or
(first
(children
field-or-property
#(and
(= (:tag %) :prompt)
(= (:locale :attrs %) *locale*))))
(:name (:attrs field-or-property))
(:property (:attrs field-or-property))
"Missing prompt"))))
(defn csrf-widget
"For the present, just return the standard cross site scripting protection field statement"
[]
@ -240,6 +221,24 @@
application))
(defn select-property
"Return the property on which we will by default do a user search on this `entity`."
[entity]
(descendant-with-tag
entity
:property
#(#{"user" "all"} (-> % :attrs :distinct))))
(defn select-field-name
[entity]
(let [p (select-property entity)]
(if
(-> p :attrs :entity)
(str (safe-name p :sql) expanded-token)
(-> p :attrs :name))))
(defn get-options
"Produce template code to get options for this `property` of this `entity` taken from
this `application`."
@ -267,14 +266,8 @@
"}}' {% ifequal record."
(-> property :attrs :name)
" option." farkey "%}selected='selected'{% endifequal %}>"
(s/join " " (map
#(str
"{{option."
(:name (:attrs %))
(if (= (-> % :attrs :type) "entity") "_expanded")
"}}")
fs-distinct))
"</option>{% endfor %}")]))
"{{option." (select-field-name farside)
"}}</option>{% endfor %}")]))
(defn widget-type
@ -371,15 +364,12 @@
(if (= (:tag field-or-property) :property)
(:name (:attrs field-or-property))
(:property (:attrs field-or-property))) :sql)
property (if
(= (:tag field-or-property) :property)
field-or-property
(first
(filter
#(= (:name (:attrs %))
(:property (:attrs field-or-property)))
(descendants-with-tag entity
:property))))
property (case
(:tag field-or-property)
:property field-or-property
:field (property-for-field field-or-property entity)
;; default
nil)
permissions (find-permissions field-or-property property form entity application)
typedef (typedef property application)
w-type (widget-type property application typedef)
@ -440,7 +430,9 @@
(let [v (slurp filepath)]
(reduce
(fn [s [pattern value]]
(s/replace s pattern value))
(if (and pattern value)
(s/replace s pattern value)
s))
v
substitutions)))
([filepath]
@ -555,28 +547,30 @@
vector
(cons
{:tag :form
:attrs {:action (str "{{servlet-context}}/" (editor-name entity application))
:method "POST"}
:content (apply
vector
(flatten
(list
(csrf-widget)
(map
#(widget % form entity application)
(children-with-tag (child-with-tag entity :key) :properties))
(map
#(widget % form entity application)
(remove
#(let
[property (filter
(fn [p] (= (:name (:attrs p)) (:property (:attrs %))))
(descendants-with-tag entity :property))]
(= (:distict (:attrs property)) :system))
(children-with-tag form :field)))
(save-widget form entity application)
(delete-widget form entity application))))}
(compose-form-auxlists form entity application)))}})
:attrs {:action (str "{{servlet-context}}/" (editor-name entity application))
:method "POST"}
:content (apply
vector
(remove
nil?
(flatten
(list
(csrf-widget)
(map
#(widget % form entity application)
(children-with-tag (child-with-tag entity :key) :property))
(map
#(widget % form entity application)
(remove
#(let
[property (filter
(fn [p] (= (:name (:attrs p)) (:property (:attrs %))))
(descendants-with-tag entity :property))]
(= (:distict (:attrs property)) :system))
(children-with-tag form :field)))
(save-widget form entity application)
(delete-widget form entity application)))))}
(compose-form-auxlists form entity application)))}})
(defn compose-form-extra-head
@ -588,14 +582,18 @@
nil?
(list
(if
(some
#(= "text-area" (widget-type % application)) (properties entity))
(child-with-tag
form
:field
#(= "text-area" (widget-type (property-for-field % entity) application)))
"
{% script \"js/lib/node_modules/simplemde/dist/simplemde.min.js\" %}
{% style \"js/lib/node_modules/simplemde/dist/simplemde.min.css\" %}")
(if
(some
#(= "select" (widget-type % application)) (properties entity))
(child-with-tag
form
:field
#(= "select" (widget-type (property-for-field % entity) application)))
"
{% script \"/js/lib/node_modules/selectize/dist/js/standalone/selectize.min.js\" %}
{% style \"/js/lib/node_modules/selectize/dist/css/selectize.css\" %}"))))})
@ -613,9 +611,12 @@
(flatten
(list
(map
(fn [property]
(fn [field]
(let
[farname (:entity (:attrs property))
[property (child-with-tag entity :property #(=
(-> field :attrs :property)
(-> % :attrs :name)))
farname (:entity (:attrs property))
farside (first (children application #(= (:name (:attrs %)) farname)))
magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7))]
(if
@ -623,12 +624,17 @@
(embed-script-fragment
"resources/js/selectize-one.js"
[["{{widget_id}}" (-> property :attrs :name)]
["{{widget_value}}" (str "{{record." (-> property :attrs :name) "}}")]]
))))
(children-with-tag entity :property #(= (-> % :attrs :type) "entity")))
["{{widget_value}}" (str "{{record." (-> property :attrs :name) "}}")]
["{{entity}}" farname]
["{{field}}" (select-field-name farside)]
["{{key}}" (first (key-names farside))]]))))
(children-with-tag
form :field
#(= "select" (widget-type (property-for-field % entity) application))))
(if
(some
#(= "text-area" (widget-type % application)) (properties entity))
(child-with-tag
form :field
#(= "text-area" (widget-type (property-for-field % entity) application)))
(embed-script-fragment "resources/js/text-area-md-support.js"))))))}})
@ -690,7 +696,7 @@
vector
(map
#(hash-map
:content [(prompt %)]
:content [(prompt % list-spec entity application)]
:tag :th)
(children-with-tag list-spec :field)))
{:tag :th :content ["&nbsp;"]})}