From 2ec8f4a928e197a18db5e0c48968f455cdd14807 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 17 Jul 2018 09:01:27 +0100 Subject: [PATCH] Improvements to menus and lists. --- .gitignore | 3 + resources/js/selectize-one.js | 10 +- resources/js/text-area-md-support.js | 2 +- src/adl/to_hugsql_queries.clj | 51 +++++---- src/adl/to_json_routes.clj | 3 + src/adl/to_selmer_templates.clj | 158 ++++++++++++++------------- 6 files changed, 126 insertions(+), 101 deletions(-) diff --git a/.gitignore b/.gitignore index faf3ae7..d388cc3 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,6 @@ generated/resources/templates/auto/ generated/src/clj/youyesyet/routes/ *.iml + +node_modules/ + diff --git a/resources/js/selectize-one.js b/resources/js/selectize-one.js index 7deb265..f248b6f 100644 --- a/resources/js/selectize-one.js +++ b/resources/js/selectize-one.js @@ -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); diff --git a/resources/js/text-area-md-support.js b/resources/js/text-area-md-support.js index d7fb7aa..6923b42 100644 --- a/resources/js/text-area-md-support.js +++ b/resources/js/text-area-md-support.js @@ -1,7 +1,7 @@ var simplemde = new SimpleMDE({ autosave: { enabled: true, - uniqueId: "Smeagol-{{page}}", + uniqueId: "adl-generated-{{page}}", delay: 1000, }, indentWithTabs: true, diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index f45dcc2..fe9e6d8 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -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 diff --git a/src/adl/to_json_routes.clj b/src/adl/to_json_routes.clj index 5d59257..0c3dee8 100644 --- a/src/adl/to_json_routes.clj +++ b/src/adl/to_json_routes.clj @@ -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)))))) diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj index 76cb484..5d93c85 100644 --- a/src/adl/to_selmer_templates.clj +++ b/src/adl/to_selmer_templates.clj @@ -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 "")) (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)) - "{% endfor %}")])) + "{{option." (select-field-name farside) + "}}{% 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 [" "]})}