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

Selectize working.

Browse source
This commit is contained in:
Simon Brooke 2018-07-10 15:46:59 +01:00
parent b5f1190c13
commit 54029c2941
3 changed files with 214 additions and 165 deletions
Download patch file Download diff file Expand all files Collapse all files

28
resources/js/selectize-one.js Normal file
View file

@ -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);
}
});
}
});

222
src/adl/to_selmer_routes.clj
View file

@ -53,6 +53,7 @@
'[clojure.java.io :as io] '[clojure.java.io :as io]
'[clojure.set :refer [subset?]] '[clojure.set :refer [subset?]]
'[clojure.tools.logging :as log] '[clojure.tools.logging :as log]
'[clojure.walk :refer [keywordize-keys]]
'[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]
@ -65,35 +66,57 @@
(defn make-form-handler-content (defn make-form-handler-content
[f e a n] [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 ;; TODO: as yet makes no attempt to save the record
(list 'let (list 'let
(vector (vector
'record (list 'record (list
'support/do-or-log-error 'support/do-or-log-error
(list 'if (list 'subset? (key-names e) (set (list 'keys 'p))) ;;(list 'if (list 'subset? (key-names e) (list 'set (list 'keys 'params)))
(list (list
(symbol (symbol
(str "db/get-" (singularise (:name (:attrs e))))) (str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*") (symbol "db/*db*")
'p)) 'params)
:message warning ;;)
:error-return {:warnings [warning]})) :message warning
:error-return {:warnings [warning]}))
(reduce (reduce
merge merge
{:warnings (list :warnings 'record) {:error (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)} :record (list 'dissoc 'record :warnings)}
(map (map
(fn [p] (fn [property]
(hash-map (hash-map
(keyword (-> p :attrs :entity)) (keyword (-> property :attrs :name))
(list 'support/do-or-log-error (list
(list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*")) 'flatten
:message (str "Error while fetching " (list
(singularise (:entity (:attrs p))) 'remove
" record")))) 'nil?
(filter #(#{"entity" "link"} (:type (:attrs %))) (list
(descendants-with-tag e :property))))))) '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 (defn make-page-handler-content
@ -107,7 +130,7 @@
(symbol (symbol
(str "db/get-" (singularise (:name (:attrs e))))) (str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*") (symbol "db/*db*")
'p)) 'params))
:message warning :message warning
:error-return {:warnings [warning]})) :error-return {:warnings [warning]}))
{:warnings (list :warnings 'record) {:warnings (list :warnings 'record)
@ -124,17 +147,14 @@
'if 'if
(list (list
'some 'some
(set (map #(-> % :attrs :name) (all-properties e))) (set (map #(keyword (-> % :attrs :name)) (all-properties e)))
(list 'keys 'p)) (list 'keys 'params))
(list (list
'support/do-or-log-error 'support/do-or-log-error
(list (list
(symbol (symbol (str "db/search-strings-" (:name (:attrs e))))
(str
"db/search-strings-"
(singularise (:name (:attrs e)))))
(symbol "db/*db*") (symbol "db/*db*")
'p) 'params)
:message (str :message (str
"Error while searching " "Error while searching "
(singularise (:name (:attrs e))) (singularise (:name (:attrs e)))
@ -171,10 +191,13 @@
(list (list
'defn 'defn
(symbol n) (symbol n)
(vector 'r) (vector 'request)
(list 'let (vector (list 'let (vector
'p 'params
(list 'support/massage-params (list :params 'r) (list :form-params 'r) (key-names e))) (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, ;; 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 ;; 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 ;; load the form in the first place, but just accepting values of other params would
@ -182,71 +205,74 @@
(list (list
'l/render 'l/render
(list 'support/resolve-template (str n ".html")) (list 'support/resolve-template (str n ".html"))
(list :session 'r) (list :session 'request)
(list 'merge (list 'merge
{:title (capitalise (:name (:attrs f))) {:title (capitalise (:name (:attrs f)))
:params 'p} :params 'params}
(case (:tag f) (case (:tag f)
(:form :page) :form (make-form-handler-content f e a n)
(list :page (make-page-handler-content f e a n)
'reduce :list (make-list-handler-content f e a n))))))))
'merge ;; (:form :page)
(list 'merge ;; (list
(list 'cond (list :save-button 'p) ;; 'reduce
(list 'try ;; 'merge
(list 'if ;; (list 'merge
(list 'some (key-names e) (list 'map 'name (list 'keys 'p))) ;; (list 'cond (list :save-button 'p)
(list 'do ;; (list 'try
(list (symbol ;; (list 'if
(str "db/update-" (singularise (-> e :attrs :name)) "!")) ;; (list 'some (key-names e) (list 'map 'name (list 'keys 'p)))
'db/*db* ;; (list 'do
'p) ;; (list (symbol
{:message "Updated record"}) ;; (str "db/update-" (singularise (-> e :attrs :name)) "!"))
(list 'do ;; 'db/*db*
(list (symbol ;; 'p)
(str "db/create-" (singularise (-> e :attrs :name)) "!")) ;; {:message "Updated record"})
'db/*db* ;; (list 'do
'p) ;; (list (symbol
{:message "Saved record"})) ;; (str "db/create-" (singularise (-> e :attrs :name)) "!"))
`(catch Exception any# ;; 'db/*db*
{:error (.getMessage any#)}))) ;; 'p)
{:record ;; {:message "Saved record"}))
(list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) [] ;; `(catch Exception any#
(list ;; {:error (.getMessage any#)})))
(symbol ;; {:record
(str "db/get-" (singularise (:name (:attrs e))))) ;; (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
(symbol "db/*db*") ;; (list
'p))}) ;; (symbol
(cons 'list ;; (str "db/get-" (singularise (:name (:attrs e)))))
(map ;; (symbol "db/*db*")
(fn [p] ;; 'p))})
(hash-map ;; (cons 'list
(keyword (-> p :attrs :entity)) ;; (map
(list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*")))) ;; (fn [p]
(filter #(#{"entity" "link"} (:type (:attrs %))) ;; (hash-map
(descendants-with-tag e :property))))) ;; (keyword (-> p :attrs :entity))
:list ;; (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))))
{:records ;; (filter #(#{"entity" "link"} (:type (:attrs %)))
(list ;; (descendants-with-tag e :property)))))
'if ;; :list
(list ;; {:records
'not ;; (list
(list ;; 'if
'empty? ;; (list
(list 'remove 'nil? (list 'vals 'p)))) ;; 'not
(list ;; (list
(symbol ;; 'empty?
(str ;; (list 'remove 'nil? (list 'vals 'p))))
"db/search-strings-" ;; (list
(:name (:attrs e)))) ;; (symbol
(symbol "db/*db*") ;; (str
'p) ;; "db/search-strings-"
(list ;; (:name (:attrs e))))
(symbol ;; (symbol "db/*db*")
(str ;; 'p)
"db/list-" ;; (list
(:name (:attrs e)))) ;; (symbol
(symbol "db/*db*") {}))}))))))) ;; (str
;; "db/list-"
;; (:name (:attrs e))))
;; (symbol "db/*db*") {}))})))))))
;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml")) ;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml"))
;; (def e (child-with-tag a :entity)) ;; (def e (child-with-tag a :entity))

129
src/adl/to_selmer_templates.clj
View file

@ -258,12 +258,16 @@
(:farkey (:attrs property)) (:farkey (:attrs property))
(first (key-names farside)) (first (key-names farside))
"id")] "id")]
[(str "{% for r in " farname " %}<option value='{{r." ;; Yes, I know it looks BONKERS generating this as an HTML string. But there is a
;; reason. We don't know whether the `selected` attribute should be present or
;; absent until rendering.
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey farkey
"}}' {% ifequal record." "}}' {% ifequal record."
(-> property :attrs :name) (-> property :attrs :name)
" r." farkey "%}selected{% endifequal %}>" " option." farkey "%}selected{% endifequal %}>"
(s/join " " (map #(str "{{r." (:name (:attrs %)) "}}") fs-distinct)) (s/join " " (map #(str "{{option." (:name (:attrs %)) "}}") fs-distinct))
"</option>{% endfor %}")])) "</option>{% endfor %}")]))
@ -292,50 +296,20 @@
(defn select-widget (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] [property form entity application]
(let [farname (:entity (:attrs property)) (let [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))
async? (and (number? magnitude) (> magnitude 1)) async? (and (number? magnitude) (> magnitude 1))
widget-name (safe-name (:name (:attrs property)) :sql)] widget-name (safe-name (:name (:attrs property)) :sql)]
{:tag :span {:tag :select
:attrs {:class "select-box" :farside farname :found (if farside "true" "false")} :attrs (merge
:content {:id widget-name
(apply :name widget-name}
vector (if
(remove (= (:type (:attrs property)) "link")
nil? {:multiple "multiple"}))
(flatten :content (apply vector (get-options property form entity application))}))
(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 + \"&amp;")
(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))}))))}))
(defn compose-readable-or-not-authorised (defn compose-readable-or-not-authorised
@ -353,8 +327,7 @@
:name w :name w
:class "pseudo-widget not-authorised"} :class "pseudo-widget not-authorised"}
:content [(str "You are not permitted to view " w " of " (:name (:attrs e)))]} :content [(str "You are not permitted to view " w " of " (:name (:attrs e)))]}
"{% endifmemberof %}" "{% endifmemberof %}"))
))
(defn compose-widget-para (defn compose-widget-para
@ -454,7 +427,7 @@
(defn embed-script-fragment (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`], made into it in order. Substitutions should be pairss [`pattern` `value`],
where `pattern` is a string, a char, or a regular expression." where `pattern` is a string, a char, or a regular expression."
([filepath substitutions] ([filepath substitutions]
@ -603,31 +576,53 @@
(defn compose-form-extra-head (defn compose-form-extra-head
[form entity application] [form entity application]
{:extra-head {:extra-head
(if (apply
(some str
#(= "text-area" (widget-type % application)) (properties entity)) (remove
"{% script \"js/lib/node_modules/simplemde/dist/simplemde.min.js\" %} nil?
{% style \"js/lib/node_modules/simplemde/dist/simplemde.min.css\" %}")}) (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 (defn compose-form-extra-tail
[form entity application] [form entity application]
{:extra-tail {:extra-tail
{:tag :script :attrs {:type "text/javascript"} {:tag :script :attrs {:type "text/javascript"}
:content :content
(apply (apply
vector vector
(remove (remove
nil? nil?
(list (flatten
(if (list
(some (map
#(= "select" (widget-type % application)) (properties entity)) (fn [property]
(embed-script-fragment "resources/js/select-widget-support.js")) (let
(if [farname (:entity (:attrs property))
(some farside (first (children application #(= (:name (:attrs %)) farname)))
#(= "text-area" (widget-type % application)) (properties entity)) magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7))]
(embed-script-fragment "resources/js/text-area-md-support.js")))))}}) (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 (defn form-to-template