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/ generated/src/clj/youyesyet/routes/
*.iml *.iml
node_modules/

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

@ -3,9 +3,9 @@
* and the current value for {{widget_value}}. * and the current value for {{widget_value}}.
*/ */
$('#{{widget_id}}').selectize({ $('#{{widget_id}}').selectize({
valueField: 'id', valueField: '{{key}}',
labelField: 'name', labelField: '{{field}}',
searchField: 'name', searchField: '{{field}}',
hideSelected: false, hideSelected: false,
create: false, create: false,
@ -13,7 +13,7 @@ $('#{{widget_id}}').selectize({
console.log('Desperately seeking ' + query); console.log('Desperately seeking ' + query);
if (query === null || !query.length) return callback(); if (query === null || !query.length) return callback();
$.ajax({ $.ajax({
url: '/json/auto/search-strings-electors?name=' + query, url: '/json/auto/search-strings-{{entity}}?{{field}}=' + query,
type: 'GET', type: 'GET',
dataType: 'jsonp', dataType: 'jsonp',
error: function() { 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({ var simplemde = new SimpleMDE({
autosave: { autosave: {
enabled: true, enabled: true,
uniqueId: "Smeagol-{{page}}", uniqueId: "adl-generated-{{page}}",
delay: 1000, delay: 1000,
}, },
indentWithTabs: true, indentWithTabs: true,

49
src/adl/to_hugsql_queries.clj
View file

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

3
src/adl/to_json_routes.clj
View file

@ -85,10 +85,13 @@
(:delete-1 :update-1) (:delete-1 :update-1)
(list (list
action action
`(log/debug (str ~(:name query) " called with params " ~'params "."))
'(response/found "/")) '(response/found "/"))
(list (list
'let 'let
(vector 'result action) (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)))))) (list 'response/ok 'result))))))

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