Merge remote-tracking branch 'origin/develop' into develop
This commit is contained in:
		
						commit
						981ff1d5fc
					
				|  | @ -183,6 +183,10 @@ | |||
|                           (str | ||||
|                             (safe-name (-> % :attrs :name) :sql) | ||||
|                             " = ':" (-> % :attrs :name) "'") | ||||
|                           "entity" | ||||
|                           (str | ||||
|                            (safe-name (-> % :attrs :name) :sql) | ||||
|                             "_expanded LIKE '%:" (-> % :attrs :name) "%'") | ||||
|                           (str | ||||
|                             (safe-name (-> % :attrs :name) :sql) | ||||
|                             " = :" | ||||
|  |  | |||
|  | @ -1,14 +1,14 @@ | |||
| (ns ^{:doc "Application Description Language: generate RING routes for REST requests." | ||||
|       :author "Simon Brooke"} | ||||
|   adl.to-json-routes | ||||
|   (:require [clojure.java.io :refer [file make-parents writer]] | ||||
|             [clojure.pprint :refer [pprint]] | ||||
|             [clojure.string :as s] | ||||
|             [clojure.xml :as x] | ||||
|   (:require [adl-support.utils :refer :all] | ||||
|             [adl.to-hugsql-queries :refer [queries]] | ||||
|             [clj-time.core :as t] | ||||
|             [clj-time.format :as f] | ||||
|             [adl-support.utils :refer :all] | ||||
|             [adl.to-hugsql-queries :refer [queries]])) | ||||
|             [clojure.java.io :refer [file make-parents writer]] | ||||
|             [clojure.pprint :refer [pprint]] | ||||
|             [clojure.string :as s] | ||||
|             [clojure.xml :as x])) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;;;; | ||||
|  | @ -47,8 +47,9 @@ | |||
|     (list | ||||
|       :require | ||||
|       '[adl-support.core :as support] | ||||
|       '[clojure.java.io :as io] | ||||
|       '[clojure.core.memoize :as memo] | ||||
|       '[clojure.java.io :as io] | ||||
|       '[clojure.tools.logging :as log] | ||||
|       '[compojure.core :refer [defroutes GET POST]] | ||||
|       '[hugsql.core :as hugsql] | ||||
|       '[noir.response :as nresponse] | ||||
|  |  | |||
|  | @ -2,12 +2,12 @@ | |||
|       :author "Simon Brooke"} | ||||
|   adl.to-selmer-routes | ||||
|   (:require [adl-support.utils :refer :all] | ||||
|             [clj-time.core :as t] | ||||
|             [clj-time.format :as f] | ||||
|             [clojure.java.io :refer [file make-parents writer]] | ||||
|             [clojure.pprint :refer [pprint]] | ||||
|             [clojure.string :as s] | ||||
|             [clojure.xml :as x] | ||||
|             [clj-time.core :as t] | ||||
|             [clj-time.format :as f] | ||||
|             )) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|  | @ -42,23 +42,128 @@ | |||
| (defn file-header | ||||
|   [application] | ||||
|   (list | ||||
|     'ns | ||||
|     (symbol (str (:name (:attrs application)) ".routes.auto")) | ||||
|     (str "User interface routes for " (pretty-name application) | ||||
|          " auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at " | ||||
|          (f/unparse (f/formatters :basic-date-time) (t/now))) | ||||
|    'ns | ||||
|    (symbol (str (:name (:attrs application)) ".routes.auto")) | ||||
|    (str "User interface routes for " (pretty-name application) | ||||
|         " auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at " | ||||
|         (f/unparse (f/formatters :basic-date-time) (t/now))) | ||||
|    (list | ||||
|     :require | ||||
|     '[adl-support.core :as support] | ||||
|     '[clojure.java.io :as io] | ||||
|     '[clojure.set :refer [subset?]] | ||||
|     '[clojure.tools.logging :as log] | ||||
|     '[compojure.core :refer [defroutes GET POST]] | ||||
|     '[hugsql.core :as hugsql] | ||||
|     '[noir.response :as nresponse] | ||||
|     '[noir.util.route :as route] | ||||
|     '[ring.util.http-response :as response] | ||||
|     (vector (symbol (str (:name (:attrs application)) ".layout")) :as 'l) | ||||
|     (vector (symbol (str (:name (:attrs application)) ".db.core")) :as 'db) | ||||
|     (vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm)))) | ||||
| 
 | ||||
| 
 | ||||
| (defn make-form-handler-content | ||||
|   [f e a n] | ||||
|   (let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")] | ||||
|     ;; 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) (set (list 'keys 'p))) | ||||
|                           (list | ||||
|                            (symbol | ||||
|                             (str "db/get-" (singularise (:name (:attrs e))))) | ||||
|                            (symbol "db/*db*") | ||||
|                            'p)) | ||||
|                     :message warning | ||||
|                     :error-return {:warnings [warning]})) | ||||
|           (reduce | ||||
|            merge | ||||
|            {:warnings (list :warnings 'record) | ||||
|             :record (list 'assoc 'record :warnings nil)} | ||||
|            (map | ||||
|             (fn [p] | ||||
|               (hash-map | ||||
|                (keyword (-> p :attrs :entity)) | ||||
|                (list 'support/do-or-log-error | ||||
|                      (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*")) | ||||
|                      :message (str "Error while fetching " | ||||
|                                    (singularise (:entity (:attrs p))) | ||||
|                                    " record")))) | ||||
|             (filter #(#{"entity" "link"} (:type (:attrs %))) | ||||
|                     (descendants-with-tag e :property))))))) | ||||
| 
 | ||||
| 
 | ||||
| (defn make-page-handler-content | ||||
|   [f e a n] | ||||
|   (let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")] | ||||
|     (list 'let | ||||
|           (vector 'record (list | ||||
|                            'support/handler-content-log-error | ||||
|                            (list 'if (list 'subset? (list 'keys 'p) (key-names e)) [] | ||||
|                                  (list | ||||
|                                   (symbol | ||||
|                                    (str "db/get-" (singularise (:name (:attrs e))))) | ||||
|                                   (symbol "db/*db*") | ||||
|                                   'p)) | ||||
|                            :message warning | ||||
|                            :error-return {:warnings [warning]})) | ||||
|            {:warnings (list :warnings 'record) | ||||
|             :record (list 'assoc 'record :warnings nil)}))) | ||||
| 
 | ||||
| 
 | ||||
| (defn make-list-handler-content | ||||
|   [f e a n] | ||||
|   (list | ||||
|    'let | ||||
|    (vector | ||||
|     'records | ||||
|     (list | ||||
|       :require | ||||
|       '[adl-support.core :as support] | ||||
|       '[clojure.java.io :as io] | ||||
|       '[compojure.core :refer [defroutes GET POST]] | ||||
|       '[hugsql.core :as hugsql] | ||||
|       '[noir.response :as nresponse] | ||||
|       '[noir.util.route :as route] | ||||
|       '[ring.util.http-response :as response] | ||||
|       (vector (symbol (str (:name (:attrs application)) ".layout")) :as 'l) | ||||
|       (vector (symbol (str (:name (:attrs application)) ".db.core")) :as 'db) | ||||
|       (vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm)))) | ||||
|      'if | ||||
|      (list | ||||
|       'some | ||||
|       (set (map #(-> % :attrs :name) (all-properties e))) | ||||
|       (list 'keys 'p)) | ||||
|      (list | ||||
|       'support/do-or-log-error | ||||
|       (list | ||||
|        (symbol | ||||
|         (str | ||||
|          "db/search-strings-" | ||||
|          (singularise (:name (:attrs e))))) | ||||
|        (symbol "db/*db*") | ||||
|        'p) | ||||
|       :message (str | ||||
|                 "Error while searching " | ||||
|                 (singularise (:name (:attrs e))) | ||||
|                 " records") | ||||
|       :error-return {:warnings [(str | ||||
|                                  "Error while searching " | ||||
|                                  (singularise (:name (:attrs e))) | ||||
|                                  " records")]}) | ||||
|      (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] | ||||
|  | @ -122,47 +227,59 @@ | |||
|                            (:name (:attrs e)))) | ||||
|                        (symbol "db/*db*") {}))}))))))) | ||||
| 
 | ||||
| ;; (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)) | ||||
| ;; (vector | ||||
| ;;  'p | ||||
| ;;  (list 'merge | ||||
| ;;        {:offset 0 :limit 25} | ||||
| ;;        (list 'support/massage-params (list :params 'r)))) | ||||
| ;; (make-handler f e a) | ||||
| 
 | ||||
| 
 | ||||
| (defn make-route | ||||
|   "Make a route for method `m` to request the resource with name `n`." | ||||
|   [m n] | ||||
|   (list | ||||
|     m | ||||
|     (str "/" n) | ||||
|     'request | ||||
|    m | ||||
|    (str "/" n) | ||||
|    'request | ||||
|    (list | ||||
|     'route/restricted | ||||
|     (list | ||||
|       'route/restricted | ||||
|       (list | ||||
|         'apply | ||||
|         (list 'resolve-handler n) | ||||
|         (list 'list 'request))))) | ||||
|      'apply | ||||
|      (list 'resolve-handler n) | ||||
|      (list 'list 'request))))) | ||||
| 
 | ||||
| (defn make-defroutes | ||||
|   [application] | ||||
|   (let [routes (flatten | ||||
|                  (map | ||||
|                    (fn [e] | ||||
|                      (map | ||||
|                        (fn [c] | ||||
|                          (path-part c e application)) | ||||
|                        (filter (fn [c] (#{:form :list :page} (:tag c))) (children e)))) | ||||
|                    (children-with-tag application :entity)))] | ||||
|                 (map | ||||
|                  (fn [e] | ||||
|                    (map | ||||
|                     (fn [c] | ||||
|                       (path-part c e application)) | ||||
|                     (filter (fn [c] (#{:form :list :page} (:tag c))) (children e)))) | ||||
|                  (children-with-tag application :entity)))] | ||||
|     (cons | ||||
|       'defroutes | ||||
|      'defroutes | ||||
|      (cons | ||||
|       'auto-selmer-routes | ||||
|       (cons | ||||
|         'auto-selmer-routes | ||||
|         (cons | ||||
|           '(GET | ||||
|              "/admin" | ||||
|              request | ||||
|              (route/restricted | ||||
|                (apply (resolve-handler "index") (list request)))) | ||||
|           (interleave | ||||
|             (map | ||||
|               (fn [r] (make-route 'GET r)) | ||||
|               (sort routes)) | ||||
|             (map | ||||
|               (fn [r] (make-route 'POST r)) | ||||
|               (sort routes)))))))) | ||||
|        '(GET | ||||
|          "/admin" | ||||
|          request | ||||
|          (route/restricted | ||||
|           (apply (resolve-handler "index") (list request)))) | ||||
|        (interleave | ||||
|         (map | ||||
|          (fn [r] (make-route 'GET r)) | ||||
|          (sort routes)) | ||||
|         (map | ||||
|          (fn [r] (make-route 'POST r)) | ||||
|          (sort routes)))))))) | ||||
| 
 | ||||
| 
 | ||||
| (defn generate-handler-resolver | ||||
|  | @ -171,17 +288,27 @@ | |||
|   were doing could write this more elegantly." | ||||
|   [application] | ||||
|   (list | ||||
|     'defn | ||||
|     'raw-resolve-handler | ||||
|     "Prefer the manually-written version of the handler with name `n`, if it exists, to the automatically generated one" | ||||
|     (vector 'n) | ||||
|     (list 'try | ||||
|           (list 'eval (list 'symbol (list 'str (:name (:attrs application)) ".routes.manual/" 'n))) | ||||
|           (list 'catch | ||||
|                 'Exception '_ | ||||
|                 (list 'eval | ||||
|                       (list 'symbol | ||||
|                             (list 'str (:name (:attrs application)) ".routes.auto/" 'n))))))) | ||||
|    'defn | ||||
|    'raw-resolve-handler | ||||
|    "Prefer the manually-written version of the handler with name `n`, if it exists, to the automatically generated one" | ||||
|    (vector 'n) | ||||
|    (list 'try | ||||
|          (list 'eval (list 'symbol (list 'str (:name (:attrs application)) ".routes.manual/" 'n))) | ||||
|          (list 'catch | ||||
|                'Exception '_ | ||||
|                (list 'eval | ||||
|                      (list 'symbol | ||||
|                            (list 'str (:name (:attrs application)) ".routes.auto/" 'n))))))) | ||||
| 
 | ||||
| 
 | ||||
| (defn make-handlers | ||||
|   [e application] | ||||
|   (doall | ||||
|    (map | ||||
|     (fn [c] | ||||
|       (pprint (make-handler c e application)) | ||||
|       (println)) | ||||
|     (filter (fn [c] (#{:form :list :page} (:tag c))) (children e))))) | ||||
| 
 | ||||
| 
 | ||||
| (defn to-selmer-routes | ||||
|  | @ -196,25 +323,19 @@ | |||
|           (pprint '(defn index | ||||
|                      [r] | ||||
|                      (l/render | ||||
|                        (support/resolve-template | ||||
|                          "application-index.html") | ||||
|                        (:session r) | ||||
|                        {:title "Administrative menu"}))) | ||||
|                       (support/resolve-template | ||||
|                        "application-index.html") | ||||
|                       (:session r) | ||||
|                       {:title "Administrative menu"}))) | ||||
|           (println) | ||||
|           (doall | ||||
|             (map | ||||
|               (fn [e] | ||||
|                 (doall | ||||
|                   (map | ||||
|                     (fn [c] | ||||
|                       (pprint (make-handler c e application)) | ||||
|                       (println)) | ||||
|                     (filter (fn [c] (#{:form :list :page} (:tag c))) (children e))))) | ||||
|               (sort | ||||
|                 #(compare (:name (:attrs %1))(:name (:attrs %2))) | ||||
|                 (children-with-tag application :entity)))) | ||||
|            (map | ||||
|             #(make-handlers % application) | ||||
|             (sort | ||||
|              #(compare (:name (:attrs %1))(:name (:attrs %2))) | ||||
|              (children-with-tag application :entity)))) | ||||
|           (pprint | ||||
|             (generate-handler-resolver application)) | ||||
|            (generate-handler-resolver application)) | ||||
|           (println) | ||||
|           (pprint '(def resolve-handler | ||||
|                      (memoize raw-resolve-handler))) | ||||
|  | @ -226,10 +347,10 @@ | |||
|       (catch | ||||
|         Exception any | ||||
|         (println | ||||
|           (str | ||||
|             "ERROR: Exception " | ||||
|             (.getName (.getClass any)) | ||||
|             (.getMessage any) | ||||
|             " while printing " | ||||
|             filepath)))))) | ||||
|          (str | ||||
|           "ERROR: Exception " | ||||
|           (.getName (.getClass any)) | ||||
|           (.getMessage any) | ||||
|           " while printing " | ||||
|           filepath)))))) | ||||
| 
 | ||||
|  |  | |||
|  | @ -39,7 +39,7 @@ | |||
|   {:tag :div | ||||
|    :attrs {:class "big-link-container"} | ||||
|    :content | ||||
|    [{:tag :a :attrs {:href url} | ||||
|    [{:tag :a :attrs {:href url :class "big-link"} | ||||
|      :content (if | ||||
|                 (vector? content) | ||||
|                 content | ||||
|  | @ -62,22 +62,24 @@ | |||
|   ([filename application k] | ||||
|    (emit-content filename nil nil application k)) | ||||
|   ([filename spec entity application k] | ||||
|    (let [content (:content | ||||
|                    (first | ||||
|                      (or (children-with-tag spec k) | ||||
|                          (children-with-tag entity k) | ||||
|                          (children-with-tag | ||||
|                            (first | ||||
|                              (children-with-tag application :content)) | ||||
|                            k))))] | ||||
|    (let [content | ||||
|          (:content | ||||
|           (first | ||||
|            (or (children-with-tag spec k) | ||||
|                (children-with-tag entity k) | ||||
|                (children-with-tag | ||||
|                 (child-with-tag application :content) | ||||
|                 k))))] | ||||
|      (if | ||||
|        content | ||||
|        (list | ||||
|        (flatten | ||||
|         (list | ||||
|          (str "{% block " (name k) " %}") | ||||
|          (map | ||||
|          (doall | ||||
|           (map | ||||
|            #(with-out-str (x/emit-element %)) | ||||
|            content) | ||||
|          "{% endblock %}"))))) | ||||
|            content)) | ||||
|          "{% endblock %}")))))) | ||||
| 
 | ||||
| 
 | ||||
| (defn file-header | ||||
|  | @ -484,7 +486,7 @@ | |||
|             :content | ||||
|             [{:tag :input | ||||
|               :attrs {:type "submit" | ||||
|                       :id "search" | ||||
|                       :id "search-widget" | ||||
|                       :value "Search"}}]})))}]}) | ||||
| 
 | ||||
| 
 | ||||
|  | @ -540,51 +542,77 @@ | |||
|     "{% endfor %}"]}) | ||||
| 
 | ||||
| 
 | ||||
| (defn- list-page-control | ||||
|   "What this needs to do is emit an HTML control which, when selected, requests the | ||||
|   next or previous page keeping the same search parameters; so it essentially needs | ||||
|   to be a submit button, not a link." | ||||
|   [forward?] | ||||
|   {:tag :div | ||||
|    :attrs {:class (if forward? "big-link-container" "back-link-container")} | ||||
|    :content | ||||
|    [{:tag :input | ||||
|      :attrs {:id "page" | ||||
|              :name "page" | ||||
|              :disabled (if | ||||
|                          forward? | ||||
|                          false | ||||
|                          "{% ifequal offset 0 %} false {% else %} true {% endifequal %}") | ||||
|              ;; TODO: real thought needs to happen on doing i18n for this! | ||||
|              :value (if forward? "Next" "Previous")}}]}) | ||||
| 
 | ||||
| 
 | ||||
| (defn- list-tfoot | ||||
|   "Return a table footer element for the list view for this `list-spec` of this `entity` within | ||||
|   this `application`." | ||||
|   [list-spec entity application] | ||||
|   {:tag :tfoot | ||||
|    :content | ||||
|    [(list-page-control false) | ||||
|     (list-page-control true)]}) | ||||
| 
 | ||||
| 
 | ||||
| (defn list-to-template | ||||
|   "Generate a template as specified by this `list` element for this `entity`, | ||||
|   taken from this `application`. If `list` is nill, generate a default list | ||||
|   template for the entity." | ||||
|   [list-spec entity application] | ||||
|   {:content | ||||
|    {:tag :form | ||||
|    :attrs {:id "content" :class "list"} | ||||
|    :content | ||||
|    [(big-link (str "Add a new " (pretty-name entity)) (editor-name entity application)) | ||||
|     {:tag :table | ||||
|      :attrs {:caption (:name (:attrs entity))} | ||||
|   (let [form-name | ||||
|         (str | ||||
|          "list-" | ||||
|          (:name (:attrs entity)) | ||||
|          "-" | ||||
|          (:name (:attrs list-spec)))] | ||||
|     {:back-links | ||||
|      {:tag :div | ||||
|       :content | ||||
|       [ | ||||
|        {:tag :div :attrs {:class "back-link-container"} | ||||
|         :content | ||||
|         ["{% ifequal params.offset \"0\" %}" | ||||
|           {:tag :a | ||||
|           :attrs {:id "back-link" :class "back-link" :href "{{servlet-context}}/admin"} | ||||
|           :content ["Back"]} | ||||
|          "{% else %}" | ||||
|           {:tag :a :attrs {:id "prev-selector" :class "back-link"} | ||||
|           :content ["Previous"]} | ||||
|          "{% endifunequal %}"]} | ||||
|        ]} | ||||
|      :big-links | ||||
|      {:tag :div | ||||
|       :content | ||||
|       [{:tag :div :attrs {:class "big-link-container"} | ||||
|         :content | ||||
|         [{:tag :a :attrs {:id "next-selector" :role "button" :class "big-link"} | ||||
|           :content ["Next"]}]} | ||||
|        (big-link (str "Add a new " (pretty-name entity)) (editor-name entity application))]} | ||||
|      :content | ||||
|      [(list-thead list-spec entity application) | ||||
|       (list-tbody list-spec entity application) | ||||
|       (list-tfoot list-spec entity application)]}]}}) | ||||
|      {:tag :form | ||||
|       :attrs {:id form-name :class "list" | ||||
|               :action (str "{{servlet-context}}/" form-name) | ||||
|               :method "POST"} | ||||
|       :content | ||||
|       [(csrf-widget) | ||||
|        {:tag :input :attrs {:id "offset" :type "hidden" :value "{{params.offset|default:0}}"}} | ||||
|        {:tag :input :attrs {:id "limit" :type "hidden" :value "{{params.limit|default:50}}"}} | ||||
|        {:tag :table | ||||
|         :attrs {:caption (:name (:attrs entity))} | ||||
|         :content | ||||
|           [(list-thead list-spec entity application) | ||||
|            (list-tbody list-spec entity application) | ||||
|            ]}]} | ||||
|      :extra-script | ||||
|      (str " | ||||
|           var form = document.getElementById('" form-name "'); | ||||
|           var ow = document.getElementById('offset'); | ||||
|           var lw = document.getElementById('limit'); | ||||
|           form.addEventListener('submit', function() { | ||||
|             ow.value='0'; | ||||
|           }); | ||||
| 
 | ||||
|           {% ifunequal params.offset \"0\" %} | ||||
|           document.getElementById('prev-selector').addEventListener('click', function () { | ||||
|             ow.value=(parseInt(ow.value)-parseInt(lw.value)); | ||||
|             console.log('Updated offset to ' + ow.value); | ||||
|             form.submit(); | ||||
|           }); | ||||
|           {% endifunequal %} | ||||
| 
 | ||||
|           document.getElementById('next-selector').addEventListener('click', function () { | ||||
|             ow.value=(parseInt(ow.value)+parseInt(lw.value)); | ||||
|             console.log('Updated offset to ' + ow.value); | ||||
|             form.submit(); | ||||
|           });")})) | ||||
| 
 | ||||
| 
 | ||||
| (defn entity-to-templates | ||||
|  | @ -628,80 +656,84 @@ | |||
|   (let | ||||
|     [first-class-entities | ||||
|      (sort-by | ||||
|        #(:name (:attrs %)) | ||||
|        (filter | ||||
|          #(children-with-tag % :list) | ||||
|          (children-with-tag application :entity)))] | ||||
|       #(:name (:attrs %)) | ||||
|       (filter | ||||
|        #(children-with-tag % :list) | ||||
|        (children-with-tag application :entity)))] | ||||
|     {:application-index | ||||
|      {:tag :dl | ||||
|       :attrs {:class "index"} | ||||
|       :content | ||||
|       (apply | ||||
|      {:content | ||||
|       {:tag :dl | ||||
|        :attrs {:class "index"} | ||||
|        :content | ||||
|        (apply | ||||
|         vector | ||||
|         (interleave | ||||
|           (map | ||||
|             #(hash-map | ||||
|                :tag :dt | ||||
|                :content | ||||
|                [{:tag :a | ||||
|                  :attrs {:href (path-part :list % application)} | ||||
|                  :content [(pretty-name %)]}]) | ||||
|             first-class-entities) | ||||
|           (map | ||||
|             #(hash-map | ||||
|                :tag :dd | ||||
|                :content (apply | ||||
|                           vector | ||||
|                           (map | ||||
|                             (fn [d] | ||||
|                               (hash-map | ||||
|                                 :tag :p | ||||
|                                 :content (:content d))) | ||||
|                             (children-with-tag % :documentation)))) | ||||
|             first-class-entities)))}})) | ||||
|          (map | ||||
|           #(hash-map | ||||
|             :tag :dt | ||||
|             :content | ||||
|             [{:tag :a | ||||
|               :attrs {:href (path-part :list % application)} | ||||
|               :content [(pretty-name %)]}]) | ||||
|           first-class-entities) | ||||
|          (map | ||||
|           #(hash-map | ||||
|             :tag :dd | ||||
|             :content (apply | ||||
|                       vector | ||||
|                       (map | ||||
|                        (fn [d] | ||||
|                          (hash-map | ||||
|                           :tag :p | ||||
|                           :content (:content d))) | ||||
|                        (children-with-tag % :documentation)))) | ||||
|           first-class-entities)))}}})) | ||||
| 
 | ||||
| 
 | ||||
| (defn write-template-file | ||||
|   [filename template application] | ||||
|   (let [filepath (str *output-path* "resources/templates/auto/" filename)] | ||||
|     (make-parents filepath) | ||||
|     (if | ||||
|       template | ||||
|       (try | ||||
|         (spit | ||||
|           filepath | ||||
|           (s/join | ||||
|         (do | ||||
|           (spit | ||||
|            filepath | ||||
|            (s/join | ||||
|             "\n" | ||||
|             (flatten | ||||
|               (list | ||||
|                 (file-header filename application) | ||||
|                 (map | ||||
|                   #(cond | ||||
|                      (:tag %) | ||||
|                      (with-out-str | ||||
|                        (x/emit-element %)) | ||||
|                      (string? %) | ||||
|                      % | ||||
|                      true | ||||
|                      (str ";; WTF? " %)) | ||||
|                   (:header template)) | ||||
|                 "{% block content %}" | ||||
|                 (with-out-str | ||||
|                   (x/emit-element (:content template))) | ||||
|                 (file-footer filename application))))) | ||||
|         (if (> *verbosity* 0) (println "\tGenerated " filepath)) | ||||
|              (list | ||||
|               (file-header filename application) | ||||
|               (doall | ||||
|                (map | ||||
|                 #(let [content (template %)] | ||||
|                    (list | ||||
|                     (str "{% block " (name %) " %}") | ||||
|                     (cond (string? content) | ||||
|                           content | ||||
|                           (map? content) | ||||
|                           (with-out-str | ||||
|                             (x/emit-element content)) | ||||
|                           true | ||||
|                           (str "<!-- don't know what to do with '" content "' -->")) | ||||
|                     "{% endblock %}")) | ||||
|                    (keys template))) | ||||
|               (file-footer filename application))))) | ||||
|           (if (> *verbosity* 0) (println "\tGenerated " filepath))) | ||||
|         (catch Exception any | ||||
|           (let [report (str | ||||
|                          "ERROR: Exception " | ||||
|                          (.getName (.getClass any)) | ||||
|                          (.getMessage any) | ||||
|                          " while printing " | ||||
|                          filename)] | ||||
|             (spit | ||||
|               filepath | ||||
|               (with-out-str | ||||
|                 (println (str "<!-- " report "-->")) | ||||
|                 (p/pprint template))) | ||||
|                         "ERROR: Exception " | ||||
|                         (.getName (.getClass any)) | ||||
|                         (.getMessage any) | ||||
|                         " while printing " | ||||
|                         filepath)] | ||||
|             (try | ||||
|               (spit | ||||
|                filepath | ||||
|                (with-out-str | ||||
|                  (println (str "<!-- " report "-->")) | ||||
|                  (p/pprint template))) | ||||
|               (catch Exception _ nil)) | ||||
|             (println report) | ||||
|             (throw any))))) | ||||
|     (str filepath))) | ||||
|  |  | |||
		Loading…
	
		Reference in a new issue