diff --git a/project.clj b/project.clj index 84cee9c..7624344 100644 --- a/project.clj +++ b/project.clj @@ -5,7 +5,7 @@ :license {:name "GNU Lesser General Public License, version 3.0 or (at your option) any later version" :url "https://www.gnu.org/licenses/lgpl-3.0.en.html"} - :dependencies [[adl-support "0.1.3"] + :dependencies [[adl-support "0.1.4-SNAPSHOT"] [bouncer "1.0.1"] [clojure-saxon "0.9.4"] [environ "1.1.0"] @@ -19,7 +19,10 @@ :main adl.main :plugins [[lein-codox "0.10.3"] - [lein-release "1.0.5"]] + [lein-kibit "0.1.6"] + [lein-release "1.0.5"] + ;; [uncomplexor "0.1.0-SNAPSHOT"] + ] ;; :lein-release {:scm :git ;; :deploy-via :clojars} ;; :deploy-via :clojars fails - with an scp error. diff --git a/src/adl/main.clj b/src/adl/main.clj index c5ceba3..73bb40d 100644 --- a/src/adl/main.clj +++ b/src/adl/main.clj @@ -92,25 +92,24 @@ (defn process "Process these parsed `options`." [options] - (do - (let [p (:path (:options options)) - op (if (.endsWith p "/") p (str p "/"))] - (binding [*output-path* op - *locale* (-> options :options :locale) - *verbosity* (-> options :options :verbosity)] - (make-parents *output-path*) - (doall - (map - #(if - (.exists (java.io.File. %)) - (let [application (x/parse (canonicalise %))] - (h/to-hugsql-queries application) - (j/to-json-routes application) - (p/to-psql application) - (s/to-selmer-routes application) - (t/to-selmer-templates application)) - (*warn* (str "ERROR: File not found: " %))) - (-> options :arguments))))))) + (let [p (:path (:options options)) + op (if (.endsWith p "/") p (str p "/"))] + (binding [*output-path* op + *locale* (-> options :options :locale) + *verbosity* (-> options :options :verbosity)] + (make-parents *output-path*) + (doall + (map + #(if + (.exists (java.io.File. %)) + (let [application (x/parse (canonicalise %))] + (h/to-hugsql-queries application) + (j/to-json-routes application) + (p/to-psql application) + (s/to-selmer-routes application) + (t/to-selmer-templates application)) + (*warn* (str "ERROR: File not found: " %))) + (:arguments options)))))) (defn -main @@ -121,7 +120,7 @@ (cond (empty? args) (usage options) - (not (empty? (:errors options))) + (seq (:errors options)) (do (doall (map diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index c8fdd85..4b07240 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -1,7 +1,7 @@ (ns ^{:doc "Application Description Language - generate HUGSQL queries file." :author "Simon Brooke"} adl.to-hugsql-queries - (:require [adl-support.core :refer [*warn*]] + (:require [adl-support.core :refer :all] [adl-support.utils :refer :all] [clojure.java.io :refer [file make-parents]] [clojure.math.combinatorics :refer [combinations]] @@ -46,13 +46,12 @@ (let [entity-name (:name (:attrs entity)) property-names (map #(:name (:attrs %)) properties)] - (if - (not (empty? property-names)) + (if-not (empty? property-names) (str - "WHERE " - (s/join - "\n\tAND" - (map #(str entity-name "." % " = :" %) property-names))))))) + "WHERE " + (s/join + "\n\tAND" + (map #(str entity-name "." % " = :" %) property-names))))))) (defn order-by-clause @@ -213,8 +212,8 @@ (defn select-query "Generate an appropriate `select` query for this `entity`" ([entity properties] - (if - (not (empty? properties)) + (if-not + (empty? properties) (let [entity-name (safe-name (:name (:attrs entity)) :sql) pretty-name (singularise entity-name) query-name (if (= properties (key-properties entity)) @@ -384,32 +383,24 @@ [application] (let [filepath (str *output-path* "resources/sql/queries.auto.sql")] (make-parents filepath) - (try - (spit + (do-or-warn + (do + (spit filepath (s/join - "\n\n" - (cons - (emit-header - "--" - "File queries.sql" - (str "autogenerated by adl.to-hugsql-queries at " (t/now)) - "See [Application Description Language](https://github.com/simon-brooke/adl).") - (map - #(:query %) - (sort - #(compare (:name %1) (:name %2)) - (vals - (queries application))))))) - (if (> *verbosity* 0) - (*warn* (str "\tGenerated " filepath))) - (catch - Exception any - (*warn* - (str - "ERROR: Exception " - (.getName (.getClass any)) - (.getMessage any) - " while printing " - filepath)))))) + "\n\n" + (cons + (emit-header + "--" + "File queries.sql" + (str "autogenerated by adl.to-hugsql-queries at " (t/now)) + "See [Application Description Language](https://github.com/simon-brooke/adl).") + (map + :query + (sort + #(compare (:name %1) (:name %2)) + (vals + (queries application))))))) + (if (pos? *verbosity*) + (*warn* (str "\tGenerated " filepath))))))) diff --git a/src/adl/to_json_routes.clj b/src/adl/to_json_routes.clj index becad9e..1918abc 100644 --- a/src/adl/to_json_routes.clj +++ b/src/adl/to_json_routes.clj @@ -1,7 +1,7 @@ (ns ^{:doc "Application Description Language: generate RING routes for REST requests." :author "Simon Brooke"} adl.to-json-routes - (:require [adl-support.core :refer [*warn*]] + (:require [adl-support.core :refer :all] [adl-support.utils :refer :all] [adl.to-hugsql-queries :refer [queries]] [clj-time.core :as t] @@ -53,7 +53,8 @@ (f/unparse (f/formatters :basic-date-time) (t/now))) (list :require - '[adl-support.core :as support] + '[adl-support.core :refer :all] + '[adl-support.rest-support :refer :all] '[clojure.core.memoize :as memo] '[clojure.java.io :as io] '[clojure.tools.logging :as log] @@ -72,28 +73,38 @@ (defn generate-handler-body "Generate and return the function body for the handler for this `query`." [query] - (let [action (list - (symbol (str "db/" (:name query))) - 'db/*db* - (list 'support/massage-params - 'params - 'form-params - (key-names (:entity query))))] + (list + ['request] + (list + 'let + ['params '(massage-params request)] (list - [{:keys ['params 'form-params]}] - (case - (:type query) - (:delete-1 :update-1) + 'valid-user-or-forbid + (list + 'with-params-or-error + (list + 'do-or-server-fail (list - action - `(log/debug (str ~(:name query) " called with params " ~'params ".")) - '(response/found "/")) - (list - 'let - (vector 'result action) - `(log/debug (~(symbol (str "db/" (:name query) "-sqlvec")) ~'params)) - `(log/debug (str ~(str "'" (:name query) "' with params ") ~'params " returned " (count ~'result) " records.")) - (list 'response/ok 'result)))))) + (symbol (str "db/" (:name query))) + 'db/*db* + 'params) + (case (:type query) + :insert-1 201 ;; created + :delete-1 204 ;; no content + ;; default + 200)) ;; OK + 'params + (set + (map + #(keyword (:name (:attrs %))) + (case (:type query) + (:insert-1 :update-1) + (-> query :entity insertable-properties) + (:select-1 :delete-1) + (-> query :entity key-properties) + ;; default + nil)))) + 'request)))) (defn generate-handler-src @@ -262,7 +273,7 @@ (let [handlers-map (make-handlers-map application) filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")] (make-parents filepath) - (try + (do-or-warn (with-open [output (writer filepath)] (binding [*out* output] (pprint (file-header application)) @@ -275,16 +286,7 @@ h) (sort (keys handlers-map)))) (pprint (defroutes handlers-map)))) - (if (> *verbosity* 0) - (*warn* (str "\tGenerated " filepath))) - (catch - Exception any - (*warn* - (str - "ERROR: Exception " - (.getName (.getClass any)) - (.getMessage any) - " while printing " - filepath)))))) + (if (pos? *verbosity*) + (*warn* (str "\tGenerated " filepath)))))) diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj index c4a5c08..898a9ea 100644 --- a/src/adl/to_psql.clj +++ b/src/adl/to_psql.clj @@ -1,7 +1,7 @@ (ns ^{:doc "Application Description Language: generate Postgres database definition." :author "Simon Brooke"} adl.to-psql - (:require [adl-support.core :refer [*warn*]] + (:require [adl-support.core :refer :all] [adl-support.utils :refer :all] [adl.to-hugsql-queries :refer [queries]] [clojure.java.io :refer [file make-parents writer]] @@ -111,7 +111,12 @@ (defn emit-field-type [property entity application key?] (case (:type (:attrs property)) - "integer" (if key? "SERIAL" "INTEGER") + "integer" (if + (and + key? + (system-generated? property)) + "SERIAL" + "INTEGER") "real" "DOUBLE PRECISION" ("string" "image" "uploadable") (str "VARCHAR(" (:size (:attrs property)) ")") @@ -150,8 +155,8 @@ #(if (selector (:permission (:attrs %))) (safe-name (:group (:attrs %)) :sql)) permissions)))] - (if - (not (empty? group-names)) + (if-not + (empty? group-names) (s/join " " (list @@ -318,12 +323,12 @@ (str (safe-name entity) "." (field-name %))) (str (safe-name entity) "." (field-name %))) (filter - #(not (= (:type (:attrs %)) "link")) + #(not= (:type (:attrs %)) "link") (all-properties entity) ))))) (str "FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true)))) - (if - (not (empty? entity-fields)) + (if-not + (empty? entity-fields) (str "WHERE " (s/join @@ -408,7 +413,7 @@ (list doc-comment (map - #(:content %) + :content (children-with-tag entity :documentation)))) (s/join " " @@ -427,7 +432,7 @@ (map #(emit-property % entity application false) (filter - #(not (= (:type (:attrs %)) "link")) + #(not= (:type (:attrs %)) "link") (children-with-tag entity :property))))))) "\n);") (map @@ -532,7 +537,7 @@ (str "(https://github.com/simon-brooke/adl) at " (f/unparse (f/formatters :basic-date-time) (t/now))) (map - #(:content %) + :content (children-with-tag application :documentation)))) @@ -568,18 +573,10 @@ (:name (:attrs application)) ".postgres.sql")] (make-parents filepath) - (try + (do-or-warn (spit filepath (emit-application application)) - (if (> *verbosity* 0) - (*warn* (str "\tGenerated " filepath))) - (catch - Exception any - (*warn* - (str - "ERROR: Exception " - (.getName (.getClass any)) - (.getMessage any) - " while printing " - filepath)))))) + (if + (pos? *verbosity*) + (*warn* (str "\tGenerated " filepath)))))) diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index a53440d..8bab130 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -1,8 +1,9 @@ (ns ^{:doc "Application Description Language: generate routes for user interface requests." :author "Simon Brooke"} adl.to-selmer-routes - (:require [adl-support.core :refer [*warn*]] + (:require [adl-support.core :refer :all] [adl-support.utils :refer :all] + [adl-support.forms-support :refer :all] [clj-time.core :as t] [clj-time.format :as f] [clojure.java.io :refer [file make-parents writer]] @@ -34,11 +35,8 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Generally. there's one route in the generated file for each Selmer -;;; template which has been generated. - -;;; TODO: there must be some more idiomatic way of generating all these -;;; functions. +;;; Generally. there are two routes - one for GET, one for POST - in the +;;; generated file for each Selmer template which has been generated. (defn file-header [application] @@ -51,6 +49,8 @@ (list :require '[adl-support.core :as support] + '[adl-support.forms-support :refer :all] + '[adl-support.rest-support :refer :all] '[clojure.java.io :as io] '[clojure.set :refer [subset?]] '[clojure.tools.logging :as log] @@ -65,62 +65,43 @@ (vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm)))) -(defn make-form-handler-content +(defn make-form-get-handler-content [f e a n] - (let [warning (list 'str (str "Error while fetching " (singularise (:name (:attrs e))) " record ") 'params)] + (let [entity-name (singularise (:name (:attrs e)))] ;; TODO: as yet makes no attempt to save the record (list 'let (vector - 'record (list - 'support/do-or-log-error - ;;(list 'if (list 'subset? (key-names e) (list 'set (list 'keys 'params))) - (list - (symbol - (str "db/get-" (singularise (:name (:attrs e))))) - (symbol "db/*db*") - 'params) - ;;) - :message warning - :error-return {:warnings [warning]})) + 'record (list + 'get-current-value + (symbol (str "db/get-" entity-name)) + 'params + entity-name)) (reduce - merge - {:error (list :warnings 'record) - :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 'support/do-or-log-error - (list - (symbol - (str "db/get-" (singularise (:entity (:attrs property))))) - (symbol "db/*db*") - (hash-map (keyword (-> property :attrs :farkey)) - (list (keyword (-> property :attrs :name)) 'record))) - :message (str "Error while fetching " - (singularise (:entity (:attrs property))) - " record " (hash-map (keyword (-> property :attrs :farkey)) - (list (keyword (-> property :attrs :name)) 'record))))) - ;;; and the potential values of the property - (list 'support/do-or-log-error - (list (symbol (str "db/list-" (:entity (:attrs property)))) (symbol "db/*db*")) - :message (str "Error while fetching " - (singularise (:entity (:attrs property))) - " list"))))))) - (filter #(:entity (:attrs %)) - (descendants-with-tag e :property))))))) + merge + {:error (list :warnings 'record) + :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-handler-content +(defn make-page-get-handler-content [f e a n] (let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")] (list 'let @@ -134,113 +115,193 @@ 'params)) :message warning :error-return {:warnings [warning]})) - {:warnings (list :warnings 'record) - :record (list 'assoc 'record :warnings nil)}))) + {:warnings (list :warnings 'record) + :record (list 'assoc 'record :warnings nil)}))) -(defn make-list-handler-content +(defn make-list-get-handler-content [f e a n] (list - 'let - (vector - 'records - (list - 'if - (list - 'some - (set (map #(keyword (-> % :attrs :name)) (all-properties e))) - (list 'keys 'params)) - (list 'do - (list (symbol "log/debug") (list (symbol (str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params)) - (list - 'support/do-or-log-error - (list - (symbol (str "db/search-strings-" (:name (:attrs e)))) - (symbol "db/*db*") - 'params) - :message (str - "Error while searching " - (singularise (:name (:attrs e))) - " records") - :error-return {:warnings [(str - "Error while searching " - (singularise (:name (:attrs e))) - " records")]})) - (list 'do - (list (symbol "log/debug") (list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params)) - (list - 'support/do-or-log-error - (list - (symbol - (str - "db/list-" - (:name (:attrs e)))) - (symbol "db/*db*") {}) - :message (str - "Error while fetching " - (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 make-handler - [f e a] - (let [n (path-part f e a)] + 'let + (vector + 'records (list - 'defn - (symbol n) - (vector 'request) - (list 'let (vector - 'params - (list 'support/massage-params - (list 'keywordize-keys (list :params 'request)) - (list 'keywordize-keys (list :form-params 'request)) - (key-names e true))) + 'if + (list + 'some + (set (map #(keyword (-> % :attrs :name)) (all-properties e))) + (list 'keys 'params)) + (list 'do + (list (symbol "log/debug") (list (symbol (str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params)) + (list + 'support/do-or-log-error (list - 'l/render - (list 'support/resolve-template (str n ".html")) - (list 'merge - {:title (capitalise (:name (:attrs f))) - :params 'params} - (case (:tag f) - :form (make-form-handler-content f e a n) - :page (make-page-handler-content f e a n) - :list (make-list-handler-content f e a n)))))))) + (symbol (str "db/search-strings-" (:name (:attrs e)))) + (symbol "db/*db*") + 'params) + :message (str + "Error while searching " + (singularise (:name (:attrs e))) + " records") + :error-return {:warnings [(str + "Error while searching " + (singularise (:name (:attrs e))) + " records")]})) + (list 'do + (list (symbol "log/debug") (list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params)) + (list + 'support/do-or-log-error + (list + (symbol + (str + "db/list-" + (:name (:attrs e)))) + (symbol "db/*db*") {}) + :message (str + "Error while fetching " + (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 + "Generate the name of the appropriate handler function for form `f` of + entity `e` of application `a` for method `m`, where `f`, `e`, and `a` + are expected to be elements and `m` is expected to be one of the keywords + `:put` `:get`." + [f e a m] + (str (s/lower-case (name m)) "-" (path-part f e a))) + + +(defn make-get-handler + [f e a] + (let [n (handler-name f e a :get)] + (list + 'defn + (symbol n) + (vector 'request) + (list 'let (vector + 'params + (list 'support/massage-params 'request)) + (list + 'l/render + (list 'support/resolve-template (str (path-part f e a) ".html")) + (list 'merge + {:title (capitalise (:name (:attrs f))) + :params 'params} + (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 + ;; Literally the only thing the post handler has to do is to + ;; generate the database store operation. Then it can hand off + ;; to the get handler. + [f e a n] + (let + [create-name (query-name e :create) + update-name (query-name e :update)] + (list + 'let + (vector + 'result + (list + 'valid-user-or-forbid + (list + 'with-params-or-error + (list + 'do-or-server-fail + (list + 'if + (list 'all-keys-present? 'params (key-names e true)) + (list + update-name + 'db/*db* + 'params) + (list + create-name + 'db/*db* + 'params)) + 200) ;; OK + 'params + (set + (map + #(keyword (:name (:attrs %))) + (insertable-properties e)))) + 'request)) + (list + 'if + (list + (set [200 400]) + (list :status 'result)) + (list + (symbol (handler-name f e a :get)) + (list + 'assoc + 'request + :params + (list + 'merge + 'params + 'result))) + 'result)))) + + +(defn make-post-handler + [f e a] + (let [n (handler-name f e a :post)] + (list + 'defn + (symbol n) + (vector 'request) + (case + (:tag f) + (:page :list) (list (symbol (handler-name f e a :get)) 'request) + :form (list + 'let + (vector + 'params + (list 'support/massage-params 'request)) + (make-form-post-handler-content f e a n)))))) + ;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml")) ;; (def e (child-with-tag a :entity)) ;; (def f (child-with-tag e :form)) -;; (def n (path-part f e a)) -;; (make-handler f e a) +;; (def n (handler-name f e a :post)) +;; (make-post-handler f e a) ;; (vector ;; 'p ;; (list 'merge ;; {:offset 0 :limit 25} ;; (list 'support/massage-params (list :params 'r)))) -;; (make-handler f e a) +;; (make-get-handler f e a) (defn make-route "Make a route for method `m` to request the resource with name `n`." [m n] (list - m + (symbol (s/upper-case (name m))) (str "/" n) 'request (list 'route/restricted (list 'apply - (list 'resolve-handler n) + (list 'resolve-handler (str (s/lower-case (name m)) "-" n)) (list 'list 'request))))) + (defn make-defroutes [application] (let [routes (flatten @@ -263,10 +324,10 @@ (apply (resolve-handler "index") (list request)))) (interleave (map - (fn [r] (make-route 'GET r)) + (fn [r] (make-route :get r)) (sort routes)) (map - (fn [r] (make-route 'POST r)) + (fn [r] (make-route :post r)) (sort routes)))))))) @@ -294,51 +355,52 @@ (doall (map (fn [c] - (pprint (make-handler c e application)) - (println)) + ;; do all get handlers before post handlers, so that the post + ;; handlers can call the get handlers. + (pprint (make-get-handler c e application)) + (println "\n") + (pprint (make-post-handler c e application)) + (println "\n")) (filter (fn [c] (#{:form :list :page} (:tag c))) (children e))))) (defn to-selmer-routes [application] - (let [filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto.clj")] + (let [filepath (str + *output-path* + "src/clj/" + (:name (:attrs application)) + "/routes/auto.clj") + entities (sort + #(compare (:name (:attrs %1))(:name (:attrs %2))) + (children-with-tag application :entity))] (make-parents filepath) - (try - (with-open [output (writer filepath)] - (binding [*out* output] - (pprint (file-header application)) - (println) - (pprint '(defn index - [r] - (l/render - (support/resolve-template - "application-index.html") - (:session r) - {:title "Administrative menu"}))) - (println) - (doall - (map - #(make-handlers % application) - (sort - #(compare (:name (:attrs %1))(:name (:attrs %2))) - (children-with-tag application :entity)))) - (pprint - (generate-handler-resolver application)) - (println) - (pprint '(def resolve-handler - (memoize raw-resolve-handler))) - (println) - (pprint (make-defroutes application)) - (println))) - (if (> *verbosity* 0) - (*warn* (str "\tGenerated " filepath))) - (catch - Exception any - (*warn* - (str - "ERROR: Exception " - (.getName (.getClass any)) - (.getMessage any) - " while printing " - filepath)))))) + (do-or-warn + (with-open [output (writer filepath)] + (binding [*out* output] + (pprint (file-header application)) + (println) + (pprint '(defn index + [r] + (l/render + (support/resolve-template + "application-index.html") + (:session r) + {:title "Administrative menu"}))) + (println) + (doall + (map + #(make-handlers % application) + entities)) + (pprint + (generate-handler-resolver application)) + (println) + (pprint '(def resolve-handler + (memoize raw-resolve-handler))) + (println) + (pprint (make-defroutes application)) + (println))) + (if + (pos? *verbosity*) + (*warn* (str "\tGenerated " filepath)))))) diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj index c4475f3..595adf5 100644 --- a/src/adl/to_selmer_templates.clj +++ b/src/adl/to_selmer_templates.clj @@ -1,7 +1,8 @@ -(ns ^{:doc "Application Description Language - generate Selmer templates for the HTML pages implied by an ADL file." +(ns ^{:doc "Application Description Language - generate Selmer templates for + the HTML pages implied by an ADL file." :author "Simon Brooke"} adl.to-selmer-templates - (:require [adl-support.core :refer [*warn*]] + (:require [adl-support.core :refer :all] [adl.to-hugsql-queries :refer [expanded-token]] [adl-support.utils :refer :all] [clojure.java.io :refer [file make-parents resource]] @@ -41,7 +42,9 @@ {:tag :div :attrs {:class "big-link-container"} :content - [{:tag :a :attrs {:href (str "{{servlet-context}}/" url) :class "big-link"} + [{:tag :a + :attrs {:href (str "{{servlet-context}}/" url) + :class "big-link"} :content (if (vector? content) content @@ -62,7 +65,7 @@ (defn emit-content ([content] - (try + (do-or-warn (cond (nil? content) nil @@ -75,15 +78,7 @@ (map emit-content (remove nil? content)) true (str "")) - (catch Exception any - (str - "")))) + (str "Failed while writing " content))) ([filename application k] (emit-content filename nil nil application k)) ([filename spec entity application k] @@ -143,7 +138,8 @@ (defn csrf-widget - "For the present, just return the standard cross site scripting protection field statement" + "For the present, just return the standard cross site scripting protection + field statement" [] "{% csrf-field %}") @@ -179,16 +175,20 @@ (defn save-widget - "Return an appropriate 'save' widget for this `form` operating on this `entity` taken - from this `application`. - TODO: should be suppressed unless a member of a group which can insert or edit." + "Return an appropriate 'save' widget for this `form` operating on this + `entity` taken from this `application`. + TODO: should be suppressed unless a member of a group which can insert + or edit." [form entity application] (wrap-in-if-member-of {:tag :p :attrs {:class "widget action-safe"} :content [{:tag :label :attrs {:for "save-button" :class "action-safe"} - :content [(str "To save this " (:name (:attrs entity)) " record")]} + :content [(str + "To save this " + (:name (:attrs entity)) + " record")]} {:tag :input :attrs {:id "save-button" :name "save-button" @@ -201,16 +201,20 @@ (defn delete-widget - "Return an appropriate 'save' widget for this `form` operating on this `entity` taken - from this `application`. + "Return an appropriate 'save' widget for this `form` operating on this + `entity` taken from this `application`. TODO: should be suppressed unless member of a group which can delete." [form entity application] (wrap-in-if-member-of {:tag :p :attrs {:class "widget action-dangerous"} :content [{:tag :label - :attrs {:for "delete-button" :class "action-dangerous"} - :content [(str "To delete this " (:name (:attrs entity)) " record")]} + :attrs {:for "delete-button" + :class "action-dangerous"} + :content [(str + "To delete this " + (:name (:attrs entity)) + " record")]} {:tag :input :attrs {:id "delete-button" :name "delete-button" @@ -223,7 +227,8 @@ (defn select-property - "Return the property on which we will by default do a user search on this `entity`." + "Return the property on which we will by default do a user search on this + `entity`." [entity] (descendant-with-tag entity @@ -241,8 +246,8 @@ (defn get-options - "Produce template code to get options for this `property` of this `entity` taken from - this `application`." + "Produce template code to get options for this `property` of this `entity` + taken from this `application`." [property form entity application] (let [type (:type (:attrs property)) @@ -258,9 +263,9 @@ (:farkey (:attrs property)) (first (key-names farside)) "id")] - ;; Yes, I know it looks BONKERS generating this as an HTML string. But there is a - ;; reason. We don't know whether the `selected` attribute should be present or - ;; absent until rendering. + ;; Yes, I know it looks BONKERS generating this as an HTML string. But + ;; there is a reason. We don't know whether the `selected` attribute + ;; should be present or absent until rendering. [(str "{% for option in " (-> property :attrs :name) " %}