simon/adl
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

#3 Auxlists mostly working

Browse source 
Problems: generating some wrong fieldnames in HugSQL, apparently through not using (safe-name x :sql); not using the right views where multiple links from one entity to another; not getting distinction between many-to-many and one-to-many right.
This commit is contained in:
Simon Brooke 2018-07-30 13:59:23 +01:00
parent 19f1e7e513
commit cbebfeca50
3 changed files with 145 additions and 99 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/adl/to_hugsql_queries.clj
View file

@ -298,7 +298,7 @@
farkey (-> % :attrs :farkey) farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type) link-type (-> % :attrs :type)
link-field (-> % :attrs :name) link-field (-> % :attrs :name)
query-name (list-related-query-name entity far-entity) query-name (list-related-query-name far-entity entity)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)

61
src/adl/to_selmer_routes.clj
View file

@ -107,18 +107,18 @@
(keyword (-> property :attrs :farkey)) (keyword (-> property :attrs :farkey))
(list (keyword (-> property :attrs :name)) 'params))) (list (keyword (-> property :attrs :name)) 'params)))
{}) {})
;; "link" (list "link" (list
;; 'do 'do
;; (list (list
;; 'comment 'comment
;; "Can't yet handle link properties") "Can't yet handle link properties")
;; {}) {})
;; (list (list
;; 'do 'do
;; (list (list
;; 'comment 'comment
;; (str "Unexpedted type " (-> property :atts :type))) (str "Unexpedted type " (-> property :atts :type)))
{})) {})))
(defn compose-fetch-auxlist-data (defn compose-fetch-auxlist-data
@ -132,12 +132,14 @@
:entity :entity
#(= (-> % :attrs :name) f-name))] #(= (-> % :attrs :name) f-name))]
(if (and (entity? entity) (entity? farside)) (if (and (entity? entity) (entity? farside))
(hash-map (list 'if (list 'all-keys-present? 'params (set (key-names entity true)))
(keyword (auxlist-data-name auxlist)) (hash-map
(list (keyword (auxlist-data-name auxlist))
(symbol (str "db/" (list-related-query-name entity farside))) (list
'db/*db* ;; TODO: wrong query name being generated
{:id (list :id 'params)})) (symbol (str "db/" (list-related-query-name entity farside)))
'db/*db*
{:id (list :id 'params)})))
(do (do
(if-not (if-not
(entity? entity) (entity? entity)
@ -163,18 +165,21 @@
'let 'let
(vector (vector
'record (compose-fetch-record e)) 'record (compose-fetch-record e))
(reduce (list
merge 'reduce
'merge
{:error (list :warnings 'record) {:error (list :warnings 'record)
:record (list 'dissoc 'record :warnings)} :record (list 'dissoc 'record :warnings)}
(concat (cons
(map 'list
#(compose-get-menu-options % a) (concat
(filter #(:entity (:attrs %)) (map
(descendants-with-tag e :property))) #(compose-get-menu-options % a)
(map (filter #(:entity (:attrs %))
#(compose-fetch-auxlist-data % e a) (descendants-with-tag e :property)))
(descendants-with-tag f :auxlist)))))) (map
#(compose-fetch-auxlist-data % e a)
(descendants-with-tag f :auxlist)))))))
(defn make-page-get-handler-content (defn make-page-get-handler-content

181
src/adl/to_selmer_templates.clj
View file

@ -66,7 +66,6 @@
(defn emit-content (defn emit-content
([content] ([content]
(do-or-warn
(cond (cond
(nil? content) (nil? content)
nil nil
@ -78,8 +77,7 @@
(seq? content) (seq? content)
(map emit-content (remove nil? content)) (map emit-content (remove nil? content))
true true
(str "<!-- don't know what to do with '" content "' -->")) (str "<!-- don't know what to do with '" content "' -->")))
(str "Failed while writing " content)))
([filename application k] ([filename application k]
(emit-content filename nil nil application k)) (emit-content filename nil nil application k))
([filename spec entity application k] ([filename spec entity application k]
@ -375,6 +373,20 @@
"{% endif %}")))}) "{% 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 (defn compose-input-widget-para
"Generate an input widget for this `field-or-property` of this `form` for "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 this `entity` taken from within this `application`, in context of a para
@ -391,17 +403,8 @@
:name widget-name :name widget-name
:type w-type :type w-type
:value (str "{{record." widget-name "}}") :value (str "{{record." widget-name "}}")
:maxlength (:size (:attrs property)) :maxlength (str (max (get-size-for-widget property) 16))
:size (cond :size (str (min (get-size-for-widget property) 60))}
(nil? (:size (:attrs property)))
"16"
(try
(> (read-string
(:size (:attrs property))) 60)
(catch Exception _ false))
"60"
true
(:size (:attrs property)))}
;; TODO: should match pattern from typedef ;; TODO: should match pattern from typedef
(if (if
(:minimum (:attrs typedef)) (:minimum (:attrs typedef))
@ -480,10 +483,12 @@
(defn edit-link (defn edit-link
[entity application parameters] [source entity application parameters]
(str (str
"{{servlet-context}}/" "{{servlet-context}}/"
(editor-name entity application) (or
(-> source :attrs :onselect)
(editor-name entity application))
"?" "?"
(s/join (s/join
"&amp;" "&amp;"
@ -495,7 +500,7 @@
(defn list-tbody (defn list-tbody
"Return a table body element for the list view for this `list-spec` of "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] [source list-spec entity application]
{:tag :tbody {:tag :tbody
:content :content
@ -503,40 +508,50 @@
{:tag :tr {:tag :tr
:content :content
(apply (apply
vector vector
(remove
nil?
(concat (concat
(map (map
(fn [field] (fn [field]
{:tag :td :content {:tag :td :content
(let (let
[p (first [p (first
(filter (filter
#(= #(=
(:name (:attrs %)) (:name (:attrs %))
(:property (:attrs field))) (:property (:attrs field)))
(all-properties entity))) (all-properties entity)))
s (safe-name (:name (:attrs p)) :sql) s (safe-name (:name (:attrs p)) :sql)
e (first e (first
(filter (filter
#(= (:name (:attrs %)) (:entity (:attrs p))) #(= (:name (:attrs %)) (:entity (:attrs p)))
(children-with-tag application :entity))) (children-with-tag application :entity)))
c (str "{{ record." s " }}")] c (str "{{ record." s " }}")]
(if (if
(= (:type (:attrs p)) "entity") (= (:type (:attrs p)) "entity")
[{:tag :a [{:tag :a
:attrs {:href (edit-link :attrs {:href (edit-link
e source
(child-with-tag
application application
(list (:name (:attrs p))))} :entity
:content [(str "{{ record." s "_expanded }}")]}] #(= (-> % :attrs :name)(-> p :attrs :entity)))
[c]))}) application
(children-with-tag list-spec :field)) (list (:name (:attrs p))))}
[{:tag :td :content [(str "{{ record." s "_expanded }}")]}]
[c]))})
(children-with-tag list-spec :field))
[{:tag :td
:content :content
[{:tag :a [(if
:attrs (or (= (:tag list-spec) :form)
{:href (edit-link entity application (key-names entity))} (-> list-spec :attrs :onselect))
:content ["View"]}]}]))} {:tag :a
:attrs
{:href (edit-link source entity application (key-names entity))}
:content ["View"]}
"&nbsp;")]}])))}
"{% endfor %}"]}) "{% endfor %}"]})
@ -559,29 +574,54 @@
{:tag :div {:tag :div
:attrs {:class "auxlist"} :attrs {:class "auxlist"}
:content :content
[{:tag :h2 (apply
:content [(prompt auxlist form entity application)]} vector
{:tag :table (remove
:content nil?
[{:tag :thead (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 :content
[{:tag :tr [{:tag :thead
:content :content
(apply [{:tag :tr
vector :content
(flatten (apply
(list vector
(remove
nil?
(flatten
(list
(map (map
#(hash-map #(hash-map
:tag :th :tag :th
:content [(prompt % form entity application)]) :content [(prompt % form entity application)])
(children-with-tag auxlist :field)) (children-with-tag auxlist :field))
{:tag :th :content ["&nbsp;"]})))}]} {:tag :th :content ["&nbsp;"]}))))}]}
(list-tbody (list-tbody
(auxlist-data-name auxlist) (auxlist-data-name auxlist)
auxlist auxlist
farside farside
application)]}]}))) 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 (defn compose-form-auxlists
@ -1031,11 +1071,12 @@
(if (if
(pos? *verbosity*) (pos? *verbosity*)
(*warn* "\tGenerated " filepath)) (*warn* "\tGenerated " filepath))
(str filepath)))))) (str filepath))
(str "While generating " filepath)))))
;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml")) ;; (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)) ;; (def f (child-with-tag e :form))
;; (write-template-file "froboz" (form-to-template f e a) a) ;; (write-template-file "froboz" (form-to-template f e a) a)
;; (def t (form-to-template f e a)) ;; (def t (form-to-template f e a))