Almost at the point of transmitting intentions.

This commit is contained in:
Simon Brooke 2018-07-26 17:47:31 +01:00
parent 981a4d0d34
commit 9564c76ae6
6 changed files with 132 additions and 58 deletions

2
.gitignore vendored
View file

@ -38,3 +38,5 @@ src/clj/youyesyet/routes/auto\.clj
src/clj/youyesyet/routes/auto_json\.clj src/clj/youyesyet/routes/auto_json\.clj
resources/sql/youyesyet\.postgres\.sql resources/sql/youyesyet\.postgres\.sql
\.rebel_readline_history

View file

@ -5,44 +5,44 @@
:dependencies [[adl-support "0.1.4-SNAPSHOT"] :dependencies [[adl-support "0.1.4-SNAPSHOT"]
[bouncer "1.0.1"] [bouncer "1.0.1"]
[ch.qos.logback/logback-classic "1.2.2"] [ch.qos.logback/logback-classic "1.2.3"]
[clj-oauth "1.5.5"] [clj-oauth "1.5.5"]
[cljsjs/react-leaflet "0.12.3-4"] [cljsjs/react-leaflet "1.6.5-0"]
[cljs-ajax "0.7.3"] [cljs-ajax "0.7.4"]
[com.cemerick/url "0.1.1"] [com.cemerick/url "0.1.1"]
[compojure "1.5.2"] [compojure "1.6.1"]
[conman "0.6.3"] [conman "0.8.2"]
[cprop "0.1.10"] [cprop "0.1.11"]
[day8.re-frame/http-fx "0.1.6"] [day8.re-frame/http-fx "0.1.6"]
[korma "0.4.3"] [korma "0.4.3"]
[lib-noir "0.9.9" :exclusions [org.clojure/tools.reader]] [lib-noir "0.9.9" :exclusions [org.clojure/tools.reader]]
[luminus/ring-ttl-session "0.3.1"] [luminus/ring-ttl-session "0.3.2"]
[luminus-nrepl "0.1.4"] [luminus-nrepl "0.1.4"]
[luminus-migrations "0.3.0"] [luminus-migrations "0.5.2"]
[luminus-immutant "0.2.4"] [luminus-immutant "0.2.4"]
[markdown-clj "0.9.98"] [markdown-clj "1.0.2"]
[metosin/compojure-api "1.1.10"] [metosin/compojure-api "1.1.12"]
[metosin/ring-http-response "0.8.2"] [metosin/ring-http-response "0.9.0"]
[migratus "0.8.33"] [migratus "1.0.8"]
[mount "0.1.11"] [mount "0.1.12"]
[org.clojure/clojure "1.8.0"] [org.clojure/clojure "1.9.0"]
[org.clojure/clojurescript "1.9.229" :scope "provided"] [org.clojure/clojurescript "1.10.339" :scope "provided"]
[org.clojure/core.memoize "0.7.1"] [org.clojure/core.memoize "0.7.1"]
[org.clojure/tools.cli "0.3.5"] [org.clojure/tools.cli "0.3.7"]
[org.clojure/tools.logging "0.3.1"] [org.clojure/tools.logging "0.4.1"]
[org.postgresql/postgresql "9.4.1212"] [org.postgresql/postgresql "42.2.4"]
[org.webjars/bootstrap "4.0.0-alpha.6-1"] [org.webjars/bootstrap "4.1.2"]
[org.webjars/font-awesome "4.7.0"] [org.webjars/font-awesome "5.1.0"]
[org.webjars.bower/tether "1.4.0"] [org.webjars.bower/tether "1.4.4"]
[re-frame "0.10.5"] [re-frame "0.10.5"]
[reagent "0.6.1"] [reagent "0.8.1"]
[reagent-utils "0.2.1"] [reagent-utils "0.3.1"]
[ring-middleware-format "0.7.2"] [ring-middleware-format "0.7.2"]
[ring/ring-defaults "0.2.3"] [ring/ring-defaults "0.3.2"]
[ring/ring-servlet "1.5.1"] [ring/ring-servlet "1.6.3"]
[ring-webjars "0.1.1"] [ring-webjars "0.2.0"]
[secretary "1.2.3"] [secretary "1.2.3"]
[selmer "1.10.6"]] [selmer "1.11.8"]]
:min-lein-version "2.0.0" :min-lein-version "2.0.0"
@ -55,15 +55,15 @@
:migratus {:store :database :db ~(get (System/getenv) "DATABASE_URL")} :migratus {:store :database :db ~(get (System/getenv) "DATABASE_URL")}
:plugins [;;[lein-adl ["0.1.2"]] :plugins [;;[lein-adl ["0.1.2"]]
[lein-cljsbuild "1.1.4"] [lein-cljsbuild "1.1.7"]
[lein-codox "0.10.3"] [lein-codox "0.10.4"]
[lein-cprop "1.0.1"] [lein-cprop "1.0.3"]
[lein-less "1.7.5"] [lein-less "1.7.5"]
[lein-npm "0.6.2"] [lein-npm "0.6.2"]
[lein-release "1.0.5"] [lein-release "1.1.3"]
[lein-uberwar "0.2.0"] [lein-uberwar "0.2.0"]
[migratus-lein "0.4.2"] [migratus-lein "0.5.9"]
[org.clojars.punkisdead/lein-cucumber "1.0.5"]] [org.clojars.punkisdead/lein-cucumber "1.0.7"]]
:cucumber-feature-paths ["test/clj/features"] :cucumber-feature-paths ["test/clj/features"]
@ -74,7 +74,7 @@
:npm {:dependencies [[datatables.net "1.10.19"] :npm {:dependencies [[datatables.net "1.10.19"]
[datatables.net-dt "1.10.19"] [datatables.net-dt "1.10.19"]
[jquery "3.3.1"] [jquery "3.3.1"]
[leaflet "0.7.3"] ;; old version works, new ["1.3.1"] doesn't [leaflet "1.3.1"]
[selectize "0.12.6"] [selectize "0.12.6"]
[signature_pad "2.3.2"] [signature_pad "2.3.2"]
[simplemde "1.11.2"]] [simplemde "1.11.2"]]
@ -133,19 +133,19 @@
:test [:project/dev :project/test :profiles/test] :test [:project/dev :project/test :profiles/test]
:project/dev {:dependencies [[prone "1.1.4"] :project/dev {:dependencies [[prone "1.1.4"]
[ring/ring-mock "0.3.0"] [ring/ring-mock "0.3.2"]
[ring/ring-devel "1.5.1"] [ring/ring-devel "1.6.3"]
[org.webjars/webjars-locator-jboss-vfs "0.1.0"] [org.webjars/webjars-locator-jboss-vfs "0.1.0"]
[luminus-immutant "0.2.3"] [luminus-immutant "0.2.4"]
[pjstadig/humane-test-output "0.8.1"] [pjstadig/humane-test-output "0.8.3"]
[binaryage/devtools "0.9.2"] [binaryage/devtools "0.9.10"]
[com.cemerick/piggieback "0.2.2-SNAPSHOT"] [com.cemerick/piggieback "0.2.2"]
[directory-naming/naming-java "0.8"] [directory-naming/naming-java "0.8"]
[doo "0.1.7"] [doo "0.1.10"]
[figwheel-sidecar "0.5.15"]] [figwheel-sidecar "0.5.16"]]
:plugins [[com.jakemccrary/lein-test-refresh "0.18.1"] :plugins [[com.jakemccrary/lein-test-refresh "0.23.0"]
[lein-doo "0.1.7"] [lein-doo "0.1.10"]
[lein-figwheel "0.5.15"] [lein-figwheel "0.5.16"]
[org.clojure/clojurescript "1.9.495"]] [org.clojure/clojurescript "1.9.495"]]
:cljsbuild {:builds :cljsbuild {:builds
{:app {:app

View file

@ -107,6 +107,8 @@
(db/create-visit! db/*db* params)))) (db/create-visit! db/*db* params))))
;; http://localhost:3000/rest/create-intention?address_id=18&elector-id=62&elector_id=62&intention=Yes&locality=5482391
(defn create-intention-and-visit! (defn create-intention-and-visit!
"Doing visit creation logic server side; request params are expected to "Doing visit creation logic server side; request params are expected to
include an `option`, an `elector_id` and an `address_id`, or an `option` and include an `option`, an `elector_id` and an `address_id`, or an `option` and
@ -117,6 +119,7 @@
a new `visit` record." a new `visit` record."
[request] [request]
(let [params (massage-params request)] (let [params (massage-params request)]
(log/debug "Creating intention with params: " params)
(if-let [address-id (-> params :address_id)] (if-let [address-id (-> params :address_id)]
(db/create-intention! (db/create-intention!
db/*db* db/*db*

View file

@ -8,6 +8,7 @@
[markdown.core :refer [md->html]] [markdown.core :refer [md->html]]
[reagent.core :as r] [reagent.core :as r]
[re-frame.core :as rf] [re-frame.core :as rf]
[re-frame.fx]
[secretary.core :as secretary] [secretary.core :as secretary]
[youyesyet.canvasser-app.ajax :refer [load-interceptors!]] [youyesyet.canvasser-app.ajax :refer [load-interceptors!]]
[youyesyet.canvasser-app.gis :refer [get-current-location]] [youyesyet.canvasser-app.gis :refer [get-current-location]]
@ -196,6 +197,7 @@
(rf/dispatch [:fetch-locality]) (rf/dispatch [:fetch-locality])
(rf/dispatch [:fetch-options]) (rf/dispatch [:fetch-options])
(rf/dispatch [:fetch-issues]) (rf/dispatch [:fetch-issues])
(rf/dispatch [:dispatch-later [{:ms 60000 :dispatch [:process-queue]}]])
(load-interceptors!) (load-interceptors!)
(hook-browser-navigation!) (hook-browser-navigation!)
(mount-components)) (mount-components))

View file

@ -48,8 +48,8 @@
(js/console.log (str "Current location is: " (js/console.log (str "Current location is: "
(.-latitude (.-coords position)) ", " (.-latitude (.-coords position)) ", "
(.-longitude (.-coords position)))) (.-longitude (.-coords position))))
(dispatch-sync [:set-latitude (.-latitude (.-coords position))]) (dispatch [:set-latitude (.-latitude (.-coords position))])
(dispatch-sync [:set-longitude (.-longitude (.-coords position))]) (dispatch [:set-longitude (.-longitude (.-coords position))])
(locality (.-latitude (.-coords position)) (.-longitude (.-coords position)))))) (locality (.-latitude (.-coords position)) (.-longitude (.-coords position))))))
(js/console.log "Geolocation not available") (js/console.log "Geolocation not available")
(catch js/Object any (catch js/Object any
@ -113,11 +113,12 @@
(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]
(.eachLayer view (if view
#(if (.eachLayer view
(instance? js/L.Marker %) #(if
(.removeLayer view %))) (instance? js/L.Marker %)
view) (.removeLayer view %)))
view))
(defn refresh-map-pins (defn refresh-map-pins

View file

@ -6,6 +6,7 @@
[cemerick.url :refer (url url-encode)] [cemerick.url :refer (url url-encode)]
[cljs.reader :refer [read-string]] [cljs.reader :refer [read-string]]
[clojure.walk :refer [keywordize-keys]] [clojure.walk :refer [keywordize-keys]]
[re-frame.fx]
[day8.re-frame.http-fx] [day8.re-frame.http-fx]
[re-frame.core :refer [dispatch reg-event-db reg-event-fx subscribe]] [re-frame.core :refer [dispatch reg-event-db reg-event-fx subscribe]]
[youyesyet.canvasser-app.gis :refer [refresh-map-pins get-current-location]] [youyesyet.canvasser-app.gis :refer [refresh-map-pins get-current-location]]
@ -50,6 +51,16 @@
:anchor nil)) :anchor nil))
(defn compose-packet
[item]
"Convert this `item` into a URI which can be sent as a GET call"
(assoc
(url js/window.location)
:path (str "/rest/" (name (:action item)))
:query (dissoc item :action)
:fragment nil))
(def feedback-messages (def feedback-messages
{:fetch-locality "Fetching local data." {:fetch-locality "Fetching local data."
:send-request "Request has been queued." :send-request "Request has been queued."
@ -65,7 +76,8 @@
(defn add-to-outqueue (defn add-to-outqueue
[db message] [db message]
add-to-key db :outqueue message) (dispatch [:process-queue])
(add-to-key db :outqueue message))
(defn add-to-feedback (defn add-to-feedback
@ -85,6 +97,11 @@
(remove-from-key db :feedback x)) (remove-from-key db :feedback x))
(defn remove-from-outqueue
[db x]
(remove-from-key db :outqueue x))
(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.
NOTE: I tried to do this in *cljc*, but it did not work. Leave it alone." NOTE: I tried to do this in *cljc*, but it did not work. Leave it alone."
@ -190,7 +207,7 @@
:process-locality :process-locality
(fn (fn
[db [_ response]] [db [_ response]]
(js/console.log (str "Updating locality data: " (count response) " addresses")) (js/console.log (str "Updating locality data: " (count response) " addresses " ))
;; loop to do it again ;; loop to do it again
(dispatch [:dispatch-later [{:ms 60000 :dispatch [:fetch-locality]} (dispatch [:dispatch-later [{:ms 60000 :dispatch [:fetch-locality]}
{:ms 1000 :dispatch [:get-current-location]}]]) {:ms 1000 :dispatch [:get-current-location]}]])
@ -310,8 +327,9 @@
:address_id (-> db :address :id) :address_id (-> db :address :id)
:locality (-> db :address :locality) :locality (-> db :address :locality)
:elector_id (-> db :elector :id) :elector_id (-> db :elector :id)
:action :set-intention)) :action :create-intention))
:elector (assoc (:elector db) :intention intention))))))) :elector (assoc (:elector db) :intention intention)
:page :elector))))))
(reg-event-db (reg-event-db
@ -328,7 +346,7 @@
:address_id (-> db :address :id) :address_id (-> db :address :id)
:method_id "Phone" :method_id "Phone"
:method_detail (-> db :method_detail) :method_detail (-> db :method_detail)
:action :add-request}) :action :create-request})
:send-request)) :send-request))
(assoc db :error "Please supply a telephone number to call")))) (assoc db :error "Please supply a telephone number to call"))))
@ -336,6 +354,7 @@
(reg-event-db (reg-event-db
:set-active-page :set-active-page
(fn [db [_ k]] (fn [db [_ k]]
(js/console.log (str "Setting page to " k))
(if k (if k
(assoc (clear-messages db) :page k) (assoc (clear-messages db) :page k)
db))) db)))
@ -346,9 +365,11 @@
(fn [db [_ address-id]] (fn [db [_ address-id]]
(let [id (coerce-to-number address-id) (let [id (coerce-to-number address-id)
address (first (remove nil? (map #(if (= id (:id %)) %) (:addresses db))))] address (first (remove nil? (map #(if (= id (:id %)) %) (:addresses db))))]
(js/console.log (str "Set address to " address " "))
(clear-messages (clear-messages
(if (if
(assoc db (= (count (:dwellings address)) 1) (= (count (:dwellings address)) 1)
(assoc db
:address address :address address
:dwelling (first (:dwellings address)) :dwelling (first (:dwellings address))
:electors (:electors (first (:dwellings address))) :electors (:electors (first (:dwellings address)))
@ -374,6 +395,7 @@
(reg-event-db (reg-event-db
:set-dwelling :set-dwelling
(fn [db [_ dwelling-id]] (fn [db [_ dwelling-id]]
(js/console.log (str "Setting dwelling to " dwelling-id " "))
(let [id (coerce-to-number dwelling-id) (let [id (coerce-to-number dwelling-id)
dwelling (first dwelling (first
(remove (remove
@ -452,3 +474,47 @@
(if (integer? zoom) (if (integer? zoom)
(assoc db :zoom zoom) (assoc db :zoom zoom)
db))) db)))
(reg-event-fx
:process-queue
(fn [{db :db} _]
(if-let [item (first (:outqueue db))]
;; if there's something in the queue, transmit it...
(let [uri (compose-packet item)]
(js/console.log (str "Transmitting item" uri))
{:http-xhrio {:method :get
:uri uri
:format (json-request-format)
:response-format (json-response-format {:keywords? true})
:on-success [:tx-success]
:on-failure [:tx-failure]}
:db (assoc
(add-to-feedback db :process-queue)
:tx-item item
:outqueue (remove #(= % item) (:outqueue db)))})
;; else try again in a minute
(do
(js/console.log "Nothing to send to server")
(dispatch [:dispatch-later [{:ms 60000 :dispatch [:process-queue]}]])
{:db db}))))
(reg-event-db
:tx-success
(fn
[db [_ response]]
(let [r (js->clj response)]
(js/console.log (str "Transmission success: " r))
;; while we've got comms working, get as many items through as we can.
(dispatch [:process-queue])
db)))
(reg-event-db
:tx-failure
(fn [db _]
(js/console.log (str "Transmission failed, requeueing" (:tx-item db)))
(assoc
(add-to-outqueue db (:tx-item db))
:error "Transmission failed, requeueing")))