Detail work, improving robustness and presentation.

This commit is contained in:
Simon Brooke 2018-06-29 23:37:55 +01:00
parent 9d086f7028
commit 7ea6b5f299
3 changed files with 22 additions and 13 deletions

View file

@ -140,7 +140,7 @@
{})) {}))
(defn search-query [entity] (defn search-query [entity application]
"Generate an appropriate search query for string fields of this `entity`" "Generate an appropriate search query for string fields of this `entity`"
(let [entity-name (safe-name (:name (:attrs entity)) :sql) (let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
@ -164,7 +164,7 @@
"-- :doc selects existing " "-- :doc selects existing "
pretty-name pretty-name
" records having any string field matching the parameter of the same name by substring match") " records having any string field matching the parameter of the same name by substring match")
(str "SELECT * FROM lv_" entity-name) (str "SELECT DISTINCT * FROM lv_" entity-name)
(s/join (s/join
"\n\t--~ " "\n\t--~ "
(cons (cons
@ -174,8 +174,8 @@
(map (map
#(str #(str
"(if (:" (-> % :attrs :name) " params) \"OR " "(if (:" (-> % :attrs :name) " params) \"OR "
(case (:type (:attrs %)) (case (base-type % application)
("string" "text" "defined") ;; TODO: 'defined' types may be string or number - more work here ("string" "text")
(str (str
(safe-name (-> % :attrs :name) :sql) (safe-name (-> % :attrs :name) :sql)
" LIKE '%:" (-> % :attrs :name) "%'") " LIKE '%:" (-> % :attrs :name) "%'")
@ -257,7 +257,7 @@
(list (list
(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 * FROM lv_" entity-name) (str "SELECT DISTINCT * FROM lv_" entity-name)
(order-by-clause entity "lv_") (order-by-clause entity "lv_")
"--~ (if (:offset params) \"OFFSET :offset \")" "--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))}))) "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
@ -359,7 +359,7 @@
(list (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far ) (str "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far )
(str "SELECT "near-name ".*") (str "SELECT DISTINCT "near-name ".*")
(str "FROM " near-name ", " link-name ) (str "FROM " near-name ", " link-name )
(str "WHERE " near-name "." (first (key-names near)) " = " link-name "." (singularise near-name) "_id" ) (str "WHERE " near-name "." (first (key-names near)) " = " link-name "." (singularise near-name) "_id" )
("\tAND " link-name "." (singularise far-name) "_id = :id") ("\tAND " link-name "." (singularise far-name) "_id = :id")
@ -428,7 +428,7 @@
(delete-query entity) (delete-query entity)
(select-query entity) (select-query entity)
(list-query entity) (list-query entity)
(search-query entity) (search-query entity application)
(foreign-queries entity application))) (foreign-queries entity application)))
([application] ([application]
(apply (apply

View file

@ -77,6 +77,7 @@
(list (list
'l/render 'l/render
(list 'support/resolve-template (str n ".html")) (list 'support/resolve-template (str n ".html"))
'(:session r)
(merge (merge
{:title (capitalise (:name (:attrs f))) {:title (capitalise (:name (:attrs f)))
:params 'p} :params 'p}
@ -96,7 +97,8 @@
(hash-map (hash-map
(keyword (-> p :attrs :entity)) (keyword (-> p :attrs :entity))
(list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*")))) (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))))
(filter #(= (:type (:attrs %)) "entity") (descendants-with-tag e :property)))) (filter #(#{"entity" "link"} (:type (:attrs %)))
(descendants-with-tag e :property))))
:list :list
{:records {:records
(list (list

View file

@ -132,7 +132,6 @@
#(and #(and
(= (:tag %) :prompt) (= (:tag %) :prompt)
(= (:locale :attrs %) *locale*)))) (= (:locale :attrs %) *locale*))))
(:name (:attrs field-or-property)) (:name (:attrs field-or-property))
(:property (:attrs field-or-property))))) (:property (:attrs field-or-property)))))
@ -265,7 +264,12 @@
[property entity application writable?] [property entity application writable?]
(let (let
[all-permissions (find-permissions property entity application) [all-permissions (find-permissions property entity application)
permissions (if writable? (writable-by all-permissions) (visible-to all-permissions))] permissions (map
s/lower-case
(if
writable?
(writable-by all-permissions)
(visible-to all-permissions)))]
(s/join (s/join
" " " "
(flatten (flatten
@ -590,9 +594,12 @@
(defn application-to-template (defn application-to-template
[application] [application]
(let (let
[first-class-entities (filter [first-class-entities
(sort-by
#(:name (:attrs %))
(filter
#(children-with-tag % :list) #(children-with-tag % :list)
(children-with-tag application :entity))] (children-with-tag application :entity)))]
{:application-index {:application-index
{:tag :dl {:tag :dl
:attrs {:class "index"} :attrs {:class "index"}