Merge branch 'develop' of github.com:simon-brooke/adl into develop

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

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

src/adl/to_selmer_templates.clj

@@ -362,15 +362,40 @@
   taken from this `application`. If `page` is nil, generate a default page
   template for the entity."
   [page entity application]
+  ;; TODO
   )
 
 
+(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
@@ -387,36 +412,32 @@
      :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- list-tbody
+(defn edit-link
+  [entity application parameters]
+  (str
+    (editor-name entity application)
+    "?"
+    (s/join
+      "&"
+      (map
+        #(str %1 "={{ 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 +451,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 %}"]})