Work on getting forms to go. Not yet complete.

2018-06-19 08:23:30 +01:00 · 2018-06-19 08:23:30 +01:00 · 284509fa7b
commit 284509fa7b
parent 6f09c0841c
40 changed files with 866 additions and 684 deletions
--- a/src/clj/youyesyet/layout.clj
+++ b/src/clj/youyesyet/layout.clj
@ -1,44 +1,67 @@
-(ns^{:doc "Render web pages using Selmer tamplating markup."
-      :author "Simon Brooke"}
-   youyesyet.layout
-  (:require [selmer.parser :as parser]
-            [selmer.filters :as filters]
-            [markdown.core :refer [md-to-html-string]]
-            [ring.util.http-response :refer [content-type ok]]
-            [ring.util.anti-forgery :refer [anti-forgery-field]]
-            [ring.middleware.anti-forgery :refer [*anti-forgery-token*]]))
+  (ns^{:doc "Render web pages using Selmer templating markup."
+        :author "Simon Brooke"}
+     youyesyet.layout
+    (:require [selmer.parser :as parser]
+              [selmer.filters :as filters]
+              [markdown.core :refer [md-to-html-string]]
+              [noir.session :as session]
+              [ring.util.http-response :refer [content-type ok]]
+              [ring.util.anti-forgery :refer [anti-forgery-field]]
+              [ring.middleware.anti-forgery :refer [*anti-forgery-token*]]))


-(declare ^:dynamic *app-context*)
-(parser/set-resource-path!  (clojure.java.io/resource "templates"))
-(parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field)))
-(filters/add-filter! :markdown (fn [content] [:safe (md-to-html-string content)]))
+
+  (declare ^:dynamic *app-context*)
+  (parser/set-resource-path!  (clojure.java.io/resource "templates"))
+  (parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field)))
+  (filters/add-filter! :markdown (fn [content] [:safe (md-to-html-string content)]))


-(defn render
-  "renders the HTML template located relative to resources/templates"
-  [template & [params]]
-  (content-type
-    (ok
-      (parser/render-file
-        template
-        (assoc params
-          :page template
-          :csrf-token *anti-forgery-token*
-          :servlet-context *app-context*
-          :version (System/getProperty "youyesyet.version"))))
-    "text/html; charset=utf-8"))
+  (parser/add-tag! :ifmemberof
+                   (fn [args context content]
+                     (let [permitted (if args (some (:user-groups context) args) false)]
+                       (if permitted
+                       (get-in content [:ifreadable :content]))))
+                   :else
+                   (fn [args context content]
+                     (let [permitted (if args (some (:user-groups context) args) false)]
+                       (if (not permitted)
+                       (get-in content [:else :content]))))
+                   :ifmemberof)


-(defn error-page
-  "error-details should be a map containing the following keys:
-   :status - error status
-   :title - error title (optional)
-   :message - detailed error message (optional)
+  (defn raw-get-user-roles [_]
+    #{"admin" "canvassers"})

-   returns a response map with the error page as the body
-   and the status specified by the status key"
-  [error-details]
-  {:status  (:status error-details)
-   :headers {"Content-Type" "text/html; charset=utf-8"}
-   :body    (parser/render-file "error.html" error-details)})
+  (def get-user-roles (memoize raw-get-user-roles))
+
+
+  (defn render
+    "renders the HTML template located relative to resources/templates"
+    [template & [params]]
+    (let [user (try session/get :user)]
+      (content-type
+       (ok
+        (parser/render-file
+         template
+         (assoc params
+           :page template
+           :csrf-token *anti-forgery-token*
+           :user user
+           :user-roles [get-user-roles user]
+           :version (System/getProperty "youyesyet.version"))))
+       "text/html; charset=utf-8")))
+
+
+  (defn error-page
+    "error-details should be a map containing the following keys:
+     :status - error status
+     :title - error title (optional)
+     :message - detailed error message (optional)
+
+     returns a response map with the error page as the body
+     and the status specified by the status key"
+    [error-details]
+    {:status  (:status error-details)
+     :headers {"Content-Type" "text/html; charset=utf-8"}
+     :body    (parser/render-file "error.html" error-details)})
--- a/src/clj/youyesyet/routes/auto.clj
+++ b/src/clj/youyesyet/routes/auto.clj
@ -1,6 +1,6 @@
 (ns
 youyesyet.routes.auto
- "User interface routes for Youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180615T084444.957Z"
+ "User interface routes for Youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180617T110557.025Z"
 (:require
  [clojure.java.io :as io]
  [compojure.core :refer [defroutes GET POST]]
@ -33,7 +33,7 @@
 list-electors-Electors
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-electors-Electors.html")
   {:title "Electors",
@ -48,16 +48,22 @@
 form-electors-Elector
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-electors-Elector.html")
-   {:title "Elector", :params p, :record (db/get-elector p)})))
+   {:title "Elector",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-elector db/*db* p))})))

 (defn
 list-genders-Genders
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-genders-Genders.html")
   {:title "Genders",
@ -72,16 +78,22 @@
 form-genders-Gender
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-genders-Gender.html")
-   {:title "Gender", :params p, :record (db/get-gender p)})))
+   {:title "Gender",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-gender db/*db* p))})))

 (defn
 list-dwellings-Dwellings
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-dwellings-Dwellings.html")
   {:title "Dwellings",
@ -96,16 +108,22 @@
 form-dwellings-Dwelling
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-dwellings-Dwelling.html")
-   {:title "Dwelling", :params p, :record (db/get-dwelling p)})))
+   {:title "Dwelling",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-dwelling db/*db* p))})))

 (defn
 list-addresses-Addresses
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-addresses-Addresses.html")
   {:title "Addresses",
@ -120,16 +138,22 @@
 form-addresses-Address
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-addresses-Address.html")
-   {:title "Address", :params p, :record (db/get-address p)})))
+   {:title "Address",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-address db/*db* p))})))

 (defn
 list-visits-Visits
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-visits-Visits.html")
   {:title "Visits",
@ -144,16 +168,19 @@
 form-visits-Visit
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-visits-Visit.html")
-   {:title "Visit", :params p, :record (db/get-visit p)})))
+   {:title "Visit",
+    :params p,
+    :record
+    (if (empty? (remove nil? (vals p))) [] (db/get-visit db/*db* p))})))

 (defn
 list-authorities-Authorities
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-authorities-Authorities.html")
   {:title "Authorities",
@ -168,16 +195,22 @@
 form-authorities-Authority
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-authorities-Authority.html")
-   {:title "Authority", :params p, :record (db/get-authority p)})))
+   {:title "Authority",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-authority db/*db* p))})))

 (defn
 list-issues-Issues
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-issues-Issues.html")
   {:title "Issues",
@ -192,16 +225,19 @@
 form-issues-Issue
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-issues-Issue.html")
-   {:title "Issue", :params p, :record (db/get-issue p)})))
+   {:title "Issue",
+    :params p,
+    :record
+    (if (empty? (remove nil? (vals p))) [] (db/get-issue db/*db* p))})))

 (defn
 list-intentions-Intentions
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-intentions-Intentions.html")
   {:title "Intentions",
@ -216,16 +252,22 @@
 form-intentions-Intention
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-intentions-Intention.html")
-   {:title "Intention", :params p, :record (db/get-intention p)})))
+   {:title "Intention",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-intention db/*db* p))})))

 (defn
 list-canvassers-Canvassers
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-canvassers-Canvassers.html")
   {:title "Canvassers",
@ -240,16 +282,22 @@
 form-canvassers-Canvasser
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-canvassers-Canvasser.html")
-   {:title "Canvasser", :params p, :record (db/get-canvasser p)})))
+   {:title "Canvasser",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-canvasser db/*db* p))})))

 (defn
 list-followuprequests-Followuprequests
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-followuprequests-Followuprequests.html")
   {:title "Followuprequests",
@ -264,18 +312,22 @@
 form-followuprequests-Followuprequest
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-followuprequests-Followuprequest.html")
   {:title "Followuprequest",
    :params p,
-    :record (db/get-followuprequest p)})))
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-followuprequest db/*db* p))})))

 (defn
 list-roles-Roles
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-roles-Roles.html")
   {:title "Roles",
@ -290,16 +342,19 @@
 form-roles-Role
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-roles-Role.html")
-   {:title "Role", :params p, :record (db/get-role p)})))
+   {:title "Role",
+    :params p,
+    :record
+    (if (empty? (remove nil? (vals p))) [] (db/get-role db/*db* p))})))

 (defn
 list-teams-Teams
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-teams-Teams.html")
   {:title "Teams",
@ -314,16 +369,19 @@
 form-teams-Team
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-teams-Team.html")
-   {:title "Team", :params p, :record (db/get-team p)})))
+   {:title "Team",
+    :params p,
+    :record
+    (if (empty? (remove nil? (vals p))) [] (db/get-team db/*db* p))})))

 (defn
 list-districts-Districts
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-districts-Districts.html")
   {:title "Districts",
@ -338,16 +396,22 @@
 form-districts-District
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-districts-District.html")
-   {:title "District", :params p, :record (db/get-district p)})))
+   {:title "District",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-district db/*db* p))})))

 (defn
 list-followupactions-Followupactions
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-followupactions-Followupactions.html")
   {:title "Followupactions",
@ -362,18 +426,22 @@
 form-followupactions-Followupaction
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-followupactions-Followupaction.html")
   {:title "Followupaction",
    :params p,
-    :record (db/get-followupaction p)})))
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-followupaction db/*db* p))})))

 (defn
 list-options-Options
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-options-Options.html")
   {:title "Options",
@ -388,16 +456,22 @@
 form-options-Option
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-options-Option.html")
-   {:title "Option", :params p, :record (db/get-option p)})))
+   {:title "Option",
+    :params p,
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-option db/*db* p))})))

 (defn
 list-followupmethods-Followupmethods
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "list-followupmethods-Followupmethods.html")
   {:title "Followupmethods",
@ -412,12 +486,16 @@
 form-followupmethods-Followupmethod
 [r]
 (let
-  [p (:form-params r)]
+  [p (:params r)]
  (l/render
   (resolve-template "form-followupmethods-Followupmethod.html")
   {:title "Followupmethod",
    :params p,
-    :record (db/get-followupmethod p)})))
+    :record
+    (if
+     (empty? (remove nil? (vals p)))
+     []
+     (db/get-followupmethod db/*db* p))})))

 (defn
 raw-resolve-handler
--- a/src/clj/youyesyet/routes/auto_json.clj
+++ b/src/clj/youyesyet/routes/auto_json.clj
@ -1,6 +1,6 @@
 (ns
 youyesyet.routes.auto-json
- "JSON routes for youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180615T084443.981Z"
+ "JSON routes for youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180617T110553.546Z"
 (:require
  [clojure.java.io :as io]
  [compojure.core :refer [defroutes GET POST]]
--- a/src/clj/youyesyet/tags.clj
+++ b/src/clj/youyesyet/tags.clj
@ -0,0 +1,20 @@
+(ns^{:doc "Custom Selmer tags."
+      :author "Simon Brooke"}
+   youyesyet.tags
+  (:require [selmer.parser :as parser]
+            [selmer.filters :as filters]
+            [selmer.util :refer :all]))
+
+
+(defn if-writable-handler [params tag-content render rdr]
+  "If the current element is writable by the current user, emit the content of
+  the if clause; else emit the content of the else clause."
+  (let [{if-tags :ifwritable else-tags :else} (tag-content rdr :ifwritable :else :endifwritable)]
+    params))
+
+
+(defn if-readable-handler [params tag-content render rdr]
+  "If the current element is readable by the current user, emit the content of
+  the if clause; else emit the content of the else clause."
+  (let [{if-tags :ifreadable else-tags :else} (tag-content rdr :ifwritable :else :endifwritable)]
+    params))