From 40fc3a99cc653c855331c3fe3f0b46d5dff2c296 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 16 Jun 2018 10:34:05 +0100
Subject: [PATCH 1/2] Added drill-down in lists.
---
src/adl/to_psql.clj | 110 +++++++++++++++++---------------
src/adl/to_selmer_templates.clj | 43 +++++++++----
2 files changed, 88 insertions(+), 65 deletions(-)
diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj
index dd4dcf1..faf2b21 100644
--- a/src/adl/to_psql.clj
+++ b/src/adl/to_psql.clj
@@ -281,7 +281,8 @@
" ||', '|| "
(compose-convenience-entity-field field entity application))
" AS "
- (field-name field)))
+ (field-name field)
+ "_expanded"))
(defn emit-convenience-view
@@ -290,59 +291,62 @@
[entity application]
(let [view-name (safe-name (str "lv_" (:table (:attrs entity))) :sql)
entity-fields (filter
- #(= (:type (:attrs %)) "entity")
- (properties entity))]
+ #(= (:type (:attrs %)) "entity")
+ (properties entity))]
(s/join
- "\n"
- (remove
- nil?
- (flatten
- (list
- (emit-header
- "--"
- (str "convenience view " view-name " of entity " (:name (:attrs entity)) " for lists, et cetera"))
- (s/join
- " "
- (list "CREATE VIEW" view-name "AS"))
- (str
- "SELECT "
- (s/join
- ",\n\t"
- (map
- #(if
- (= (:type (:attrs %)) "entity")
- (emit-convenience-entity-field % entity application)
- (str (safe-name entity) "." (field-name %)))
- (filter
- #(not (= (:type (:attrs %)) "link"))
- (all-properties entity) ))))
- (str
- "FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true))))
- (if
- (not (empty? entity-fields))
- (str
- "WHERE "
- (s/join
- "\n\tAND "
- (map
- (fn [f]
- (let
- [farside (child
- application
- #(and
- (entity? %)
- (= (:name (:attrs %)) (:entity (:attrs f)))))]
- (str
- (safe-name (:table (:attrs entity)) :sql)
- "."
- (field-name f)
- " = "
- (safe-name (:table (:attrs farside)) :sql)
- "."
- (safe-name (first (key-names farside)) :sql))))
- entity-fields))))
- ";"
- (emit-permissions-grant view-name :SELECT (permissions entity application))))))))
+ "\n"
+ (remove
+ nil?
+ (flatten
+ (list
+ (emit-header
+ "--"
+ (str "convenience view " view-name " of entity " (:name (:attrs entity)) " for lists, et cetera"))
+ (s/join
+ " "
+ (list "CREATE VIEW" view-name "AS"))
+ (str
+ "SELECT "
+ (s/join
+ ",\n\t"
+ (flatten
+ (map
+ #(if
+ (= (:type (:attrs %)) "entity")
+ (list
+ (emit-convenience-entity-field % entity application)
+ (str (safe-name entity) "." (field-name %)))
+ (str (safe-name entity) "." (field-name %)))
+ (filter
+ #(not (= (:type (:attrs %)) "link"))
+ (all-properties entity) )))))
+ (str
+ "FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true))))
+ (if
+ (not (empty? entity-fields))
+ (str
+ "WHERE "
+ (s/join
+ "\n\tAND "
+ (map
+ (fn [f]
+ (let
+ [farside (child
+ application
+ #(and
+ (entity? %)
+ (= (:name (:attrs %)) (:entity (:attrs f)))))]
+ (str
+ (safe-name (:table (:attrs entity)) :sql)
+ "."
+ (field-name f)
+ " = "
+ (safe-name (:table (:attrs farside)) :sql)
+ "."
+ (safe-name (first (key-names farside)) :sql))))
+ entity-fields))))
+ ";"
+ (emit-permissions-grant view-name :SELECT (permissions entity application))))))))
(defn emit-referential-integrity-link
diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj
index 69faf38..a813092 100644
--- a/src/adl/to_selmer_templates.clj
+++ b/src/adl/to_selmer_templates.clj
@@ -362,6 +362,7 @@
taken from this `application`. If `page` is nil, generate a default page
template for the entity."
[page entity application]
+ ;; TODO
)
@@ -416,7 +417,21 @@
:value "Search"}}]})))}]})
-(defn- list-tbody
+(defn edit-link
+ [entity application parameters]
+ (str
+ (editor-name entity application)
+ "?"
+ (s/join
+ "&"
+ (map
+ #(let [n (:name (:attrs %1))]
+ (str n "={{ record." %2 " }}"))
+ (key-names entity)
+ parameters))))
+
+
+(defn list-tbody
"Return a table body element for the list view for this `list-spec` of this `entity` within
this `application`."
[list-spec entity application]
@@ -430,22 +445,26 @@
(concat
(map
(fn [field]
- {:tag :td :content [(str "{{ record." (:property (:attrs field)) " }}")]})
+ {:tag :td :content
+ (let
+ [p (first (filter #(= (:name (:attrs %)) (:property (:attrs field))) (all-properties entity)))
+ e (first
+ (filter
+ #(= (:name (:attrs %)) (:entity (:attrs p)))
+ (children-with-tag application :entity)))
+ c (str "{{ record." (:property (:attrs field)) " }}")]
+ (if
+ (= (:type (:attrs p)) "entity")
+ [{:tag :a
+ :attrs {:href (edit-link e application (list (:name (:attrs p))))}
+ :content [(str "{{ record." (:property (:attrs field)) "_expanded }}")]}]
+ [c]))})
(fields list-spec))
[{:tag :td
:content
[{:tag :a
:attrs
- {:href
- (str
- (editor-name entity application)
- "?"
- (s/join
- "&"
- (map
- #(let [n (:name (:attrs %))]
- (str n "={{ record." n "}}"))
- (children (first (filter #(= (:tag %) :key) (children entity)))))))}
+ {:href (edit-link entity application (key-names entity))}
:content ["View"]}]}]))}
"{% endfor %}"]})
From adca71875cd639dec6edbc13516af4cefd43e147 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 16 Jun 2018 11:29:21 +0100
Subject: [PATCH 2/2] Work on getting forms working. Not complete but a
considerable advance.
---
src/adl/to_selmer_routes.clj | 9 ++++-
src/adl/to_selmer_templates.clj | 72 ++++++++++++++++++---------------
2 files changed, 46 insertions(+), 35 deletions(-)
diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj
index 597797a..62170c1 100644
--- a/src/adl/to_selmer_routes.clj
+++ b/src/adl/to_selmer_routes.clj
@@ -61,7 +61,10 @@
'defn
(symbol n)
(vector 'r)
- (list 'let (vector 'p (list :form-params 'r))
+ (list 'let (vector 'p (list :params 'r)) ;; 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
+ ;; allow spoofing.
(list
'l/render
(list 'resolve-template (str n ".html"))
@@ -71,10 +74,12 @@
(case (:tag f)
(:form :page)
{:record
+ (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
(list
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
- 'p)}
+ (symbol "db/*db*")
+ 'p))}
:list
{:records
(list
diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj
index a813092..b784f9b 100644
--- a/src/adl/to_selmer_templates.clj
+++ b/src/adl/to_selmer_templates.clj
@@ -366,12 +366,36 @@
)
+(defn compose-list-search-widget
+ [field entity]
+ (let [property (first
+ (children
+ entity
+ (fn [p] (and (= (:tag p) :property)
+ (= (:name (:attrs p)) (:property (:attrs field)))))))
+ input-type (case (:type (:attrs property))
+ ("integer" "real" "money") "number"
+ ("date" "timestamp") "date"
+ "time" "time"
+ "text")
+ base-name (:property (:attrs field))
+ search-name (if
+ (= (:type (:attrs property)) "entity")
+ (str base-name "_expanded") base-name)]
+ (hash-map
+ :tag :th
+ :content
+ [{:tag :input
+ :attrs {:id search-name
+ :type input-type
+ :name search-name
+ :value (str "{{ params." search-name " }}")}}])))
+
+
+
(defn- list-thead
"Return a table head element for the list view for this `list-spec` of this `entity` within
- this `application`.
-
- TODO: where entity fields are being shown/searched on, we should be using the user-distinct
- fields of the far side, rather than key values"
+ this `application`."
[list-spec entity application]
{:tag :thead
:content
@@ -388,33 +412,16 @@
:content
(apply
vector
- (concat
- (map
- (fn [f]
- (let [property (first
- (children
- entity
- (fn [p] (and (= (:tag p) :property)
- (= (:name (:attrs p)) (:property (:attrs f)))))))]
- (hash-map
- :tag :th
- :content
- [{:tag :input
- :attrs {:id (:property (:attrs f))
- :type (case (:type (:attrs property))
- ("integer" "real" "money") "number"
- ("date" "timestamp") "date"
- "time" "time"
- "text")
- :name (:property (:attrs f))
- :value (str "{{ params." (:property (:attrs f)) " }}")}}])))
- (fields list-spec))
- '({:tag :th
- :content
- [{:tag :input
- :attrs {:type "submit"
- :id "search"
- :value "Search"}}]})))}]})
+ (concat
+ (map
+ #(compose-list-search-widget % entity)
+ (fields list-spec))
+ '({:tag :th
+ :content
+ [{:tag :input
+ :attrs {:type "submit"
+ :id "search"
+ :value "Search"}}]})))}]})
(defn edit-link
@@ -425,8 +432,7 @@
(s/join
"&"
(map
- #(let [n (:name (:attrs %1))]
- (str n "={{ record." %2 " }}"))
+ #(str %1 "={{ record." %2 " }}")
(key-names entity)
parameters))))