From 34552cff4fcf3bf583738bc538709bba8b5e57a5 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 5 Aug 2018 14:53:54 +0100 Subject: [PATCH] Working through getting record creation going --- src/adl/to_selmer_routes.clj | 95 ++++++++++++++------------- src/adl/to_selmer_templates.clj | 111 +++++++++++++++++--------------- 2 files changed, 111 insertions(+), 95 deletions(-) diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index 7f31bac..a517e86 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -77,7 +77,7 @@ 'if (list 'all-keys-present? - 'params (set (key-names e true))) + 'params (key-names e true)) (list 'support/do-or-log-error (list @@ -138,7 +138,7 @@ :entity #(= (-> % :attrs :name) f-name))] (if (and (entity? entity) (entity? farside)) - (list 'if (list 'all-keys-present? 'params (set (key-names entity true))) + (list 'if (list 'all-keys-present? 'params (key-names entity true)) (hash-map (keyword (auxlist-data-name auxlist)) (list @@ -189,7 +189,12 @@ (descendants-with-tag e :property))) (map #(compose-fetch-auxlist-data % e a) - (descendants-with-tag f :auxlist))))))) + (descendants-with-tag f :auxlist)) + (list + (list 'if (list :error 'request) + {:error (list :error 'request)}) + (list 'if (list :message 'request) + {:message (list :message 'request)}))))))) (defn make-page-get-handler-content @@ -248,7 +253,7 @@ (str "db/list-" (:name (:attrs e)))) - (symbol "db/*db*") {}) + (symbol "db/*db*") 'params) :message (str "Error while fetching " (singularise (:name (:attrs e))) @@ -304,49 +309,51 @@ [create-name (query-name e :create) update-name (query-name e :update)] (list - 'let - (vector - 'result - (list - 'valid-user-or-forbid - (list - 'with-params-or-error + 'let + (vector + 'result (list - 'do-or-server-fail - (list - 'if - (list 'all-keys-present? 'params (key-names e true)) + 'valid-user-or-forbid (list - update-name - 'db/*db* - 'params) - (list - create-name - 'db/*db* - 'params)) - 200) ;; OK - 'params - (set - (map - #(keyword (:name (:attrs %))) - (insertable-properties e)))) - 'request)) - (list - 'if + 'with-params-or-error + (list + 'if + (list 'all-keys-present? 'params (key-names e true)) + (list + 'do-or-server-fail + (list + update-name + 'db/*db* + 'params) + 200) + (list + 'do-or-server-fail + (list + create-name + 'db/*db* + 'params) + 201)) + 'params + (set + (map + #(keyword (:name (:attrs %))) + (required-properties e)))) + 'request)) (list - (set [200 400]) - (list :status 'result)) - (list - (symbol (handler-name f e a :get)) - (list - 'assoc - 'request - :params - (list - 'merge - 'params - 'result))) - 'result)))) + (symbol (handler-name f e a :get)) + (list 'merge + (list + 'assoc + 'request + :params + (list + 'merge + 'params + 'result)) + (list 'case (:status 'result) + 200 {:message "Record stored"} + 201 (str "Record created: " (list :body 'result)) + {:error (list :body 'result)})))))) (defn make-post-handler diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj index b524e66..5dbb407 100644 --- a/src/adl/to_selmer_templates.clj +++ b/src/adl/to_selmer_templates.clj @@ -405,6 +405,12 @@ :value (str "{{record." widget-name "}}") :maxlength (str (max (get-size-for-widget property) 16)) :size (str (min (get-size-for-widget property) 60))} + (case (-> property :attrs :type) + "real" + {:step 0.000001} ;; this is a bit arbitrary! + "integer" + {:step 1} + nil) ;; TODO: should match pattern from typedef (if (:minimum (:attrs typedef)) @@ -561,67 +567,70 @@ entity :property #(= - (-> % :attrs :name) - (-> auxlist :attrs :property))) + (-> % :attrs :name) + (-> auxlist :attrs :property))) farside (child-with-tag application :entity #(= - (-> % :attrs :name) - (-> property :attrs :entity)))] + (-> % :attrs :name) + (-> property :attrs :entity)))] (if (and property farside) {:tag :div :attrs {:class "auxlist"} :content (apply - vector - (remove - nil? - (flatten - (list - ;; only show auxlists if we've got keys - (str "{% if all " - (s/join " " (map #(str "params." %) (key-names entity))) - " %}") - {:tag :h2 - :content [(prompt auxlist form entity application)]} - {:tag :table - :content - [{:tag :thead - :content - [{:tag :tr - :content - (apply - vector - (remove - nil? - (flatten - (list - (map - #(hash-map - :tag :th - :content [(prompt % form entity application)]) - (children-with-tag auxlist :field)) - {:tag :th :content [" "]}))))}]} - (list-tbody - (auxlist-data-name auxlist) - auxlist - farside - application)]} - (if - (= (-> auxlist :attrs :canadd) "true") - (wrap-in-if-member-of - (big-link (str - "Add a new " - (pretty-name property)) - (editor-name farside application)) - :writeable - farside - application) - ) - "{% endif %}" - ))))}))) + vector + (remove + nil? + (flatten + (list + ;; only show auxlists if we've got keys + (str "{% if all " + (s/join " " (map #(str "params." %) (key-names entity))) + " %}") + ;; only show the body of auxlists if the list is non-empty + (str "{% if " (auxlist-data-name auxlist) "|not-empty %}") + + {:tag :h2 + :content [(prompt auxlist form entity application)]} + {:tag :table + :content + [{:tag :thead + :content + [{:tag :tr + :content + (apply + vector + (remove + nil? + (flatten + (list + (map + #(hash-map + :tag :th + :content [(prompt % form entity application)]) + (children-with-tag auxlist :field)) + {:tag :th :content [" "]}))))}]} + (list-tbody + (auxlist-data-name auxlist) + auxlist + farside + application)]} + "{% endif %}" + (if + (= (-> auxlist :attrs :canadd) "true") + (wrap-in-if-member-of + (big-link (str + "Add a new " + (pretty-name property)) + (editor-name farside application)) + :writeable + farside + application) + ) + "{% endif %}"))))}))) (defn compose-form-auxlists