From 7ea6b5f29990fda39caec87f9c47c31a174e1eae Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 29 Jun 2018 23:37:55 +0100
Subject: [PATCH] Detail work, improving robustness and presentation.
---
src/adl/to_hugsql_queries.clj | 14 +++++++-------
src/adl/to_selmer_routes.clj | 4 +++-
src/adl/to_selmer_templates.clj | 17 ++++++++++++-----
3 files changed, 22 insertions(+), 13 deletions(-)
diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj
index a79f174..673023d 100644
--- a/src/adl/to_hugsql_queries.clj
+++ b/src/adl/to_hugsql_queries.clj
@@ -140,7 +140,7 @@
{}))
-(defn search-query [entity]
+(defn search-query [entity application]
"Generate an appropriate search query for string fields of this `entity`"
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
@@ -164,7 +164,7 @@
"-- :doc selects existing "
pretty-name
" 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
"\n\t--~ "
(cons
@@ -174,8 +174,8 @@
(map
#(str
"(if (:" (-> % :attrs :name) " params) \"OR "
- (case (:type (:attrs %))
- ("string" "text" "defined") ;; TODO: 'defined' types may be string or number - more work here
+ (case (base-type % application)
+ ("string" "text")
(str
(safe-name (-> % :attrs :name) :sql)
" LIKE '%:" (-> % :attrs :name) "%'")
@@ -257,7 +257,7 @@
(list
(str "-- :name " query-name " " signature)
(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_")
"--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
@@ -359,7 +359,7 @@
(list
(str "-- :name " query-name " " signature)
(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 "WHERE " near-name "." (first (key-names near)) " = " link-name "." (singularise near-name) "_id" )
("\tAND " link-name "." (singularise far-name) "_id = :id")
@@ -428,7 +428,7 @@
(delete-query entity)
(select-query entity)
(list-query entity)
- (search-query entity)
+ (search-query entity application)
(foreign-queries entity application)))
([application]
(apply
diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj
index 50a1585..645a640 100644
--- a/src/adl/to_selmer_routes.clj
+++ b/src/adl/to_selmer_routes.clj
@@ -77,6 +77,7 @@
(list
'l/render
(list 'support/resolve-template (str n ".html"))
+ '(:session r)
(merge
{:title (capitalise (:name (:attrs f)))
:params 'p}
@@ -96,7 +97,8 @@
(hash-map
(keyword (-> p :attrs :entity))
(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
{:records
(list
diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj
index b4feb07..640af91 100644
--- a/src/adl/to_selmer_templates.clj
+++ b/src/adl/to_selmer_templates.clj
@@ -132,7 +132,6 @@
#(and
(= (:tag %) :prompt)
(= (:locale :attrs %) *locale*))))
-
(:name (:attrs field-or-property))
(:property (:attrs field-or-property)))))
@@ -265,7 +264,12 @@
[property entity application writable?]
(let
[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
" "
(flatten
@@ -590,9 +594,12 @@
(defn application-to-template
[application]
(let
- [first-class-entities (filter
- #(children-with-tag % :list)
- (children-with-tag application :entity))]
+ [first-class-entities
+ (sort-by
+ #(:name (:attrs %))
+ (filter
+ #(children-with-tag % :list)
+ (children-with-tag application :entity)))]
{:application-index
{:tag :dl
:attrs {:class "index"}