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

Refactoring around constructing menus (which is still not working)

Browse source
This commit is contained in:
Simon Brooke 2018-07-29 18:19:56 +01:00
parent 6ba1ad60c9
commit d93619dff8
1 changed files with 107 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

195
src/adl/to_selmer_routes.clj
View file

@ -65,58 +65,67 @@
(vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm)))) (vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm))))
(defn compose-fetch-record
[e]
(let
[entity-name (singularise (:name (:attrs e)))
warning (str
"Error while fetching "
entity-name
" record")]
(list
'if
(list
'all-keys-present?
'params (set (key-names e true)))
(list
'support/do-or-log-error
(list
(query-name e :get)
(symbol "db/*db*")
'params)
:message warning
:error-return {:warnings [warning]}))))
(defn compose-get-menu-options
[e property]
;; TODO: doesn't handle the case of type="link"
(hash-map
(keyword (-> property :attrs :name))
(list
'get-menu-options
(singularise (-> e :attrs :name))
(query-name e :search-strings)
(query-name e :search-strings)
(keyword (-> property :attrs :farkey))
(list (keyword (-> property :attrs :name)) 'params))))
(defn make-form-get-handler-content (defn make-form-get-handler-content
[f e a n] [f e a n]
(let [entity-name (singularise (:name (:attrs e)))] (list
;; TODO: as yet makes no attempt to save the record 'let
(list 'let (vector
(vector 'record (compose-fetch-record e))
'record (list (reduce
'get-current-value merge
(symbol (str "db/get-" entity-name)) {:error (list :warnings 'record)
'params :record (list 'dissoc 'record :warnings)}
entity-name)) (map
(reduce #(compose-get-menu-options e %)
merge (filter #(:entity (:attrs %))
{:error (list :warnings 'record) (descendants-with-tag e :property))))))
:record (list 'dissoc 'record :warnings)}
(map
(fn [property]
(hash-map
(keyword (-> property :attrs :name))
(list
'flatten
(list
'remove
'nil?
(list
'list
;; Get the current value of the property, if it's an entity
(if (= (-> property :attrs :type) "entity")
(list 'get-menu-options
(-> e :attrs :name)
(-> property :attrs :farkey)
(list (keyword (-> property :attrs :name)) 'params))))))))
(filter #(:entity (:attrs %))
(descendants-with-tag e :property)))))))
(defn make-page-get-handler-content (defn make-page-get-handler-content
[f e a n] [f e a n]
(let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")] (list
(list 'let 'let
(vector 'record (list (vector
'support/handler-content-log-error 'record (compose-fetch-record e))
(list 'if (list 'subset? (list 'keys 'p) (key-names e)) [] {:warnings (list :warnings 'record)
(list :record (list 'assoc 'record :warnings nil)}))
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*")
'params))
:message warning
:error-return {:warnings [warning]}))
{:warnings (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)})))
(defn make-list-get-handler-content (defn make-list-get-handler-content
@ -130,45 +139,55 @@
(list (list
'some 'some
(set (map #(keyword (-> % :attrs :name)) (all-properties e))) (set (map #(keyword (-> % :attrs :name)) (all-properties e)))
(list 'keys 'params)) (list
(list 'do 'keys 'params))
(list (symbol "log/debug") (list (symbol (str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params)) (list
(list 'do
'support/do-or-log-error (list
(list (symbol "log/debug")
(symbol (str "db/search-strings-" (:name (:attrs e)))) (list
(symbol "db/*db*") (symbol
'params) (str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params))
:message (str (list
"Error while searching " 'support/do-or-log-error
(singularise (:name (:attrs e))) (list
" records") (symbol (str "db/search-strings-" (:name (:attrs e))))
:error-return {:warnings [(str (symbol "db/*db*")
"Error while searching " 'params)
(singularise (:name (:attrs e))) :message (str
" records")]})) "Error while searching "
(list 'do (singularise (:name (:attrs e)))
(list (symbol "log/debug") (list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params)) " records")
(list :error-return {:warnings [(str
'support/do-or-log-error "Error while searching "
(list (singularise (:name (:attrs e)))
(symbol " records")]}))
(str (list
"db/list-" 'do
(:name (:attrs e)))) (list
(symbol "db/*db*") {}) (symbol "log/debug")
:message (str (list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params))
"Error while fetching " (list
(singularise (:name (:attrs e))) 'support/do-or-log-error
" records") (list
:error-return {:warnings [(str (symbol
"Error while fetching " (str
(singularise (:name (:attrs e))) "db/list-"
" records")]})))) (:name (:attrs e))))
(list 'if (symbol "db/*db*") {})
(list :warnings 'records) :message (str
'records "Error while fetching "
{:records 'records}))) (singularise (:name (:attrs e)))
" records")
:error-return {:warnings [(str
"Error while fetching "
(singularise (:name (:attrs e)))
" records")]}))))
(list
'if
(list :warnings 'records)
'records
{:records 'records})))
(defn handler-name (defn handler-name
@ -250,9 +269,9 @@
'request 'request
:params :params
(list (list
'merge 'merge
'params 'params
'result))) 'result)))
'result)))) 'result))))