Mainly documentation (and related) fixes.
This commit is contained in:
parent
ae0c383365
commit
ed2dc5a7fb
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
@ -63,7 +63,7 @@
|
||||||
:main ^:skip-aot youyesyet.core
|
:main ^:skip-aot youyesyet.core
|
||||||
:migratus {:store :database :db ~(get (System/getenv) "DATABASE_URL")}
|
:migratus {:store :database :db ~(get (System/getenv) "DATABASE_URL")}
|
||||||
|
|
||||||
:plugins [[lein-adl "0.1.6"]
|
:plugins [[lein-adl "0.1.7-SNAPSHOT"]
|
||||||
[lein-cljsbuild "1.1.7"]
|
[lein-cljsbuild "1.1.7"]
|
||||||
[lein-codox "0.10.7-multilang"]
|
[lein-codox "0.10.7-multilang"]
|
||||||
[lein-cprop "1.0.3"]
|
[lein-cprop "1.0.3"]
|
||||||
|
@ -81,7 +81,7 @@
|
||||||
:doc/format :markdown}
|
:doc/format :markdown}
|
||||||
:languages [:clojure :clojurescript]
|
:languages [:clojure :clojurescript]
|
||||||
:source-paths ["src/clj" "src/cljc" "src/cljs"]
|
:source-paths ["src/clj" "src/cljc" "src/cljs"]
|
||||||
:source-uri "https://github.com/simon-brooke/html-to-md/blob/master/{filepath}#L{line}"
|
:source-uri "https://github.com/simon-brooke/youyesyet/blob/master/{filepath}#L{line}"
|
||||||
:output-path "docs"}
|
:output-path "docs"}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
|
|
|
@ -1,11 +1,14 @@
|
||||||
(ns ^{:doc "Read configuration."
|
(ns ^{:doc "Read configuration; largely unaltered from Luminus default."
|
||||||
:author "Simon Brooke"}
|
:author "Simon Brooke"}
|
||||||
youyesyet.config
|
youyesyet.config
|
||||||
(:require [cprop.core :refer [load-config]]
|
(:require [cprop.core :refer [load-config]]
|
||||||
[cprop.source :as source]
|
[cprop.source :as source]
|
||||||
[mount.core :refer [args defstate]]))
|
[mount.core :refer [args defstate]]))
|
||||||
|
|
||||||
(defstate env :start (load-config
|
(defstate env
|
||||||
|
"Configuration, loaded at startup time from properties. **Note** that
|
||||||
|
this conficuration is used only when not running in a Servlet context."
|
||||||
|
:start (load-config
|
||||||
:merge
|
:merge
|
||||||
[(args)
|
[(args)
|
||||||
(source/from-system-props)
|
(source/from-system-props)
|
||||||
|
|
|
@ -19,10 +19,12 @@
|
||||||
PreparedStatement]))
|
PreparedStatement]))
|
||||||
|
|
||||||
(defstate ^:dynamic *db*
|
(defstate ^:dynamic *db*
|
||||||
:start (conman/connect! {:jdbc-url-env (env :database-url)
|
"Primary connection to the main database. TODO: this does not yet enable
|
||||||
:jdbc-url "jdbc:postgresql://127.0.0.1/youyesyet_dev?user=youyesyet&password=thisisnotsecure"
|
sharding."
|
||||||
:driver-class-name "org.postgresql.Driver"})
|
:start (conman/connect! {:jdbc-url-env (env :database-url)
|
||||||
:stop (conman/disconnect! *db*))
|
:jdbc-url "jdbc:postgresql://127.0.0.1/youyesyet_dev?user=youyesyet&password=thisisnotsecure"
|
||||||
|
:driver-class-name "org.postgresql.Driver"})
|
||||||
|
:stop (conman/disconnect! *db*))
|
||||||
|
|
||||||
(add-json-type generate-string parse-string)
|
(add-json-type generate-string parse-string)
|
||||||
(add-jsonb-type generate-string parse-string)
|
(add-jsonb-type generate-string parse-string)
|
||||||
|
@ -31,7 +33,9 @@
|
||||||
(conman/bind-connection *db* "sql/queries.auto.sql" "sql/queries.sql")
|
(conman/bind-connection *db* "sql/queries.auto.sql" "sql/queries.sql")
|
||||||
(hugsql/def-sqlvec-fns "sql/queries.auto.sql")
|
(hugsql/def-sqlvec-fns "sql/queries.auto.sql")
|
||||||
|
|
||||||
(defn to-date [^java.sql.Date sql-date]
|
(defn to-date
|
||||||
|
"Return the SQL date `sql-date` as a Java date."
|
||||||
|
[^java.sql.Date sql-date]
|
||||||
(-> sql-date (.getTime) (java.util.Date.)))
|
(-> sql-date (.getTime) (java.util.Date.)))
|
||||||
|
|
||||||
(extend-protocol jdbc/IResultSetReadColumn
|
(extend-protocol jdbc/IResultSetReadColumn
|
||||||
|
@ -59,10 +63,12 @@
|
||||||
(set-parameter [v ^PreparedStatement stmt ^long idx]
|
(set-parameter [v ^PreparedStatement stmt ^long idx]
|
||||||
(.setTimestamp stmt idx (Timestamp. (.getTime v)))))
|
(.setTimestamp stmt idx (Timestamp. (.getTime v)))))
|
||||||
|
|
||||||
(defn to-pg-json [value]
|
(defn to-pg-json
|
||||||
(doto (PGobject.)
|
"Render this `value` as JavaScript Object Notation."
|
||||||
(.setType "jsonb")
|
[value]
|
||||||
(.setValue (generate-string value))))
|
(doto (PGobject.)
|
||||||
|
(.setType "jsonb")
|
||||||
|
(.setValue (generate-string value))))
|
||||||
|
|
||||||
(extend-type clojure.lang.IPersistentVector
|
(extend-type clojure.lang.IPersistentVector
|
||||||
jdbc/ISQLParameter
|
jdbc/ISQLParameter
|
||||||
|
|
|
@ -44,8 +44,8 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(mount/defstate init-app
|
(mount/defstate init-app
|
||||||
:start ((or (:init defaults) identity))
|
:start ((or (:init defaults) identity))
|
||||||
:stop ((or (:stop defaults) identity)))
|
:stop ((or (:stop defaults) identity)))
|
||||||
|
|
||||||
(defn init
|
(defn init
|
||||||
"init will be called once when
|
"init will be called once when
|
||||||
|
@ -67,6 +67,8 @@
|
||||||
|
|
||||||
|
|
||||||
(def app-routes
|
(def app-routes
|
||||||
|
"All routes served as part of the `youyesyet` (server-side) web-app (not
|
||||||
|
to be confused with the client-side `canvasser-app`, q.v.)."
|
||||||
(routes
|
(routes
|
||||||
(-> #'home-routes
|
(-> #'home-routes
|
||||||
(wrap-routes middleware/wrap-csrf)
|
(wrap-routes middleware/wrap-csrf)
|
||||||
|
@ -101,4 +103,7 @@
|
||||||
:message "The page you requested has not yet been implemented"})))))
|
:message "The page you requested has not yet been implemented"})))))
|
||||||
|
|
||||||
|
|
||||||
(def app (middleware/wrap-base #'app-routes))
|
(def app
|
||||||
|
"The `youyesyet` server-side web-app (not to be confused with the client-
|
||||||
|
side `canvasser-app`, q.v.)"
|
||||||
|
(middleware/wrap-base #'app-routes))
|
||||||
|
|
|
@ -40,7 +40,15 @@
|
||||||
|
|
||||||
|
|
||||||
(declare ^:dynamic *app-context*)
|
(declare ^:dynamic *app-context*)
|
||||||
(def ^:dynamic *user* nil)
|
;; "Bound to the servlet context, if we're running as a servlet; otherwise
|
||||||
|
;; from configuration. See [[youyesyet.middleware/wrap-context]]."
|
||||||
|
|
||||||
|
(def ^:dynamic *user*
|
||||||
|
"The current user, in circumstances in which we do not have a session.
|
||||||
|
Normally the user is held on a key in the session.
|
||||||
|
|
||||||
|
TODO: is this necessary? Is it *safe*?"
|
||||||
|
nil)
|
||||||
|
|
||||||
(parser/set-resource-path! (clojure.java.io/resource "templates"))
|
(parser/set-resource-path! (clojure.java.io/resource "templates"))
|
||||||
(parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field)))
|
(parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field)))
|
||||||
|
|
|
@ -45,7 +45,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn add!
|
(defn add!
|
||||||
"Add this item to the queue."
|
"Add this `item` to the queue `q`."
|
||||||
[q item]
|
[q item]
|
||||||
(swap! q
|
(swap! q
|
||||||
(fn [a]
|
(fn [a]
|
||||||
|
@ -54,7 +54,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn queue?
|
(defn queue?
|
||||||
"True if x is a queue, else false."
|
"True if `x` is a queue, else false."
|
||||||
[x]
|
[x]
|
||||||
(try
|
(try
|
||||||
(let [q (deref x)
|
(let [q (deref x)
|
||||||
|
@ -68,17 +68,20 @@
|
||||||
|
|
||||||
|
|
||||||
(defn peek
|
(defn peek
|
||||||
"Look at the next item which could be removed from the queue."
|
"Look at the next item which could be removed from the queue `q`."
|
||||||
[q]
|
[q]
|
||||||
(last (:items (deref q))))
|
(last (:items (deref q))))
|
||||||
|
|
||||||
|
|
||||||
(defn locked?
|
(defn locked?
|
||||||
|
"True if this queue `q` is locked, else false."
|
||||||
[q]
|
[q]
|
||||||
(:locked (deref q)))
|
(:locked (deref q)))
|
||||||
|
|
||||||
|
|
||||||
(defn unlock!
|
(defn unlock!
|
||||||
|
"Unlock the queue `q` if not `value` is supplied; if a `value` is
|
||||||
|
supplied, unlock only if that value is `true`, otherwise lock."
|
||||||
([q ]
|
([q ]
|
||||||
(unlock! q true))
|
(unlock! q true))
|
||||||
([q value]
|
([q value]
|
||||||
|
@ -86,18 +89,19 @@
|
||||||
|
|
||||||
|
|
||||||
(defn lock!
|
(defn lock!
|
||||||
|
"Lock the queue `q`."
|
||||||
[q]
|
[q]
|
||||||
(unlock! q false))
|
(unlock! q false))
|
||||||
|
|
||||||
|
|
||||||
(defn count
|
(defn count
|
||||||
"Return the count of items currently in the queue."
|
"Return the count of items currently in the queue `q`."
|
||||||
[q]
|
[q]
|
||||||
(count (deref q)))
|
(count (deref q)))
|
||||||
|
|
||||||
|
|
||||||
(defn take!
|
(defn take!
|
||||||
"Return the first item from the queue, rebind the queue to the remaining
|
"Return the first item from the queue `q`, rebind the queue to the remaining
|
||||||
items. If the queue is empty return nil."
|
items. If the queue is empty return nil."
|
||||||
[q]
|
[q]
|
||||||
(swap! q (fn [a]
|
(swap! q (fn [a]
|
||||||
|
@ -109,8 +113,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn maybe-process-next
|
(defn maybe-process-next
|
||||||
"Apply this process, assumed to be a function of one argument, to the next
|
"Apply this `process`, assumed to be a function of one argument, to the next
|
||||||
item in the queue, if the queue is not currently locked; return the value
|
item in the queue `q`, if the queue is not currently locked; return the value
|
||||||
returned by process."
|
returned by process."
|
||||||
[q process]
|
[q process]
|
||||||
(if (and (queue? q)(not (locked? q)))
|
(if (and (queue? q)(not (locked? q)))
|
||||||
|
@ -122,5 +126,4 @@
|
||||||
(catch #?(:clj Exception :cljs js/Object) any
|
(catch #?(:clj Exception :cljs js/Object) any
|
||||||
#?(:clj (print (.getMessage any))
|
#?(:clj (print (.getMessage any))
|
||||||
:cljs (js/console.log (str any))))
|
:cljs (js/console.log (str any))))
|
||||||
(finally (unlock! q)))
|
(finally (unlock! q)))))
|
||||||
))
|
|
||||||
|
|
|
@ -27,7 +27,7 @@
|
||||||
|
|
||||||
(defn coerce-to-number [v]
|
(defn coerce-to-number [v]
|
||||||
"If it is possible to do so, coerce `v` to a number"
|
"If it is possible to do so, coerce `v` to a number"
|
||||||
;; TODO: this doesn't work in cljs.
|
;; TODO: this doesn't work in cljs. Fix if possible.
|
||||||
(if (number? v) v
|
(if (number? v) v
|
||||||
(try
|
(try
|
||||||
(read-string (str v))
|
(read-string (str v))
|
||||||
|
|
|
@ -28,9 +28,12 @@
|
||||||
|
|
||||||
|
|
||||||
(defn local-uri? [{:keys [uri]}]
|
(defn local-uri? [{:keys [uri]}]
|
||||||
|
"Return `true` if the supplied `uri` has no protocol part."
|
||||||
(not (re-find #"^\w+?://" (str uri))))
|
(not (re-find #"^\w+?://" (str uri))))
|
||||||
|
|
||||||
(defn default-headers [request]
|
(defn default-headers [request]
|
||||||
|
"Copy the current uri and cross site request forgery token into the headers
|
||||||
|
of this request."
|
||||||
(if (local-uri? request)
|
(if (local-uri? request)
|
||||||
(-> request
|
(-> request
|
||||||
(update :uri #(str js/context %))
|
(update :uri #(str js/context %))
|
||||||
|
|
|
@ -53,33 +53,48 @@
|
||||||
(enable-console-print!)
|
(enable-console-print!)
|
||||||
|
|
||||||
(defn about-page []
|
(defn about-page []
|
||||||
|
"Return the content for the 'about' page."
|
||||||
(about/panel))
|
(about/panel))
|
||||||
|
|
||||||
(defn building-page []
|
(defn building-page []
|
||||||
|
"Return the content for the single building page, for the current address."
|
||||||
(building/panel))
|
(building/panel))
|
||||||
|
|
||||||
(defn dwelling-page []
|
(defn dwelling-page []
|
||||||
|
"Return the content for the single dwelling page, for the current
|
||||||
|
dwelling."
|
||||||
(dwelling/panel))
|
(dwelling/panel))
|
||||||
|
|
||||||
(defn elector-page []
|
(defn elector-page []
|
||||||
|
"Return the content for the elector page, for the current dwelling."
|
||||||
(elector/panel))
|
(elector/panel))
|
||||||
|
|
||||||
(defn gdpr-page []
|
(defn gdpr-page []
|
||||||
|
"Return the content for the general data protection regulation consent
|
||||||
|
page."
|
||||||
(gdpr/panel))
|
(gdpr/panel))
|
||||||
|
|
||||||
(defn followup-page []
|
(defn followup-page []
|
||||||
|
"Return the content for the followup-request page, for the current elector
|
||||||
|
and selected issue."
|
||||||
(followup/panel))
|
(followup/panel))
|
||||||
|
|
||||||
(defn issues-page []
|
(defn issues-page []
|
||||||
|
"Return the content for the current issues page - list of currently
|
||||||
|
prompted for issues."
|
||||||
(issues/panel))
|
(issues/panel))
|
||||||
|
|
||||||
(defn issue-page []
|
(defn issue-page []
|
||||||
|
"Return the content for the current issue page: canned text prompt for the
|
||||||
|
canvasser to say to the elector on this issue."
|
||||||
(issue/panel))
|
(issue/panel))
|
||||||
|
|
||||||
(defn map-page []
|
(defn map-page []
|
||||||
|
"Return the content for the main map page. Map showing current location."
|
||||||
(maps/panel))
|
(maps/panel))
|
||||||
|
|
||||||
(def pages
|
(def pages
|
||||||
|
"Dispatcher table for pages."
|
||||||
{:about #'about-page
|
{:about #'about-page
|
||||||
:building #'building-page
|
:building #'building-page
|
||||||
:dwelling #'dwelling-page
|
:dwelling #'dwelling-page
|
||||||
|
@ -173,7 +188,9 @@
|
||||||
;; -------------------------
|
;; -------------------------
|
||||||
;; History
|
;; History
|
||||||
;; must be called after routes have been defined
|
;; must be called after routes have been defined
|
||||||
(defn hook-browser-navigation! []
|
(defn hook-browser-navigation!
|
||||||
|
"Interceptor for the browser back button."
|
||||||
|
[]
|
||||||
(doto (History.)
|
(doto (History.)
|
||||||
(events/listen
|
(events/listen
|
||||||
HistoryEventType/NAVIGATE
|
HistoryEventType/NAVIGATE
|
||||||
|
@ -187,7 +204,9 @@
|
||||||
(defn mount-components []
|
(defn mount-components []
|
||||||
(r/render [#'page] (.getElementById js/document "app")))
|
(r/render [#'page] (.getElementById js/document "app")))
|
||||||
|
|
||||||
(defn init! []
|
(defn init!
|
||||||
|
"Initialise the app."
|
||||||
|
[]
|
||||||
(rf/dispatch-sync [:initialize-db])
|
(rf/dispatch-sync [:initialize-db])
|
||||||
(rf/dispatch [:get-current-location])
|
(rf/dispatch [:get-current-location])
|
||||||
(rf/dispatch [:fetch-locality])
|
(rf/dispatch [:fetch-locality])
|
||||||
|
|
|
@ -38,7 +38,7 @@
|
||||||
;; references, so do it here.
|
;; references, so do it here.
|
||||||
|
|
||||||
(defn get-current-location []
|
(defn get-current-location []
|
||||||
"Get the current location from the device, setting it in the database and
|
"Return the current location from the device, setting it in the database and
|
||||||
returning the locality."
|
returning the locality."
|
||||||
(try
|
(try
|
||||||
(if (.-geolocation js/navigator)
|
(if (.-geolocation js/navigator)
|
||||||
|
@ -61,7 +61,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn pin-image
|
(defn pin-image
|
||||||
"select the name of a suitable pin image for this address"
|
"Return the name of a suitable pin image for this `address`."
|
||||||
[address]
|
[address]
|
||||||
(let [intentions
|
(let [intentions
|
||||||
(set
|
(set
|
||||||
|
@ -93,7 +93,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn add-map-pin
|
(defn add-map-pin
|
||||||
"Add a map-pin at this address in this map view"
|
"Add an appropriate map-pin at this `address` in this map `view`."
|
||||||
[address view]
|
[address view]
|
||||||
(let [lat (:latitude address)
|
(let [lat (:latitude address)
|
||||||
lng (:longitude address)
|
lng (:longitude address)
|
||||||
|
@ -110,12 +110,16 @@
|
||||||
(.latLng js/L lat lng)
|
(.latLng js/L lat lng)
|
||||||
(clj->js {:icon pin
|
(clj->js {:icon pin
|
||||||
:title (:address address)}))]
|
:title (:address address)}))]
|
||||||
(.on (.addTo marker view) "click" (fn [_] (map-pin-click-handler (str (:id address)))))
|
(.on
|
||||||
|
(.addTo marker view)
|
||||||
|
"click"
|
||||||
|
(fn [_] (map-pin-click-handler (str (:id address)))))
|
||||||
marker))
|
marker))
|
||||||
|
|
||||||
|
|
||||||
(defn map-remove-pins
|
(defn map-remove-pins
|
||||||
"Remove all pins from this map `view`. Side-effecty; liable to be problematic."
|
"Remove all pins from this map `view`. Side-effecty; liable to be
|
||||||
|
problematic."
|
||||||
[view]
|
[view]
|
||||||
(if view
|
(if view
|
||||||
(.eachLayer view
|
(.eachLayer view
|
||||||
|
@ -126,7 +130,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn refresh-map-pins
|
(defn refresh-map-pins
|
||||||
"Refresh the map pins on this map. Side-effecty; liable to be problematic."
|
"Refresh the map pins on the current map. Side-effecty; liable to be
|
||||||
|
problematic."
|
||||||
[]
|
[]
|
||||||
(let [view (map-remove-pins @(subscribe [:view]))
|
(let [view (map-remove-pins @(subscribe [:view]))
|
||||||
addresses @(subscribe [:addresses])]
|
addresses @(subscribe [:addresses])]
|
||||||
|
|
|
@ -44,11 +44,13 @@
|
||||||
(merge state {:error '() :feedback '()}))
|
(merge state {:error '() :feedback '()}))
|
||||||
|
|
||||||
|
|
||||||
(def source-host (assoc
|
(def source-host
|
||||||
(url js/window.location)
|
"The base URL of the host from which the app was loaded."
|
||||||
:path "/"
|
(assoc
|
||||||
:query nil
|
(url js/window.location)
|
||||||
:anchor nil))
|
:path "/"
|
||||||
|
:query nil
|
||||||
|
:anchor nil))
|
||||||
|
|
||||||
|
|
||||||
(defn handle-forbidden
|
(defn handle-forbidden
|
||||||
|
@ -86,6 +88,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn add-to-outqueue
|
(defn add-to-outqueue
|
||||||
|
"Add the supplied `message` to the output queue in this `db`."
|
||||||
[db message]
|
[db message]
|
||||||
(dispatch [:process-queue])
|
(dispatch [:process-queue])
|
||||||
(add-to-key db :outqueue message))
|
(add-to-key db :outqueue message))
|
||||||
|
@ -98,6 +101,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn remove-from-key
|
(defn remove-from-key
|
||||||
|
"Remove `x` from the values of key `k` in map `db`."
|
||||||
[db k x]
|
[db k x]
|
||||||
(assoc db k (remove #(= x %) (db k))))
|
(assoc db k (remove #(= x %) (db k))))
|
||||||
|
|
||||||
|
@ -109,6 +113,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn remove-from-outqueue
|
(defn remove-from-outqueue
|
||||||
|
"Remove `x` from the output queue in this `db`."
|
||||||
[db x]
|
[db x]
|
||||||
(remove-from-key db :outqueue x))
|
(remove-from-key db :outqueue x))
|
||||||
|
|
||||||
|
|
|
@ -26,11 +26,10 @@
|
||||||
;;;;
|
;;;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
;;; This is the constructor for the atom in which the state of the user interface is held.
|
|
||||||
;;; The atom gets updated by 'events' registered in handler.cljs, q.v.
|
|
||||||
|
|
||||||
|
|
||||||
(def default-db
|
(def default-db
|
||||||
|
"The default configuration state of the app, when first loaded.
|
||||||
|
This is the constructor for the atom in which the state of the user interface
|
||||||
|
is held. The atom gets updated by 'events' registered in handler.cljs, q.v."
|
||||||
{ ;;; any confirmation message to display
|
{ ;;; any confirmation message to display
|
||||||
:feedback '("Welcome to the canvasser app!")
|
:feedback '("Welcome to the canvasser app!")
|
||||||
;;; message of the day
|
;;; message of the day
|
||||||
|
|
|
@ -28,9 +28,10 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
||||||
(defn log-and-dispatch [arg]
|
(defn log-and-dispatch [event]
|
||||||
(js/console.log (str "Dispatching " arg))
|
"Log this `event` and dispatch it."
|
||||||
(rf/dispatch arg))
|
(js/console.log (str "Dispatching " event))
|
||||||
|
(rf/dispatch event))
|
||||||
|
|
||||||
|
|
||||||
(defn back-link
|
(defn back-link
|
||||||
|
@ -44,6 +45,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn big-link
|
(defn big-link
|
||||||
|
"Generate a big link with this `text` which, when selected, either opens
|
||||||
|
the url which is this `target` if supplied, or else invokes this `handler`."
|
||||||
[text & {:keys [target handler]}]
|
[text & {:keys [target handler]}]
|
||||||
[:div.big-link-container {:key (gensym "big-link")}
|
[:div.big-link-container {:key (gensym "big-link")}
|
||||||
[:a.big-link (merge {}
|
[:a.big-link (merge {}
|
||||||
|
@ -53,6 +56,10 @@
|
||||||
|
|
||||||
|
|
||||||
(defn nav-link [uri title page collapsed?]
|
(defn nav-link [uri title page collapsed?]
|
||||||
|
"Generate and return a navigaton link for this `uri` with the text which is
|
||||||
|
this `title`; the `uri` is expected to be the uri of this `page`, and if
|
||||||
|
this `page` is the currently selected page, the lin should be highlighted to
|
||||||
|
indicate this."
|
||||||
(let [selected-page @(rf/subscribe [:page])]
|
(let [selected-page @(rf/subscribe [:page])]
|
||||||
[:li.nav-item
|
[:li.nav-item
|
||||||
{:class (when (= page selected-page) "active")
|
{:class (when (= page selected-page) "active")
|
||||||
|
@ -63,6 +70,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn error-panel
|
(defn error-panel
|
||||||
|
"Generate and return an error panel with this `message`."
|
||||||
[message]
|
[message]
|
||||||
[:div
|
[:div
|
||||||
[:h1.error message]
|
[:h1.error message]
|
||||||
|
@ -70,7 +78,10 @@
|
||||||
(back-link)]])
|
(back-link)]])
|
||||||
|
|
||||||
|
|
||||||
(defn navbar []
|
(defn navbar
|
||||||
|
"Generate and return a navigation bar representing the current state of the
|
||||||
|
app."
|
||||||
|
[]
|
||||||
(r/with-let [collapsed? (r/atom true)]
|
(r/with-let [collapsed? (r/atom true)]
|
||||||
[:div {:id "nav"}
|
[:div {:id "nav"}
|
||||||
[:img {:id "nav-icon"
|
[:img {:id "nav-icon"
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
:page :gdpr}]))
|
:page :gdpr}]))
|
||||||
|
|
||||||
|
|
||||||
(defn gender-cell
|
(defn- gender-cell
|
||||||
[elector]
|
[elector]
|
||||||
(let [gender (:gender elector)
|
(let [gender (:gender elector)
|
||||||
image (if gender (name gender) "Unknown")]
|
image (if gender (name gender) "Unknown")]
|
||||||
|
@ -56,21 +56,21 @@
|
||||||
[:img {:src (str "img/gender/" image ".png") :alt image}]]]))
|
[:img {:src (str "img/gender/" image ".png") :alt image}]]]))
|
||||||
|
|
||||||
|
|
||||||
(defn genders-row
|
(defn- genders-row
|
||||||
[electors]
|
[electors]
|
||||||
[:tr
|
[:tr
|
||||||
(map
|
(map
|
||||||
#(gender-cell %) electors)])
|
#(gender-cell %) electors)])
|
||||||
|
|
||||||
|
|
||||||
(defn name-cell
|
(defn- name-cell
|
||||||
[elector]
|
[elector]
|
||||||
[:td {:key (str "name-" (:id elector))
|
[:td {:key (str "name-" (:id elector))
|
||||||
:on-click #(go-to-gdpr-for-elector elector)}
|
:on-click #(go-to-gdpr-for-elector elector)}
|
||||||
(:name elector)])
|
(:name elector)])
|
||||||
|
|
||||||
|
|
||||||
(defn names-row
|
(defn- names-row
|
||||||
[electors]
|
[electors]
|
||||||
[:tr
|
[:tr
|
||||||
(map
|
(map
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
(ns ^{:doc "Canvasser app electors in household panel."
|
(ns ^{:doc "The General Data Protection Regulations consent panel,
|
||||||
|
incorporating a signature widget."
|
||||||
:author "Simon Brooke"}
|
:author "Simon Brooke"}
|
||||||
youyesyet.canvasser-app.views.gdpr
|
youyesyet.canvasser-app.views.gdpr
|
||||||
(:require [re-frame.core :refer [reg-sub subscribe dispatch]]
|
(:require [re-frame.core :refer [reg-sub subscribe dispatch]]
|
||||||
|
@ -31,7 +32,7 @@
|
||||||
;; OK, the idea here is a GDPR consent form to be signed by the elector
|
;; OK, the idea here is a GDPR consent form to be signed by the elector
|
||||||
|
|
||||||
(def sig-pad
|
(def sig-pad
|
||||||
;; something the signature pad will be bound to
|
"An atom that the signature pad will be bound to, when instantiated."
|
||||||
(atom nil))
|
(atom nil))
|
||||||
|
|
||||||
|
|
||||||
|
@ -52,6 +53,8 @@
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(defn gdpr-render
|
(defn gdpr-render
|
||||||
|
"Return a renderer for the GDPR consent form, incorporating the signature
|
||||||
|
widget."
|
||||||
[]
|
[]
|
||||||
(let [elector @(subscribe [:elector])]
|
(let [elector @(subscribe [:elector])]
|
||||||
[:div
|
[:div
|
||||||
|
@ -79,12 +82,13 @@
|
||||||
|
|
||||||
|
|
||||||
(defn gdpr-did-mount
|
(defn gdpr-did-mount
|
||||||
|
"Instantiate the `sig-pad` atom, q.v."
|
||||||
[]
|
[]
|
||||||
(reset! sig-pad (js/SignaturePad. (.getElementById js/document "signature-pad"))))
|
(reset! sig-pad (js/SignaturePad. (.getElementById js/document "signature-pad"))))
|
||||||
|
|
||||||
|
|
||||||
(defn panel
|
(defn panel
|
||||||
"A reagent class for the GDPR consent form"
|
"Return the GDPR consent form."
|
||||||
[]
|
[]
|
||||||
(js/console.log "gdpr.panel")
|
(js/console.log "gdpr.panel")
|
||||||
(reagent/create-class {:reagent-render gdpr-render
|
(reagent/create-class {:reagent-render gdpr-render
|
||||||
|
|
Loading…
Reference in a new issue