A lot of UI work.

src/adl/to_hugsql_queries.clj

@@ -183,6 +183,10 @@
                           (str
                             (safe-name (-> % :attrs :name) :sql)
                             " = ':" (-> % :attrs :name) "'")
+                          "entity"
+                          (str
+                           (safe-name (-> % :attrs :name) :sql)
+                            "_expanded LIKE '%:" (-> % :attrs :name) "%'")
                           (str
                             (safe-name (-> % :attrs :name) :sql)
                             " = :"

src/adl/to_json_routes.clj

@@ -1,14 +1,14 @@
 (ns ^{:doc "Application Description Language: generate RING routes for REST requests."
       :author "Simon Brooke"}
   adl.to-json-routes
-  (:require [clojure.java.io :refer [file make-parents writer]]
+  (:require [adl-support.utils :refer :all]
-            [clojure.pprint :refer [pprint]]
+            [adl.to-hugsql-queries :refer [queries]]
-            [clojure.string :as s]
-            [clojure.xml :as x]
             [clj-time.core :as t]
             [clj-time.format :as f]
-            [adl-support.utils :refer :all]
+            [clojure.java.io :refer [file make-parents writer]]
-            [adl.to-hugsql-queries :refer [queries]]))
+            [clojure.pprint :refer [pprint]]
+            [clojure.string :as s]
+            [clojure.xml :as x]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -47,8 +47,9 @@
     (list
       :require
       '[adl-support.core :as support]
-      '[clojure.java.io :as io]
       '[clojure.core.memoize :as memo]
+      '[clojure.java.io :as io]
+      '[clojure.tools.logging :as log]
       '[compojure.core :refer [defroutes GET POST]]
       '[hugsql.core :as hugsql]
       '[noir.response :as nresponse]
@@ -66,7 +67,24 @@
   [query]
   (list
     [{:keys ['params]}]
-    (list 'do (list (symbol (str "db/" (:name query))) 'params))
+    (list 'do
+          (list
+           'log/debug
+           (list 'str
+                 "Calling query '"
+                 (:name query)
+                 "' with params "
+                 (list 'map
+                       (list 'fn ['p]
+                             ;; user-distinct is a reasonable proxy for 'not-too-secret' -
+                             ;; this will only appear in debug logs.
+                         (list 'if
+                               (list (user-distinct-property-names (:entity query))
+                                     (list 'str (list 'name 'p)))
+                               (list 'params 'p)
+                               "[ELIDED]"))
+                       '(keys params))))
+          (list (symbol (str "db/" (:name query))) 'params))
     (case
       (:type query)
       (:delete-1 :update-1)

src/adl/to_selmer_routes.clj

@@ -2,12 +2,12 @@
       :author "Simon Brooke"}
   adl.to-selmer-routes
   (:require [adl-support.utils :refer :all]
+            [clj-time.core :as t]
+            [clj-time.format :as f]
             [clojure.java.io :refer [file make-parents writer]]
             [clojure.pprint :refer [pprint]]
             [clojure.string :as s]
             [clojure.xml :as x]
-            [clj-time.core :as t]
-            [clj-time.format :as f]
             ))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -51,6 +51,8 @@
     :require
     '[adl-support.core :as support]
     '[clojure.java.io :as io]
+    '[clojure.set :refer [subset?]]
+    '[clojure.tools.logging :as log]
     '[compojure.core :refer [defroutes GET POST]]
     '[hugsql.core :as hugsql]
     '[noir.response :as nresponse]
@@ -60,58 +62,72 @@
     (vector (symbol (str (:name (:attrs application)) ".db.core")) :as 'db)
     (vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm))))
 
-(defn make-handler
+
-  [f e a]
+(defn make-form-handler-content
-  (let [n (path-part f e a)]
+  [f e a n]
-    (list
+  (let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")]
-      'defn
+    ;; TODO: as yet makes no attempt to save the record
-      (symbol n)
+    (list 'let
-      (vector 'r)
+          (vector
-      (list 'let (vector
+           'record (list
-                   'p
+                    'support/do-or-log-error
-                   (list 'merge
+                    (list 'if (list 'subset? (key-names e) (set (list 'keys 'p)))
-                         {:offset 0 :limit 25}
-                         (list 'support/massage-params (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 'support/resolve-template (str n ".html"))
-              '(:session r)
-              (merge
-                {:title (capitalise (:name (:attrs f)))
-                 :params  'p}
-                (case (:tag f)
-                  (:form :page)
-                  (reduce
-                    merge
-                    {:record
-                     ;; TODO: this breaks. We need to check for the presence of the
-                     ;; actual key in the params.
-                     (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
                           (list
                            (symbol
                             (str "db/get-" (singularise (:name (:attrs e)))))
                            (symbol "db/*db*")
-                             'p))}
+                           'p))
+                    :message warning
+                    :error-return {:warnings [warning]}))
+          (reduce
+           merge
+           {:warnings (list :warnings 'record)
+            :record (list 'assoc 'record :warnings nil)}
            (map
             (fn [p]
               (hash-map
                (keyword (-> p :attrs :entity))
-                          (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))))
+               (list 'support/do-or-log-error
+                     (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))
+                     :message (str "Error while fetching "
+                                   (singularise (:entity (:attrs p)))
+                                   " record"))))
             (filter #(#{"entity" "link"} (:type (:attrs %)))
-                              (descendants-with-tag e :property))))
+                    (descendants-with-tag e :property)))))))
-                  :list
+
-                  {:records
+
+(defn make-page-handler-content
+  [f e a n]
+  (let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")]
+    (list 'let
+          (vector 'record (list
+                           'support/handler-content-log-error
+                           (list 'if (list 'subset? (list 'keys 'p) (key-names e)) []
+                                 (list
+                                  (symbol
+                                   (str "db/get-" (singularise (:name (:attrs e)))))
+                                  (symbol "db/*db*")
+                                  'p))
+                           :message warning
+                           :error-return {:warnings [warning]}))
+           {:warnings (list :warnings 'record)
+            :record (list 'assoc 'record :warnings nil)})))
+
+
+(defn make-list-handler-content
+  [f e a n]
+  (list
+   'let
+   (vector
+    'records
     (list
      'if
      (list
-                       'not
+      'some
+      (set (map #(-> % :attrs :name) (all-properties e)))
+      (list 'keys 'p))
      (list
-                         'empty?
+      'support/do-or-log-error
-                         (list 'remove 'nil? (list 'vals 'p))))
       (list
        (symbol
         (str
@@ -119,12 +135,74 @@
          (singularise (:name (:attrs e)))))
        (symbol "db/*db*")
        'p)
+      :message (str
+                "Error while searching "
+                (singularise (:name (:attrs e)))
+                " records")
+      :error-return {:warnings [(str
+                                 "Error while searching "
+                                 (singularise (:name (:attrs e)))
+                                 " records")]})
+     (list
+      'support/do-or-log-error
       (list
        (symbol
         (str
          "db/list-"
          (:name (:attrs e))))
-                       (symbol "db/*db*") {}))})))))))
+       (symbol "db/*db*") {})
+      :message (str
+                "Error while fetching "
+                (singularise (:name (:attrs e)))
+                " records")
+      :error-return {:warnings [(str
+                                 "Error while fetching "
+                                 (singularise (:name (:attrs e)))
+                                 " records")]})))
+   (list 'if
+         (list :warnings 'records)
+         'records
+         {:records 'records})))
+
+
+(defn make-handler
+  [f e a]
+  (let [n (path-part f e a)]
+    (list
+     'defn
+     (symbol n)
+     (vector 'r)
+     (list
+      'let
+      (vector
+       'p
+       (list 'merge
+             {:offset 0 :limit 25}
+             (list 'support/massage-params (list :params 'r) (list :form-params 'r) (key-names e)))
+       'c (case (:tag f)
+          :form (make-form-handler-content f e a n)
+          :page (make-page-handler-content f e a n)
+          :list (make-list-handler-content f e a n)))
+      (list
+       'l/render
+       (list 'support/resolve-template (str n ".html"))
+       '(:session 'r)
+       (list 'merge
+        {:title (capitalise (:name (:attrs f)))
+         :params  'p}
+        'c))))))
+
+;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml"))
+;; (def e (child-with-tag a :entity))
+;; (def f (child-with-tag e :form))
+;; (def n (path-part f e a))
+;; (vector
+;;  'p
+;;  (list 'merge
+;;        {:offset 0 :limit 25}
+;;        (list 'support/massage-params (list :params 'r))))
+;; (make-handler f e a)
+
 
 (defn make-route
   "Make a route for method `m` to request the resource with name `n`."
@@ -188,6 +266,16 @@
                            (list 'str (:name (:attrs application)) ".routes.auto/" 'n)))))))
 
 
+(defn make-handlers
+  [e application]
+  (doall
+   (map
+    (fn [c]
+      (pprint (make-handler c e application))
+      (println))
+    (filter (fn [c] (#{:form :list :page} (:tag c))) (children e)))))
+
+
 (defn to-selmer-routes
   [application]
   (let [filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto.clj")]
@@ -207,13 +295,7 @@
           (println)
           (doall
            (map
-              (fn [e]
+            #(make-handlers % application)
-                (doall
-                  (map
-                    (fn [c]
-                      (pprint (make-handler c e application))
-                      (println))
-                    (filter (fn [c] (#{:form :list :page} (:tag c))) (children e)))))
             (sort
              #(compare (:name (:attrs %1))(:name (:attrs %2)))
              (children-with-tag application :entity))))

src/adl/to_selmer_templates.clj

@@ -523,13 +523,13 @@
       [
        {:tag :div :attrs {:class "back-link-container"}
         :content
-        ["{% ifunequal offset 0 %}"
+        ["{% ifequal params.offset \"0\" %}"
-         {:tag :a :attrs {:id "prev-selector" :class "back-link"}
-          :content ["Previous"]}
-         "{% else %}"
           {:tag :a
           :attrs {:id "back-link" :class "back-link" :href "{{servlet-context}}/admin"}
           :content ["Back"]}
+         "{% else %}"
+          {:tag :a :attrs {:id "prev-selector" :class "back-link"}
+          :content ["Previous"]}
          "{% endifunequal %}"]}
        ]}
      :big-links
@@ -564,7 +564,7 @@
             ow.value='0';
           });
 
-          {% ifunequal offset 0 %}
+          {% ifunequal params.offset \"0\" %}
           document.getElementById('prev-selector').addEventListener('click', function () {
             ow.value=(parseInt(ow.value)-parseInt(lw.value));
             console.log('Updated offset to ' + ow.value);