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

Small improvements. More and more works.

Browse source
This commit is contained in:
Simon Brooke 2018-07-04 22:29:33 +01:00
parent 981ff1d5fc
commit ac070b537f
3 changed files with 87 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/adl/to_hugsql_queries.clj
View file

@ -114,10 +114,6 @@
(defn update-query
"Generate an appropriate `update` query for this `entity`"
[entity]
(if
(and
(has-primary-key? entity)
(has-non-key-properties? entity))
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
property-names (map #(:name (:attrs %)) (insertable-properties entity))
@ -136,8 +132,7 @@
"SET "
(s/join ",\n\t" (map #(str (safe-name % :sql) " = " (keyword %)) property-names))
"\n"
(where-clause entity))}))
{}))
(where-clause entity))})))
(defn search-query [entity application]

66
src/adl/to_selmer_routes.clj
View file

@ -182,28 +182,49 @@
(list
'l/render
(list 'support/resolve-template (str n ".html"))
'(:session r)
(merge
{:title (capitalise (:name (:attrs f)))
:params 'p}
(case (:tag f)
(:form :page)
(reduce
merge
{:record
(list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
(list
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*")
'p))}
(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 :session 'r)
(list 'merge
{:title (capitalise (:name (:attrs f)))
:params 'p}
(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
@ -231,6 +252,7 @@
;; (def e (child-with-tag a :entity))
;; (def f (child-with-tag e :form))
;; (def n (path-part f e a))
;; (make-handler f e a)
;; (vector
;; 'p
;; (list 'merge

81
src/adl/to_selmer_templates.clj
View file

@ -114,7 +114,6 @@
"\n"
(flatten
(list
"{% endblock %}"
(emit-content filename spec entity application :foot))))))
@ -238,38 +237,42 @@
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 :div
{:tag :span
:attrs {:class "select-box" :farside farname :found (if farside "true" "false")}
:content
(apply
vector
(remove
nil?
(list
(if
async?
{: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 :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))})))}))
(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))}))))}))
(defn compose-if-member-of-tag
@ -378,11 +381,9 @@
(defn compose-select-script-header [entity application]
["{% block extra-head %}"
{:tag :script :attrs {:type "text/javascript"}
{:tag :script :attrs {:type "text/javascript"}
:content
[(slurp "resources/js/select-widget-support.js")]}
"{% endblock %}"])
[(slurp "resources/js/select-widget-support.js")]})
(defn form-to-template
@ -417,7 +418,7 @@
(delete-widget form entity application)))}]}}
(if
(some #(= "select" (widget-type % application)) (properties entity))
{:header (compose-select-script-header entity application)}
{:extra-head (compose-select-script-header entity application)}
{})))
@ -467,13 +468,15 @@
:content
[{:tag :tr
:content
(apply
vector
(map
#(hash-map
:content [(prompt %)]
:tag :th)
(children-with-tag list-spec :field)))}
(conj
(apply
vector
(map
#(hash-map
:content [(prompt %)]
:tag :th)
(children-with-tag list-spec :field)))
{:tag :th :content [" "]})}
{:tag :tr
:content
(apply