Much progress, nothing yet works.

This commit is contained in:
Simon Brooke 2018-06-20 09:17:53 +01:00
parent 284509fa7b
commit acfaf985fa
40 changed files with 1658 additions and 1430 deletions

View file

@ -17,7 +17,6 @@
Timestamp
PreparedStatement]))
;; (def ^:dynamic *db* {:name "java:comp/env/jdbc/EmployeeDB"})
(defstate ^:dynamic *db*
:start (conman/connect! {:jdbc-url-env (env :database-url)
:jdbc-url "jdbc:postgresql://127.0.0.1/youyesyet_dev?user=youyesyet&password=thisisnotsecure"

View file

@ -1,67 +1,55 @@
(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*]]))
(ns^{:doc "Render web pages using Selmer templating markup."
:author "Simon Brooke"}
youyesyet.layout
(:require [adl-support.tags :as tags]
[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*]]
[selmer.parser :as parser]
[selmer.filters :as filters]
))
(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)]))
(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 raw-get-user-roles [_]
#{"admin" "canvassers"})
(def get-user-roles (memoize raw-get-user-roles))
(defn raw-get-user-roles [_]
#{"admin" "canvassers"})
(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
(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")))
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)})
(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)})

View file

@ -1,7 +1,8 @@
(ns
youyesyet.routes.auto
"User interface routes for Youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180617T110557.025Z"
"User interface routes for Youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180619T185151.309Z"
(:require
[adl-support.core :as support]
[clojure.java.io :as io]
[compojure.core :refer [defroutes GET POST]]
[hugsql.core :as hugsql]
@ -13,119 +14,20 @@
[youyesyet.routes.manual :as m]))
(defn
raw-resolve-template
[n]
(if
(.exists (io/as-file (str "resources/templates/" n)))
n
(str "auto/" n)))
(def resolve-template (memoize raw-resolve-template))
(defn
index
admin
[r]
(l/render
(resolve-template "application-index.html")
(support/resolve-template "application-index.html")
{:title "Administrative menu"}))
(defn
list-electors-Electors
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-electors-Electors.html")
{:title "Electors",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-elector db/*db* p)
(db/list-electors db/*db* {}))})))
(defn
form-electors-Elector
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-electors-Elector.html")
{:title "Elector",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-elector db/*db* p))})))
(defn
list-genders-Genders
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-genders-Genders.html")
{:title "Genders",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-gender db/*db* p)
(db/list-genders db/*db* {}))})))
(defn
form-genders-Gender
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-genders-Gender.html")
{:title "Gender",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-gender db/*db* p))})))
(defn
list-dwellings-Dwellings
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-dwellings-Dwellings.html")
{:title "Dwellings",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-dwelling db/*db* p)
(db/list-dwellings db/*db* {}))})))
(defn
form-dwellings-Dwelling
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-dwellings-Dwelling.html")
{:title "Dwelling",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-dwelling db/*db* p))})))
(defn
list-addresses-Addresses
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "list-addresses-Addresses.html")
(support/resolve-template "list-addresses-Addresses.html")
{:title "Addresses",
:params p,
:records
@ -138,51 +40,24 @@
form-addresses-Address
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "form-addresses-Address.html")
(support/resolve-template "form-addresses-Address.html")
{:title "Address",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-address db/*db* p))})))
(defn
list-visits-Visits
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-visits-Visits.html")
{:title "Visits",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-visit db/*db* p)
(db/list-visits db/*db* {}))})))
(defn
form-visits-Visit
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-visits-Visit.html")
{:title "Visit",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-visit db/*db* p))})))
(if (empty? (remove nil? (vals p))) [] (db/get-address db/*db* p)),
:districts (db/list-districts db/*db*)})))
(defn
list-authorities-Authorities
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "list-authorities-Authorities.html")
(support/resolve-template "list-authorities-Authorities.html")
{:title "Authorities",
:params p,
:records
@ -195,9 +70,10 @@
form-authorities-Authority
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "form-authorities-Authority.html")
(support/resolve-template "form-authorities-Authority.html")
{:title "Authority",
:params p,
:record
@ -206,70 +82,14 @@
[]
(db/get-authority db/*db* p))})))
(defn
list-issues-Issues
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-issues-Issues.html")
{:title "Issues",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-issue db/*db* p)
(db/list-issues db/*db* {}))})))
(defn
form-issues-Issue
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-issues-Issue.html")
{:title "Issue",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-issue db/*db* p))})))
(defn
list-intentions-Intentions
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-intentions-Intentions.html")
{:title "Intentions",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-intention db/*db* p)
(db/list-intentions db/*db* {}))})))
(defn
form-intentions-Intention
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-intentions-Intention.html")
{:title "Intention",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-intention db/*db* p))})))
(defn
list-canvassers-Canvassers
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "list-canvassers-Canvassers.html")
(support/resolve-template "list-canvassers-Canvassers.html")
{:title "Canvassers",
:params p,
:records
@ -282,108 +102,29 @@
form-canvassers-Canvasser
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "form-canvassers-Canvasser.html")
(support/resolve-template "form-canvassers-Canvasser.html")
{:title "Canvasser",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-canvasser db/*db* p))})))
(defn
list-followuprequests-Followuprequests
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-followuprequests-Followuprequests.html")
{:title "Followuprequests",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-followuprequest db/*db* p)
(db/list-followuprequests db/*db* {}))})))
(defn
form-followuprequests-Followuprequest
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-followuprequests-Followuprequest.html")
{:title "Followuprequest",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-followuprequest db/*db* p))})))
(defn
list-roles-Roles
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-roles-Roles.html")
{:title "Roles",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-role db/*db* p)
(db/list-roles db/*db* {}))})))
(defn
form-roles-Role
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-roles-Role.html")
{:title "Role",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-role db/*db* p))})))
(defn
list-teams-Teams
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-teams-Teams.html")
{:title "Teams",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-team db/*db* p)
(db/list-teams db/*db* {}))})))
(defn
form-teams-Team
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-teams-Team.html")
{:title "Team",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-team db/*db* p))})))
(db/get-canvasser db/*db* p)),
:electors (db/list-electors db/*db*),
:addresses (db/list-addresses db/*db*),
:authorities (db/list-authorities db/*db*)})))
(defn
list-districts-Districts
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "list-districts-Districts.html")
(support/resolve-template "list-districts-Districts.html")
{:title "Districts",
:params p,
:records
@ -396,9 +137,10 @@
form-districts-District
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "form-districts-District.html")
(support/resolve-template "form-districts-District.html")
{:title "District",
:params p,
:record
@ -407,13 +149,79 @@
[]
(db/get-district db/*db* p))})))
(defn
list-dwellings-Dwellings
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-dwellings-Dwellings.html")
{:title "Dwellings",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-dwelling db/*db* p)
(db/list-dwellings db/*db* {}))})))
(defn
form-dwellings-Dwelling
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-dwellings-Dwelling.html")
{:title "Dwelling",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-dwelling db/*db* p)),
:addresses (db/list-addresses db/*db*)})))
(defn
list-electors-Electors
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-electors-Electors.html")
{:title "Electors",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-elector db/*db* p)
(db/list-electors db/*db* {}))})))
(defn
form-electors-Elector
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-electors-Elector.html")
{:title "Elector",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-elector db/*db* p)),
:dwellings (db/list-dwellings db/*db*),
:genders (db/list-genders db/*db*)})))
(defn
list-followupactions-Followupactions
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "list-followupactions-Followupactions.html")
(support/resolve-template
"list-followupactions-Followupactions.html")
{:title "Followupactions",
:params p,
:records
@ -426,54 +234,30 @@
form-followupactions-Followupaction
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "form-followupactions-Followupaction.html")
(support/resolve-template
"form-followupactions-Followupaction.html")
{:title "Followupaction",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-followupaction db/*db* p))})))
(defn
list-options-Options
[r]
(let
[p (:params r)]
(l/render
(resolve-template "list-options-Options.html")
{:title "Options",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-option db/*db* p)
(db/list-options db/*db* {}))})))
(defn
form-options-Option
[r]
(let
[p (:params r)]
(l/render
(resolve-template "form-options-Option.html")
{:title "Option",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-option db/*db* p))})))
(db/get-followupaction db/*db* p)),
:followuprequests (db/list-followuprequests db/*db*),
:canvassers (db/list-canvassers db/*db*)})))
(defn
list-followupmethods-Followupmethods
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "list-followupmethods-Followupmethods.html")
(support/resolve-template
"list-followupmethods-Followupmethods.html")
{:title "Followupmethods",
:params p,
:records
@ -486,9 +270,11 @@
form-followupmethods-Followupmethod
[r]
(let
[p (:params r)]
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(resolve-template "form-followupmethods-Followupmethod.html")
(support/resolve-template
"form-followupmethods-Followupmethod.html")
{:title "Followupmethod",
:params p,
:record
@ -497,6 +283,262 @@
[]
(db/get-followupmethod db/*db* p))})))
(defn
list-followuprequests-Followuprequests
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template
"list-followuprequests-Followuprequests.html")
{:title "Followuprequests",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-followuprequest db/*db* p)
(db/list-followuprequests db/*db* {}))})))
(defn
form-followuprequests-Followuprequest
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template
"form-followuprequests-Followuprequest.html")
{:title "Followuprequest",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-followuprequest db/*db* p)),
:electors (db/list-electors db/*db*),
:visits (db/list-visits db/*db*),
:issues (db/list-issues db/*db*),
:followupmethods (db/list-followupmethods db/*db*)})))
(defn
list-genders-Genders
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-genders-Genders.html")
{:title "Genders",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-gender db/*db* p)
(db/list-genders db/*db* {}))})))
(defn
form-genders-Gender
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-genders-Gender.html")
{:title "Gender",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-gender db/*db* p))})))
(defn
list-intentions-Intentions
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-intentions-Intentions.html")
{:title "Intentions",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-intention db/*db* p)
(db/list-intentions db/*db* {}))})))
(defn
form-intentions-Intention
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-intentions-Intention.html")
{:title "Intention",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-intention db/*db* p)),
:visits (db/list-visits db/*db*),
:electors (db/list-electors db/*db*),
:options (db/list-options db/*db*)})))
(defn
list-issues-Issues
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-issues-Issues.html")
{:title "Issues",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-issue db/*db* p)
(db/list-issues db/*db* {}))})))
(defn
form-issues-Issue
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-issues-Issue.html")
{:title "Issue",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-issue db/*db* p))})))
(defn
list-options-Options
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-options-Options.html")
{:title "Options",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-option db/*db* p)
(db/list-options db/*db* {}))})))
(defn
form-options-Option
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-options-Option.html")
{:title "Option",
:params p,
:record
(if
(empty? (remove nil? (vals p)))
[]
(db/get-option db/*db* p))})))
(defn
list-roles-Roles
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-roles-Roles.html")
{:title "Roles",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-role db/*db* p)
(db/list-roles db/*db* {}))})))
(defn
form-roles-Role
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-roles-Role.html")
{:title "Role",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-role db/*db* p))})))
(defn
list-teams-Teams
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-teams-Teams.html")
{:title "Teams",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-team db/*db* p)
(db/list-teams db/*db* {}))})))
(defn
form-teams-Team
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-teams-Team.html")
{:title "Team",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-team db/*db* p)),
:districts (db/list-districts db/*db*)})))
(defn
list-visits-Visits
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "list-visits-Visits.html")
{:title "Visits",
:params p,
:records
(if
(not (empty? (remove nil? (vals p))))
(db/search-strings-visit db/*db* p)
(db/list-visits db/*db* {}))})))
(defn
form-visits-Visit
[r]
(let
[p
(merge (support/query-string-to-map (:query-string r)) (:params r))]
(l/render
(support/resolve-template "form-visits-Visit.html")
{:title "Visit",
:params p,
:record
(if (empty? (remove nil? (vals p))) [] (db/get-visit db/*db* p)),
:addresses (db/list-addresses db/*db*),
:canvassers (db/list-canvassers db/*db*)})))
(defn
raw-resolve-handler
"Prefer the manually-written version of the handler with name `n`, if it exists, to the automatically generated one"

View file

@ -1,7 +1,8 @@
(ns
youyesyet.routes.auto-json
"JSON routes for youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180617T110553.546Z"
"JSON routes for youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180619T185150.149Z"
(:require
[adl-support.core :as support]
[clojure.java.io :as io]
[compojure.core :refer [defroutes GET POST]]
[hugsql.core :as hugsql]