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

Tactical commit

Browse source
This commit is contained in:
Simon Brooke 2018-06-30 20:05:55 +01:00
parent 2d7e39ca29
commit 16f953741b
1 changed files with 121 additions and 81 deletions

202
src/adl/to_selmer_templates.clj
View file

@ -99,8 +99,7 @@
"See [Application Description Language](https://github.com/simon-brooke/adl)." "See [Application Description Language](https://github.com/simon-brooke/adl)."
"-->") "-->")
(emit-content filename spec entity application :head) (emit-content filename spec entity application :head)
(emit-content filename spec entity application :top) (emit-content filename spec entity application :top))))))
"{% block content %}")))))
(defn file-footer (defn file-footer
@ -110,12 +109,8 @@
(file-footer filename nil nil application)) (file-footer filename nil nil application))
([filename spec entity application] ([filename spec entity application]
(s/join (s/join
"\n" "\n"
(flatten (emit-content filename spec entity application :foot))))
(list
"{% endblock %}"
(emit-content filename spec entity application :foot)
)))))
(defn prompt (defn prompt
@ -362,25 +357,26 @@
[keyfields (children [keyfields (children
;; there should only be one key; its keys are properties ;; there should only be one key; its keys are properties
(first (children entity #(= (:tag %) :key))))] (first (children entity #(= (:tag %) :key))))]
{:tag :div {:content
:attrs {:id "content" :class "edit"} {:tag :div
:content :attrs {:id "content" :class "edit"}
[{:tag :form :content
:attrs {:action (str "{{servlet-context}}/" (editor-name entity application)) [{:tag :form
:method "POST"} :attrs {:action (str "{{servlet-context}}/" (editor-name entity application))
:content (flatten :method "POST"}
(list :content (flatten
(csrf-widget) (list
(map (csrf-widget)
#(widget % form entity application) (map
keyfields) #(widget % form entity application)
(map keyfields)
#(widget % form entity application) (map
(remove #(widget % form entity application)
#(= (:distict (:attrs %)) :system) (remove
(fields entity))) #(= (:distict (:attrs %)) :system)
(save-widget form entity application) (fields entity)))
(delete-widget form entity application)))}]})) (save-widget form entity application)
(delete-widget form entity application)))}]}}))
@ -536,16 +532,46 @@
taken from this `application`. If `list` is nill, generate a default list taken from this `application`. If `list` is nill, generate a default list
template for the entity." template for the entity."
[list-spec entity application] [list-spec entity application]
{:tag :form (let [form-name
:attrs {:id "content" :class "list"} (str
:content "list-"
[(big-link (str "Add a new " (pretty-name entity)) (editor-name entity application)) (:name (:attrs entity))
{:tag :table "-"
:attrs {:caption (:name (:attrs entity))} (:name (:attrs list-spec)))]
{: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 :content
[(list-thead list-spec entity application) {:tag :form
(list-tbody list-spec entity application) :attrs {:id form-name :class "list"
(list-tfoot list-spec entity application)]}]}) :action (str "{{servlet-context}}/" form-name)
:method "POST"}
:content
[
(csrf-widget)
{:tag :input :attrs {:id "offset" :type "hidden" :value "{{offset|0}}"}}
{:tag :input :attrs {:id "limit" :type "hidden" :value "{{limit|50}}"}}
(big-link (str "Add a new " (pretty-name entity)) (editor-name entity application))
{:tag :table
:attrs {:caption (:name (:attrs entity))}
:content
[(list-thead list-spec entity application)
(list-tbody list-spec entity application)
(list-tfoot list-spec entity application)]}]}
:extra-script
(str "var form = document.getElementById('" form-name "');
var ow = document.getElementById('offset');
var lw = document.getElementById('limit');
document.getElementById('next-selector').addEventListener('click', function () {
ow.text=(parseInt(ow.text)+parseInt(lw.text));
//form.submit();
});")}))
(defn entity-to-templates (defn entity-to-templates
@ -589,35 +615,36 @@
[application] [application]
(let (let
[first-class-entities (filter [first-class-entities (filter
#(children-with-tag % :list) #(children-with-tag % :list)
(children-with-tag application :entity))] (children-with-tag application :entity))]
{:application-index {:content
{:tag :dl {:application-index
:attrs {:class "index"} {:tag :dl
:content :attrs {:class "index"}
(apply :content
(apply
vector vector
(interleave (interleave
(map (map
#(hash-map #(hash-map
:tag :dt :tag :dt
:content :content
[{:tag :a [{:tag :a
:attrs {:href (path-part :list % application)} :attrs {:href (path-part :list % application)}
:content [(pretty-name %)]}]) :content [(pretty-name %)]}])
first-class-entities) first-class-entities)
(map (map
#(hash-map #(hash-map
:tag :dd :tag :dd
:content (apply :content (apply
vector vector
(map (map
(fn [d] (fn [d]
(hash-map (hash-map
:tag :p :tag :p
:content (:content d))) :content (:content d)))
(children-with-tag % :documentation)))) (children-with-tag % :documentation))))
first-class-entities)))}})) first-class-entities)))}}}))
@ -627,26 +654,39 @@
template template
(try (try
(spit (spit
(str *output-path* filename) (str *output-path* filename)
(s/join (s/join
"\n" "\n"
(list (flatten
(file-header filename application) (list
(with-out-str (file-header filename application)
(x/emit-element template)) (doall
(file-footer filename application)))) (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)))))
(catch Exception any (catch Exception any
(spit (spit
(str *output-path* filename) (str *output-path* filename)
(with-out-str (with-out-str
(println (println
(str (str
"<!-- Exception " "<!-- Exception "
(.getName (.getClass any)) (.getName (.getClass any))
(.getMessage any) (.getMessage any)
" while printing " " while printing "
filename "-->")) filename "-->"))
(p/pprint template)))))) (p/pprint template))))))
filename) filename)