diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index 76e51ae..b9e57c5 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -298,7 +298,7 @@ farkey (-> % :attrs :farkey) link-type (-> % :attrs :type) link-field (-> % :attrs :name) - query-name (list-related-query-name entity far-entity) + query-name (list-related-query-name far-entity entity) signature ":? :*"] (hash-map (keyword query-name) diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index 29bc936..753322d 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -107,18 +107,18 @@ (keyword (-> property :attrs :farkey)) (list (keyword (-> property :attrs :name)) 'params))) {}) -;; "link" (list -;; 'do -;; (list -;; 'comment -;; "Can't yet handle link properties") -;; {}) -;; (list -;; 'do -;; (list -;; 'comment -;; (str "Unexpedted type " (-> property :atts :type))) - {})) + "link" (list + 'do + (list + 'comment + "Can't yet handle link properties") + {}) + (list + 'do + (list + 'comment + (str "Unexpedted type " (-> property :atts :type))) + {}))) (defn compose-fetch-auxlist-data @@ -132,12 +132,14 @@ :entity #(= (-> % :attrs :name) f-name))] (if (and (entity? entity) (entity? farside)) - (hash-map - (keyword (auxlist-data-name auxlist)) - (list - (symbol (str "db/" (list-related-query-name entity farside))) - 'db/*db* - {:id (list :id 'params)})) + (list 'if (list 'all-keys-present? 'params (set (key-names entity true))) + (hash-map + (keyword (auxlist-data-name auxlist)) + (list + ;; TODO: wrong query name being generated + (symbol (str "db/" (list-related-query-name entity farside))) + 'db/*db* + {:id (list :id 'params)}))) (do (if-not (entity? entity) @@ -163,18 +165,21 @@ 'let (vector 'record (compose-fetch-record e)) - (reduce - merge + (list + 'reduce + 'merge {:error (list :warnings 'record) :record (list 'dissoc 'record :warnings)} - (concat - (map - #(compose-get-menu-options % a) - (filter #(:entity (:attrs %)) - (descendants-with-tag e :property))) - (map - #(compose-fetch-auxlist-data % e a) - (descendants-with-tag f :auxlist)))))) + (cons + 'list + (concat + (map + #(compose-get-menu-options % a) + (filter #(:entity (:attrs %)) + (descendants-with-tag e :property))) + (map + #(compose-fetch-auxlist-data % e a) + (descendants-with-tag f :auxlist))))))) (defn make-page-get-handler-content diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj index ddb3767..0a55b6d 100644 --- a/src/adl/to_selmer_templates.clj +++ b/src/adl/to_selmer_templates.clj @@ -66,7 +66,6 @@ (defn emit-content ([content] - (do-or-warn (cond (nil? content) nil @@ -78,8 +77,7 @@ (seq? content) (map emit-content (remove nil? content)) true - (str "")) - (str "Failed while writing " content))) + (str ""))) ([filename application k] (emit-content filename nil nil application k)) ([filename spec entity application k] @@ -375,6 +373,20 @@ "{% endif %}")))}) +(defn get-size-for-widget + "Return, as an integer, the fieldwidth for the input widget for this + `property`." + [property] + (let [s (try + (read-string + (:size (:attrs property))) + (catch Exception _ 16))] + (if + (not (integer? s)) + 16 + s))) + + (defn compose-input-widget-para "Generate an input widget for this `field-or-property` of this `form` for this `entity` taken from within this `application`, in context of a para @@ -391,17 +403,8 @@ :name widget-name :type w-type :value (str "{{record." widget-name "}}") - :maxlength (:size (:attrs property)) - :size (cond - (nil? (:size (:attrs property))) - "16" - (try - (> (read-string - (:size (:attrs property))) 60) - (catch Exception _ false)) - "60" - true - (:size (:attrs property)))} + :maxlength (str (max (get-size-for-widget property) 16)) + :size (str (min (get-size-for-widget property) 60))} ;; TODO: should match pattern from typedef (if (:minimum (:attrs typedef)) @@ -480,10 +483,12 @@ (defn edit-link - [entity application parameters] + [source entity application parameters] (str "{{servlet-context}}/" - (editor-name entity application) + (or + (-> source :attrs :onselect) + (editor-name entity application)) "?" (s/join "&" @@ -495,7 +500,7 @@ (defn list-tbody "Return a table body element for the list view for this `list-spec` of - this `entity` within this `application`, using data from this source." + this `entity` within this `application`, using data from this `source`." [source list-spec entity application] {:tag :tbody :content @@ -503,40 +508,50 @@ {:tag :tr :content (apply - vector + vector + (remove + nil? (concat - (map - (fn [field] - {:tag :td :content - (let - [p (first - (filter - #(= - (:name (:attrs %)) - (:property (:attrs field))) - (all-properties entity))) - s (safe-name (:name (:attrs p)) :sql) - e (first - (filter - #(= (:name (:attrs %)) (:entity (:attrs p))) - (children-with-tag application :entity))) - c (str "{{ record." s " }}")] - (if - (= (:type (:attrs p)) "entity") - [{:tag :a - :attrs {:href (edit-link - e + (map + (fn [field] + {:tag :td :content + (let + [p (first + (filter + #(= + (:name (:attrs %)) + (:property (:attrs field))) + (all-properties entity))) + s (safe-name (:name (:attrs p)) :sql) + e (first + (filter + #(= (:name (:attrs %)) (:entity (:attrs p))) + (children-with-tag application :entity))) + c (str "{{ record." s " }}")] + (if + (= (:type (:attrs p)) "entity") + [{:tag :a + :attrs {:href (edit-link + source + (child-with-tag application - (list (:name (:attrs p))))} - :content [(str "{{ record." s "_expanded }}")]}] - [c]))}) - (children-with-tag list-spec :field)) - [{:tag :td + :entity + #(= (-> % :attrs :name)(-> p :attrs :entity))) + application + (list (:name (:attrs p))))} + :content [(str "{{ record." s "_expanded }}")]}] + [c]))}) + (children-with-tag list-spec :field)) + [{:tag :td :content - [{:tag :a - :attrs - {:href (edit-link entity application (key-names entity))} - :content ["View"]}]}]))} + [(if + (or (= (:tag list-spec) :form) + (-> list-spec :attrs :onselect)) + {:tag :a + :attrs + {:href (edit-link source entity application (key-names entity))} + :content ["View"]} + " ")]}])))} "{% endfor %}"]}) @@ -559,29 +574,54 @@ {:tag :div :attrs {:class "auxlist"} :content - [{:tag :h2 - :content [(prompt auxlist form entity application)]} - {:tag :table - :content - [{:tag :thead + (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 :tr + [{:tag :thead :content - (apply - vector - (flatten - (list + [{: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)]}]}))) + #(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 %}" + ))))}))) (defn compose-form-auxlists @@ -1031,11 +1071,12 @@ (if (pos? *verbosity*) (*warn* "\tGenerated " filepath)) - (str filepath)))))) + (str filepath)) + (str "While generating " filepath))))) ;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml")) -;; (def e (child-with-tag a :entity)) +;; (def e (child-with-tag a :entity #(= (-> % :attrs :name) "teams"))) ;; (def f (child-with-tag e :form)) ;; (write-template-file "froboz" (form-to-template f e a) a) ;; (def t (form-to-template f e a))