diff --git a/resources/js/selectize-one.js b/resources/js/selectize-one.js
new file mode 100644
index 0000000..a45d578
--- /dev/null
+++ b/resources/js/selectize-one.js
@@ -0,0 +1,28 @@
+/**
+ * selectize one select widget. Substitute the actual id of the widget for `{{widget_id}}`.
+ */
+$('#{{widget_id}}').selectize({
+ valueField: 'id',
+ labelField: 'name',
+ searchField: 'name',
+ options: [],
+ create: false,
+
+ load: function(query, callback) {
+ console.log('Desperately seeking ' + query);
+ if (query === null || !query.length) return callback();
+ $.ajax({
+ url: '/json/auto/search-strings-electors?name=' + query,
+ type: 'GET',
+ dataType: 'jsonp',
+ error: function() {
+ console.log( 'Query ' + query + ' failed.');
+ callback();
+ },
+ success: function(res) {
+ console.log('Received ' + res + ' records for ' + query);
+ callback(res);
+ }
+ });
+ }
+});
diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj
index e016a3f..272c007 100644
--- a/src/adl/to_selmer_routes.clj
+++ b/src/adl/to_selmer_routes.clj
@@ -53,6 +53,7 @@
'[clojure.java.io :as io]
'[clojure.set :refer [subset?]]
'[clojure.tools.logging :as log]
+ '[clojure.walk :refer [keywordize-keys]]
'[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql]
'[noir.response :as nresponse]
@@ -65,35 +66,57 @@
(defn make-form-handler-content
[f e a n]
- (let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")]
+ (let [warning (list 'str (str "Error while fetching " (singularise (:name (:attrs e))) " record ") 'params)]
;; TODO: as yet makes no attempt to save the record
(list 'let
(vector
- 'record (list
- 'support/do-or-log-error
- (list 'if (list 'subset? (key-names e) (set (list 'keys 'p)))
- (list
- (symbol
- (str "db/get-" (singularise (:name (:attrs e)))))
- (symbol "db/*db*")
- 'p))
- :message warning
- :error-return {:warnings [warning]}))
+ 'record (list
+ 'support/do-or-log-error
+ ;;(list 'if (list 'subset? (key-names e) (list 'set (list 'keys 'params)))
+ (list
+ (symbol
+ (str "db/get-" (singularise (:name (:attrs e)))))
+ (symbol "db/*db*")
+ 'params)
+ ;;)
+ :message warning
+ :error-return {:warnings [warning]}))
(reduce
- merge
- {:warnings (list :warnings 'record)
- :record (list 'assoc 'record :warnings nil)}
- (map
- (fn [p]
- (hash-map
- (keyword (-> p :attrs :entity))
- (list 'support/do-or-log-error
- (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))
- :message (str "Error while fetching "
- (singularise (:entity (:attrs p)))
- " record"))))
- (filter #(#{"entity" "link"} (:type (:attrs %)))
- (descendants-with-tag e :property)))))))
+ merge
+ {:error (list :warnings 'record)
+ :record (list 'dissoc 'record :warnings)}
+ (map
+ (fn [property]
+ (hash-map
+ (keyword (-> property :attrs :name))
+ (list
+ 'flatten
+ (list
+ 'remove
+ 'nil?
+ (list
+ 'list
+ ;; Get the current value of the property, if it's an entity
+ (if (= (-> property :attrs :type) "entity")
+ (list 'support/do-or-log-error
+ (list
+ (symbol
+ (str "db/get-" (singularise (:entity (:attrs property)))))
+ (symbol "db/*db*")
+ (hash-map (keyword (-> property :attrs :farkey))
+ (list (keyword (-> property :attrs :name)) 'record)))
+ :message (str "Error while fetching "
+ (singularise (:entity (:attrs property)))
+ " record " (hash-map (keyword (-> property :attrs :farkey))
+ (list (keyword (-> property :attrs :name)) 'record)))))
+ ;;; and the potential values of the property
+ (list 'support/do-or-log-error
+ (list (symbol (str "db/list-" (:entity (:attrs property)))) (symbol "db/*db*"))
+ :message (str "Error while fetching "
+ (singularise (:entity (:attrs property)))
+ " list")))))))
+ (filter #(:entity (:attrs %))
+ (descendants-with-tag e :property)))))))
(defn make-page-handler-content
@@ -107,7 +130,7 @@
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*")
- 'p))
+ 'params))
:message warning
:error-return {:warnings [warning]}))
{:warnings (list :warnings 'record)
@@ -124,17 +147,14 @@
'if
(list
'some
- (set (map #(-> % :attrs :name) (all-properties e)))
- (list 'keys 'p))
+ (set (map #(keyword (-> % :attrs :name)) (all-properties e)))
+ (list 'keys 'params))
(list
'support/do-or-log-error
(list
- (symbol
- (str
- "db/search-strings-"
- (singularise (:name (:attrs e)))))
+ (symbol (str "db/search-strings-" (:name (:attrs e))))
(symbol "db/*db*")
- 'p)
+ 'params)
:message (str
"Error while searching "
(singularise (:name (:attrs e)))
@@ -171,10 +191,13 @@
(list
'defn
(symbol n)
- (vector 'r)
+ (vector 'request)
(list 'let (vector
- 'p
- (list 'support/massage-params (list :params 'r) (list :form-params 'r) (key-names e)))
+ 'params
+ (list 'support/massage-params
+ (list 'keywordize-keys (list :params 'request))
+ (list 'keywordize-keys (list :form-params 'request))
+ (key-names e true)))
;; TODO: we must take key params out of just params,
;; but we should take all other params out of form-params - because we need the key to
;; load the form in the first place, but just accepting values of other params would
@@ -182,71 +205,74 @@
(list
'l/render
(list 'support/resolve-template (str n ".html"))
- (list :session 'r)
+ (list :session 'request)
(list 'merge
{:title (capitalise (:name (:attrs f)))
- :params 'p}
+ :params 'params}
(case (:tag f)
- (:form :page)
- (list
- 'reduce
- 'merge
- (list 'merge
- (list 'cond (list :save-button 'p)
- (list 'try
- (list 'if
- (list 'some (key-names e) (list 'map 'name (list 'keys 'p)))
- (list 'do
- (list (symbol
- (str "db/update-" (singularise (-> e :attrs :name)) "!"))
- 'db/*db*
- 'p)
- {:message "Updated record"})
- (list 'do
- (list (symbol
- (str "db/create-" (singularise (-> e :attrs :name)) "!"))
- 'db/*db*
- 'p)
- {:message "Saved record"}))
- `(catch Exception any#
- {:error (.getMessage any#)})))
- {:record
- (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
- (list
- (symbol
- (str "db/get-" (singularise (:name (:attrs e)))))
- (symbol "db/*db*")
- 'p))})
- (cons 'list
- (map
- (fn [p]
- (hash-map
- (keyword (-> p :attrs :entity))
- (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))))
- (filter #(#{"entity" "link"} (:type (:attrs %)))
- (descendants-with-tag e :property)))))
- :list
- {:records
- (list
- 'if
- (list
- 'not
- (list
- 'empty?
- (list 'remove 'nil? (list 'vals 'p))))
- (list
- (symbol
- (str
- "db/search-strings-"
- (:name (:attrs e))))
- (symbol "db/*db*")
- 'p)
- (list
- (symbol
- (str
- "db/list-"
- (:name (:attrs e))))
- (symbol "db/*db*") {}))})))))))
+ :form (make-form-handler-content f e a n)
+ :page (make-page-handler-content f e a n)
+ :list (make-list-handler-content f e a n))))))))
+;; (:form :page)
+;; (list
+;; 'reduce
+;; 'merge
+;; (list 'merge
+;; (list 'cond (list :save-button 'p)
+;; (list 'try
+;; (list 'if
+;; (list 'some (key-names e) (list 'map 'name (list 'keys 'p)))
+;; (list 'do
+;; (list (symbol
+;; (str "db/update-" (singularise (-> e :attrs :name)) "!"))
+;; 'db/*db*
+;; 'p)
+;; {:message "Updated record"})
+;; (list 'do
+;; (list (symbol
+;; (str "db/create-" (singularise (-> e :attrs :name)) "!"))
+;; 'db/*db*
+;; 'p)
+;; {:message "Saved record"}))
+;; `(catch Exception any#
+;; {:error (.getMessage any#)})))
+;; {:record
+;; (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
+;; (list
+;; (symbol
+;; (str "db/get-" (singularise (:name (:attrs e)))))
+;; (symbol "db/*db*")
+;; 'p))})
+;; (cons 'list
+;; (map
+;; (fn [p]
+;; (hash-map
+;; (keyword (-> p :attrs :entity))
+;; (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))))
+;; (filter #(#{"entity" "link"} (:type (:attrs %)))
+;; (descendants-with-tag e :property)))))
+;; :list
+;; {:records
+;; (list
+;; 'if
+;; (list
+;; 'not
+;; (list
+;; 'empty?
+;; (list 'remove 'nil? (list 'vals 'p))))
+;; (list
+;; (symbol
+;; (str
+;; "db/search-strings-"
+;; (:name (:attrs e))))
+;; (symbol "db/*db*")
+;; 'p)
+;; (list
+;; (symbol
+;; (str
+;; "db/list-"
+;; (:name (:attrs e))))
+;; (symbol "db/*db*") {}))})))))))
;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml"))
;; (def e (child-with-tag a :entity))
diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj
index 027d367..ff1b30e 100644
--- a/src/adl/to_selmer_templates.clj
+++ b/src/adl/to_selmer_templates.clj
@@ -258,12 +258,16 @@
(:farkey (:attrs property))
(first (key-names farside))
"id")]
- [(str "{% for r in " farname " %}{% endfor %}")]))
@@ -292,50 +296,20 @@
(defn select-widget
- ;; TODO: rewrite for selectize https://github.com/selectize/selectize.js/blob/master/docs/usage.md
- ;; https://gist.github.com/zabolotnov87/11142887
[property form entity application]
(let [farname (:entity (:attrs property))
farside (first (children application #(= (:name (:attrs %)) farname)))
magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7))
async? (and (number? magnitude) (> magnitude 1))
widget-name (safe-name (:name (:attrs property)) :sql)]
- {:tag :span
- :attrs {:class "select-box" :farside farname :found (if farside "true" "false")}
- :content
- (apply
- vector
- (remove
- nil?
- (flatten
- (list
- (if
- async?
- (list
- {:tag :input
- :attrs
- {:name (str widget-name "_search_box")
- :onchange (str "$.getJSON(\"/auto/json/seach-strings-"
- (-> farside :attrs :name)
- "?"
- (s/join (str "=\" + " widget-name "_search_box.text + \"&")
- (user-distinct-property-names farside))
- (str "=\" + " widget-name "_search_box.text")
- ", null, function (data) {updateMenuOptions(\""
- widget-name "\", \""
- (first (key-names farside))
- "\", [\""
- (s/join "\", \"" (user-distinct-property-names farside))
- "\"], data);})")}}
- {:tag :br}))
- {:tag :select
- :attrs (merge
- {:id widget-name
- :name widget-name}
- (if
- (= (:type (:attrs property)) "link")
- {:multiple "multiple"}))
- :content (apply vector (get-options property form entity application))}))))}))
+ {:tag :select
+ :attrs (merge
+ {:id widget-name
+ :name widget-name}
+ (if
+ (= (:type (:attrs property)) "link")
+ {:multiple "multiple"}))
+ :content (apply vector (get-options property form entity application))}))
(defn compose-readable-or-not-authorised
@@ -353,8 +327,7 @@
:name w
:class "pseudo-widget not-authorised"}
:content [(str "You are not permitted to view " w " of " (:name (:attrs e)))]}
- "{% endifmemberof %}"
- ))
+ "{% endifmemberof %}"))
(defn compose-widget-para
@@ -454,7 +427,7 @@
(defn embed-script-fragment
- "Return the content of the file at `fielpath`, with these `substitutions`
+ "Return the content of the file at `filepath`, with these `substitutions`
made into it in order. Substitutions should be pairss [`pattern` `value`],
where `pattern` is a string, a char, or a regular expression."
([filepath substitutions]
@@ -603,31 +576,53 @@
(defn compose-form-extra-head
[form entity application]
{:extra-head
- (if
- (some
- #(= "text-area" (widget-type % application)) (properties entity))
- "{% script \"js/lib/node_modules/simplemde/dist/simplemde.min.js\" %}
- {% style \"js/lib/node_modules/simplemde/dist/simplemde.min.css\" %}")})
+ (apply
+ str
+ (remove
+ nil?
+ (list
+ (if
+ (some
+ #(= "text-area" (widget-type % application)) (properties entity))
+ "
+ {% 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))
+ "
+ {% script \"/js/lib/node_modules/selectize/dist/js/standalone/selectize.min.js\" %}
+ {% style \"/js/lib/node_modules/selectize/dist/css/selectize.css\" %}"))))})
- (defn compose-form-extra-tail
- [form entity application]
- {:extra-tail
- {:tag :script :attrs {:type "text/javascript"}
- :content
- (apply
- vector
- (remove
- nil?
- (list
- (if
- (some
- #(= "select" (widget-type % application)) (properties entity))
- (embed-script-fragment "resources/js/select-widget-support.js"))
- (if
- (some
- #(= "text-area" (widget-type % application)) (properties entity))
- (embed-script-fragment "resources/js/text-area-md-support.js")))))}})
+(defn compose-form-extra-tail
+ [form entity application]
+ {:extra-tail
+ {:tag :script :attrs {:type "text/javascript"}
+ :content
+ (apply
+ vector
+ (remove
+ nil?
+ (flatten
+ (list
+ (map
+ (fn [property]
+ (let
+ [farname (:entity (:attrs property))
+ farside (first (children application #(= (:name (:attrs %)) farname)))
+ magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7))]
+ (if
+ (> magnitude 2)
+ (embed-script-fragment
+ "resources/js/selectize-one.js"
+ [["{{widget_id}}" (-> property :attrs :name)]]
+ ))))
+ (children-with-tag entity :property #(= (-> % :attrs :type) "entity")))
+ (if
+ (some
+ #(= "text-area" (widget-type % application)) (properties entity))
+ (embed-script-fragment "resources/js/text-area-md-support.js"))))))}})
(defn form-to-template