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

Working through getting record creation going

Browse source
This commit is contained in:
Simon Brooke 2018-08-05 14:53:54 +01:00
parent 972dfd091e
commit 34552cff4f
2 changed files with 111 additions and 95 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

95
src/adl/to_selmer_routes.clj
View file

@ -77,7 +77,7 @@
'if 'if
(list (list
'all-keys-present? 'all-keys-present?
'params (set (key-names e true))) 'params (key-names e true))
(list (list
'support/do-or-log-error 'support/do-or-log-error
(list (list
@ -138,7 +138,7 @@
:entity :entity
#(= (-> % :attrs :name) f-name))] #(= (-> % :attrs :name) f-name))]
(if (and (entity? entity) (entity? farside)) (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 (hash-map
(keyword (auxlist-data-name auxlist)) (keyword (auxlist-data-name auxlist))
(list (list
@ -189,7 +189,12 @@
(descendants-with-tag e :property))) (descendants-with-tag e :property)))
(map (map
#(compose-fetch-auxlist-data % e a) #(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 (defn make-page-get-handler-content
@ -248,7 +253,7 @@
(str (str
"db/list-" "db/list-"
(:name (:attrs e)))) (:name (:attrs e))))
(symbol "db/*db*") {}) (symbol "db/*db*") 'params)
:message (str :message (str
"Error while fetching " "Error while fetching "
(singularise (:name (:attrs e))) (singularise (:name (:attrs e)))
@ -304,49 +309,51 @@
[create-name (query-name e :create) [create-name (query-name e :create)
update-name (query-name e :update)] update-name (query-name e :update)]
(list (list
'let 'let
(vector (vector
'result 'result
(list
'valid-user-or-forbid
(list
'with-params-or-error
(list (list
'do-or-server-fail 'valid-user-or-forbid
(list
'if
(list 'all-keys-present? 'params (key-names e true))
(list (list
update-name 'with-params-or-error
'db/*db* (list
'params) 'if
(list (list 'all-keys-present? 'params (key-names e true))
create-name (list
'db/*db* 'do-or-server-fail
'params)) (list
200) ;; OK update-name
'params 'db/*db*
(set 'params)
(map 200)
#(keyword (:name (:attrs %))) (list
(insertable-properties e)))) 'do-or-server-fail
'request)) (list
(list create-name
'if 'db/*db*
'params)
201))
'params
(set
(map
#(keyword (:name (:attrs %)))
(required-properties e))))
'request))
(list (list
(set [200 400]) (symbol (handler-name f e a :get))
(list :status 'result)) (list 'merge
(list (list
(symbol (handler-name f e a :get)) 'assoc
(list 'request
'assoc :params
'request (list
:params 'merge
(list 'params
'merge 'result))
'params (list 'case (:status 'result)
'result))) 200 {:message "Record stored"}
'result)))) 201 (str "Record created: " (list :body 'result))
{:error (list :body 'result)}))))))
(defn make-post-handler (defn make-post-handler

111
src/adl/to_selmer_templates.clj
View file

@ -405,6 +405,12 @@
:value (str "{{record." widget-name "}}") :value (str "{{record." widget-name "}}")
:maxlength (str (max (get-size-for-widget property) 16)) :maxlength (str (max (get-size-for-widget property) 16))
:size (str (min (get-size-for-widget property) 60))} :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 ;; TODO: should match pattern from typedef
(if (if
(:minimum (:attrs typedef)) (:minimum (:attrs typedef))
@ -561,67 +567,70 @@
entity entity
:property :property
#(= #(=
(-> % :attrs :name) (-> % :attrs :name)
(-> auxlist :attrs :property))) (-> auxlist :attrs :property)))
farside (child-with-tag farside (child-with-tag
application application
:entity :entity
#(= #(=
(-> % :attrs :name) (-> % :attrs :name)
(-> property :attrs :entity)))] (-> property :attrs :entity)))]
(if (if
(and property farside) (and property farside)
{:tag :div {:tag :div
:attrs {:class "auxlist"} :attrs {:class "auxlist"}
:content :content
(apply (apply
vector vector
(remove (remove
nil? nil?
(flatten (flatten
(list (list
;; only show auxlists if we've got keys ;; only show auxlists if we've got keys
(str "{% if all " (str "{% if all "
(s/join " " (map #(str "params." %) (key-names entity))) (s/join " " (map #(str "params." %) (key-names entity)))
" %}") " %}")
{:tag :h2 ;; only show the body of auxlists if the list is non-empty
:content [(prompt auxlist form entity application)]} (str "{% if " (auxlist-data-name auxlist) "|not-empty %}")
{:tag :table
:content {:tag :h2
[{:tag :thead :content [(prompt auxlist form entity application)]}
:content {:tag :table
[{:tag :tr :content
:content [{:tag :thead
(apply :content
vector [{:tag :tr
(remove :content
nil? (apply
(flatten vector
(list (remove
(map nil?
#(hash-map (flatten
:tag :th (list
:content [(prompt % form entity application)]) (map
(children-with-tag auxlist :field)) #(hash-map
{:tag :th :content [" "]}))))}]} :tag :th
(list-tbody :content [(prompt % form entity application)])
(auxlist-data-name auxlist) (children-with-tag auxlist :field))
auxlist {:tag :th :content [" "]}))))}]}
farside (list-tbody
application)]} (auxlist-data-name auxlist)
(if auxlist
(= (-> auxlist :attrs :canadd) "true") farside
(wrap-in-if-member-of application)]}
(big-link (str "{% endif %}"
"Add a new " (if
(pretty-name property)) (= (-> auxlist :attrs :canadd) "true")
(editor-name farside application)) (wrap-in-if-member-of
:writeable (big-link (str
farside "Add a new "
application) (pretty-name property))
) (editor-name farside application))
"{% endif %}" :writeable
))))}))) farside
application)
)
"{% endif %}"))))})))
(defn compose-form-auxlists (defn compose-form-auxlists