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

Better form titles, progress on menus

Browse source
This commit is contained in:
Simon Brooke 2018-10-02 18:35:33 +01:00
parent 2df3444090
commit dc4937dfa2
1 changed files with 71 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

126
src/adl/to_selmer_routes.clj
View file

@ -96,33 +96,34 @@
[property application] [property application]
;; TODO: doesn't handle the case of type="link" ;; TODO: doesn't handle the case of type="link"
(case (-> property :attrs :type) (case (-> property :attrs :type)
"entity" (if-let [e (child-with-tag ("entity" "link" "list")
application (if-let [e (child-with-tag
:entity application
#(= (-> % :attrs :name) :entity
(-> property :attrs :entity)))] #(= (-> % :attrs :name)
(hash-map (-> property :attrs :entity)))]
(keyword (-> property :attrs :name)) (hash-map
(list (keyword (-> property :attrs :name))
'get-menu-options (list
(singularise (-> e :attrs :name)) 'get-menu-options
(query-name e :search-strings) (singularise (-> e :attrs :name))
(query-name e :search-strings) (query-name e :search-strings)
(keyword (-> property :attrs :farkey)) (query-name e :search-strings)
(list (keyword (-> property :attrs :name)) 'params))) (keyword (-> property :attrs :farkey))
{}) (list (keyword (-> property :attrs :name)) 'params)))
"link" (list {})
'do ;; "link" (list
(list ;; 'do
'comment ;; (list
"Can't yet handle link properties") ;; 'comment
{}) ;; "Can't yet handle link properties")
"list" (list ;; {})
'do ;; "list" (list
(list ;; 'do
'comment ;; (list
"Can't yet handle link properties") ;; 'comment
{}) ;; "Can't yet handle link properties")
;; {})
(list (list
'do 'do
(list (list
@ -181,14 +182,23 @@
is not used." is not used."
[f e a n] [f e a n]
(list (list
'let 'let
(vector (vector
'record (compose-fetch-record e)) 'record (compose-fetch-record e))
(list (list
'reduce 'reduce
'merge 'merge
{:error (list :warnings 'record) {:title (list
:record (list 'dissoc 'record :warnings)} 'form-title
'record
(capitalise (:name (:attrs f)))
(apply
vector
(map
#(keyword (safe-name %))
(user-distinct-properties e))))
:error (list :warnings 'record)
:record (list 'dissoc 'record :warnings)}
(cons (cons
'list 'list
(concat (concat
@ -297,25 +307,28 @@
[f e a] [f e a]
(let [n (handler-name f e a :get)] (let [n (handler-name f e a :get)]
(list (list
'defn 'defn
(symbol n) (symbol n)
(vector 'request) (vector 'request)
(list 'let (vector (list 'let (vector
'params 'params
(list (list 'support/massage-params 'request))
'merge (list
(property-defaults e) 'l/render
(list 'support/massage-params 'request))) (list 'support/resolve-template (str (path-part f e a) ".html"))
(list (list 'merge
'l/render {:title (case (:tag f)
(list 'support/resolve-template (str (path-part f e a) ".html")) :list
(list 'merge (str "List " (pretty-name e))
{:title (capitalise (:name (:attrs f))) :form
:params 'params} (str "Add a " (singularise (pretty-name e)))
(case (:tag f) :page
:form (make-form-get-handler-content f e a n) (singularise (pretty-name e)))
:page (make-page-get-handler-content f e a n) :params 'params}
:list (make-list-get-handler-content f e a n)))))))) (case (:tag f)
:form (make-form-get-handler-content f e a n)
:page (make-page-get-handler-content f e a n)
:list (make-list-get-handler-content f e a n))))))))
(defn make-form-post-handler-content (defn make-form-post-handler-content
@ -330,6 +343,8 @@
(let (let
[create-name (query-name e :create) [create-name (query-name e :create)
update-name (query-name e :update)] update-name (query-name e :update)]
;; NOTE! Default values should be specified on database fields. They
;; should NOT be inserted by application layer code.
(list (list
'let 'let
(vector (vector
@ -387,7 +402,8 @@
(list 'merge 'params (list 'merge 'params
(list :body 'result)) (list :body 'result))
:message :message
(list 'str "Record created")(list :body 'result)) (list 'str "Record created")
(list :body 'result))
(list (list
'catch 'Exception 'x 'catch 'Exception 'x
{:message "Record created" {:message "Record created"