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

#17: progress, not complete.

Browse source
This commit is contained in:
Simon Brooke 2018-07-09 22:00:39 +01:00
parent 0026218993
commit 9c3af4c936
58 changed files with 1896 additions and 463 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/clj/youyesyet/handler.clj
View file

@ -10,10 +10,11 @@
[youyesyet.layout :refer [error-page]]
[youyesyet.middleware :as middleware]
[youyesyet.routes.home :refer [home-routes]]
[youyesyet.routes.oauth :refer [oauth-routes]]
[youyesyet.routes.auto-json :refer [auto-rest-routes]]
[youyesyet.routes.auto :refer [auto-selmer-routes]]
[youyesyet.routes.auto-json :refer [auto-rest-routes]]
[youyesyet.routes.issue-experts :refer [issue-expert-routes]]
[youyesyet.routes.rest :refer [rest-routes]]
[youyesyet.routes.oauth :refer [oauth-routes]]
[youyesyet.routes.roles :refer [roles-routes]]
[youyesyet.routes.services :refer [service-routes]]
[youyesyet.env :refer [defaults]]))
@ -72,6 +73,9 @@
(-> #'roles-routes
(wrap-routes middleware/wrap-csrf)
(wrap-routes middleware/wrap-formats))
(-> #'issue-expert-routes
(wrap-routes middleware/wrap-csrf)
(wrap-routes middleware/wrap-formats))
(-> #'auto-rest-routes
(wrap-routes middleware/wrap-csrf)
(wrap-routes middleware/wrap-formats))

7
src/clj/youyesyet/routes/auto.clj
View file

@ -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 20180707T080949.557Z"
"User interface routes for Youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180709T205534.030Z"
(:require
[adl-support.core :as support]
[clojure.java.io :as io]
@ -176,7 +176,8 @@
{:electors (db/list-electors db/*db*)}
{:addresses (db/list-addresses db/*db*)}
{:authorities (db/list-authorities db/*db*)}
{:roles (db/list-roles db/*db*)}))))))
{:roles (db/list-roles db/*db*)}
{:issues (db/list-issues db/*db*)}))))))
(defn
list-districts-Districts
@ -689,7 +690,7 @@
(empty? (remove nil? (vals p)))
[]
(db/get-issue db/*db* p))})
(list))))))
(list {:canvassers (db/list-canvassers db/*db*)}))))))
(defn
list-options-Options

20
src/clj/youyesyet/routes/auto_json.clj
View file

@ -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 20180707T080948.404Z"
"JSON routes for youyesyet auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at 20180709T205532.861Z"
(:require
[adl-support.core :as support]
[clojure.core.memoize :as memo]
@ -675,6 +675,11 @@
[{:keys [params]}]
(do (db/list-canvassers-by-elector params)))
(defn
list-canvassers-by-issue
[{:keys [params]}]
(do (db/list-canvassers-by-issue params)))
(defn
list-canvassers-by-role
[{:keys [params]}]
@ -879,6 +884,11 @@
:ttl/threshold
1000000))
(defn
list-issues-by-canvasser
[{:keys [params]}]
(do (db/list-issues-by-canvasser params)))
(def
list-options
(memo/ttl
@ -1587,6 +1597,10 @@
"/json/auto/list-canvassers-by-elector"
request
(route/restricted (list-canvassers-by-elector request)))
(GET
"/json/auto/list-canvassers-by-issue"
request
(route/restricted (list-canvassers-by-issue request)))
(GET
"/json/auto/list-canvassers-by-role"
request
@ -1683,6 +1697,10 @@
"/json/auto/list-issues"
request
(route/restricted (list-issues request)))
(GET
"/json/auto/list-issues-by-canvasser"
request
(route/restricted (list-issues-by-canvasser request)))
(GET
"/json/auto/list-options"
request

68
src/clj/youyesyet/routes/issue_experts.clj Normal file
View file

@ -0,0 +1,68 @@
(ns ^{:doc "Routes/pages available to issue experts."
:author "Simon Brooke"} youyesyet.routes.issue-experts
(:require [adl-support.utils :refer [safe-name]]
[clojure.java.io :as io]
[clojure.string :as s]
[clojure.tools.logging :as log]
[clojure.walk :refer [keywordize-keys]]
[markdown.core :refer [md-to-html-string]]
[noir.util.route :as route]
[ring.util.http-response :as response]
[youyesyet.config :refer [env]]
[youyesyet.db.core :as db]
[youyesyet.layout :as layout]
[youyesyet.oauth :as oauth]
[compojure.core :refer [defroutes GET POST]]
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; youyesyet.routes.home: routes and pages for issue experts.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2016 Simon Brooke for Radical Independence Campaign
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn list-page [request]
(layout/render
"auto/list-followuprequests-Followuprequests.html"
(:session request)
(let [user (:user (:session request))]
{:title "Open requests"
:user user
:records (db/list-open-requests db/*db* {:expert (:id user)})})))
(defn followup-request-page [request]
(layout/render
"issue-expert/request.html"
(:session request)
{:title "Open requests"
:user (:user (:session request))
:request (db/get-followuprequest
db/*db*
{:id (:id (keywordize-keys (:params request)))})}))
(defroutes issue-expert-routes
(GET "/issue-expert/list" request
(route/restricted (list-page request)))
(GET "/issue-expert/followup-request" request
(route/restricted (followup-request-page request)))
(POST "/issue-expert/followup-request" request
(route/restricted (followup-request-page request))))

31
src/clj/youyesyet/routes/roles.clj
View file

@ -1,6 +1,7 @@
(ns ^{:doc "Routes/pages available to authenticated users in specific roles."
:author "Simon Brooke"} youyesyet.routes.roles
(:require [adl-support.utils :refer [safe-name]]
(:require [adl-support.core :as support]
[adl-support.utils :refer [safe-name]]
[clojure.tools.logging :as log]
[clojure.walk :refer [keywordize-keys]]
[compojure.core :refer [defroutes GET POST]]
@ -8,6 +9,7 @@
[ring.util.http-response :as response]
[youyesyet.config :refer [env]]
[youyesyet.db.core :as db-core]
[youyesyet.routes.issue-experts :as expert]
[youyesyet.layout :as layout]
[youyesyet.oauth :as oauth]
[youyesyet.routes.auto :as auto]))
@ -34,7 +36,10 @@
(defn admins-page
[request]
(response/found "/admin"))
(layout/render
(support/resolve-template "application-index.html")
(:session request)
{:title "Administrative menu"}))
(defn analysts-page
@ -42,7 +47,10 @@
some other geographical information system; so there isn't a need to put
anything sophisticated here."
[request]
(response/found "/admin"))
(layout/render
(support/resolve-template "application-index.html")
(:session request)
{:title "Administrative menu"}))
(defn canvassers-page
@ -50,22 +58,17 @@
(layout/render "roles/canvasser.html" request {}))
(defn issue-experts-page
[request]
(layout/render "roles/issue-experts.html" request {}))
(defn team-organisers-page
[request]
(layout/render "roles/team-orgenisers.html" request {}))
(defroutes roles-routes
(GET "/roles/admins" [request] (route/restricted (admins-page request)))
(GET "/roles/analysts" [request] (route/restricted (analysts-page request)))
(GET "/roles/canvassers" [request] (route/restricted (canvassers-page request)))
(GET "/roles/issue_editors" [request] (route/restricted (auto/list-issues-Issues request)))
(GET "/roles/issue_experts" [request] (route/restricted (issue-experts-page request)))
(GET "/roles/team_organisers" [request] (route/restricted (auto/list-teams-Teams request)))
(GET "/roles/admin" request (route/restricted (admins-page request)))
(GET "/roles/analysts" request (route/restricted (analysts-page request)))
(GET "/roles/canvassers" request (route/restricted (canvassers-page request)))
(GET "/roles/issue_editors" request (route/restricted (auto/list-issues-Issues request)))
(GET "/roles/issue_experts" request (route/restricted (expert/list-page request)))
(GET "/roles/team_organisers" request (route/restricted (auto/list-teams-Teams request)))
(GET "/roles" request (route/restricted (roles-page request))))

9
src/cljs/youyesyet/canvasser_app/core.cljs
View file

@ -10,6 +10,7 @@
[re-frame.core :as rf]
[secretary.core :as secretary]
[youyesyet.canvasser-app.ajax :refer [load-interceptors!]]
[youyesyet.canvasser-app.gis :refer [get-current-location]]
[youyesyet.canvasser-app.handlers :as h]
[youyesyet.canvasser-app.subscriptions]
[youyesyet.canvasser-app.ui-utils :as ui]
@ -74,14 +75,18 @@
(defn issue-page []
(issue/panel))
(defn issue-experts-page []
(expert/panel))
(defn map-page []
(maps/panel))
(def pages
{:about #'about-page
:building #'building-page
:elector #'elector-page
:dwelling #'dwelling-page
:elector #'elector-page
:expert #'expert
:followup #'followup-page
:gdpr #'gdpr-page
:issues #'issues-page
@ -191,7 +196,7 @@
(defn init! []
(rf/dispatch-sync [:initialize-db])
(h/get-current-location)
(get-current-location)
(rf/dispatch [:fetch-locality])
(rf/dispatch [:fetch-options])
(rf/dispatch [:fetch-issues])

139
src/cljs/youyesyet/canvasser_app/gis.cljs Normal file
View file

@ -0,0 +1,139 @@
(ns ^{:doc "Canvasser app map stuff."
:author "Simon Brooke"}
youyesyet.canvasser-app.gis
(:require [cljs.reader :refer [read-string]]
[cemerick.url :refer (url url-encode)]
[day8.re-frame.http-fx]
[re-frame.core :refer [dispatch reg-event-db reg-event-fx subscribe]]
[ajax.core :refer [GET]]
[ajax.json :refer [json-request-format json-response-format]]
[youyesyet.canvasser-app.state :as db]
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; youyesyet.canvasser-app.gis: stuff to do with maps.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2016 Simon Brooke for Radical Independence Campaign
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; map stuff. If we do this in canvasser-app.views.map we get circular
;; references, so do it here.
(defn get-current-location []
"Get the current location from the device."
(try
(if (.-geolocation js/navigator)
(.getCurrentPosition
(.-geolocation js/navigator)
(fn [position]
(js/console.log (str "Current location is: "
(.-latitude (.-coords position)) ", "
(.-longitude (.-coords position))))
(dispatch [:set-latitude (.-latitude (.-coords position))])
(dispatch [:set-longitude (.-longitude (.-coords position))])))
(js/console.log "Geolocation not available"))
(catch js/Object any
(js/console.log "Exception while trying to access location: " + any))))
(defn pin-image
"select the name of a suitable pin image for this address"
[address]
(let [intentions
(set
(remove
nil?
(map
:intention
(mapcat :electors
(:dwellings address)))))]
(case (count intentions)
0 "unknown-pin"
1 (str (name (first intentions)) "-pin")
"mixed-pin")))
(defn map-pin-click-handler
"On clicking on the pin, navigate to the electors at the address.
This way of doing it adds an antry in the browser location history,
so back links work."
[id]
(js/console.log (str "Click handler for address #" id))
(let [view @(subscribe [:view])
centre (.getCenter view)]
(dispatch [:set-zoom (.getZoom view)])
(dispatch [:set-latitude (.-lat centre)])
(dispatch [:set-longitude (.-lng centre)]))
(set! window.location.href (str "#building/" id)))
(defn add-map-pin
"Add a map-pin at this address in this map view"
[address view]
(let [lat (:latitude address)
lng (:longitude address)
pin (.icon js/L
(clj->js
{:iconAnchor [16 41]
:iconSize [32 42]
:iconUrl (str "img/map-pins/" (pin-image address) ".png")
:riseOnHover true
:shadowAnchor [16 23]
:shadowSize [57 24]
:shadowUrl "img/map-pins/shadow_pin.png"}))
marker (.marker js/L
(.latLng js/L lat lng)
(clj->js {:icon pin
:title (:address address)}))]
(.on (.addTo marker view) "click" (fn [_] (map-pin-click-handler (str (:id address)))))
marker))
(defn map-remove-pins
"Remove all pins from this map `view`. Side-effecty; liable to be problematic."
[view]
(if
view
(.eachLayer
view
(fn [layer]
(try
(if
(instance? js/L.Marker layer)
(.removeLayer view layer))
(catch js/Object any (js/console.log (str "Failed to remove pin '" layer "' from map: " any)))))))
view)
(defn refresh-map-pins
"Refresh the map pins on this map. Side-effecty; liable to be problematic."
[]
(let [view (map-remove-pins @(subscribe [:view]))
addresses @(subscribe [:addresses])]
(if
view
(do
(js/console.log (str "Adding " (count addresses) " pins"))
(doall (map #(add-map-pin % view) addresses)))
(js/console.log "View is not yet ready"))
view))

117
src/cljs/youyesyet/canvasser_app/handlers.cljs
View file

@ -7,12 +7,13 @@
[re-frame.core :refer [dispatch reg-event-db reg-event-fx subscribe]]
[ajax.core :refer [GET]]
[ajax.json :refer [json-request-format json-response-format]]
[youyesyet.canvasser-app.gis :refer [refresh-map-pins get-current-location]]
[youyesyet.canvasser-app.state :as db]
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; youyesyet.handlers: handlers for events.
;;;; youyesyet.canvasser-app.handlers: event handlers.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
@ -101,113 +102,12 @@
(:electors state) "'")))))
;; map stuff. If we do this in canvasser-app.views.map we get circular
;; references, so do it here.
(defn pin-image
"select the name of a suitable pin image for this address"
[address]
(let [intentions
(set
(remove
nil?
(map
:intention
(mapcat :electors
(:dwellings address)))))]
(case (count intentions)
0 "unknown-pin"
1 (str (name (first intentions)) "-pin")
"mixed-pin")))
(defn map-pin-click-handler
"On clicking on the pin, navigate to the electors at the address.
This way of doing it adds an antry in the browser location history,
so back links work."
[id]
(js/console.log (str "Click handler for address #" id))
(let [view @(subscribe [:view])
centre (.getCenter view)]
(dispatch [:set-zoom (.getZoom view)])
(dispatch [:set-latitude (.-lat centre)])
(dispatch [:set-longitude (.-lng centre)]))
(set! window.location.href (str "#building/" id)))
(defn add-map-pin
"Add a map-pin at this address in this map view"
[address view]
(let [lat (:latitude address)
lng (:longitude address)
pin (.icon js/L
(clj->js
{:iconAnchor [16 41]
:iconSize [32 42]
:iconUrl (str "img/map-pins/" (pin-image address) ".png")
:riseOnHover true
:shadowAnchor [16 23]
:shadowSize [57 24]
:shadowUrl "img/map-pins/shadow_pin.png"}))
marker (.marker js/L
(.latLng js/L lat lng)
(clj->js {:icon pin
:title (:address address)}))]
(.on (.addTo marker view) "click" (fn [_] (map-pin-click-handler (str (:id address)))))
marker))
(defn map-remove-pins
"Remove all pins from this map `view`. Side-effecty; liable to be problematic."
[view]
(if
view
(.eachLayer
view
(fn [layer]
(try
(if
(instance? js/L.Marker layer)
(.removeLayer view layer))
(catch js/Object any (js/console.log (str "Failed to remove pin '" layer "' from map: " any)))))))
view)
(defn refresh-map-pins
"Refresh the map pins on this map. Side-effecty; liable to be problematic."
[]
(let [view (map-remove-pins @(subscribe [:view]))
addresses @(subscribe [:addresses])]
(if
view
(do
(js/console.log (str "Adding " (count addresses) " pins"))
(doall (map #(add-map-pin % view) addresses)))
(js/console.log "View is not yet ready"))
view))
(reg-event-db
:initialize-db
(fn [_ _]
db/default-db))
(defn get-current-location []
"Get the current location from the device."
(try
(if (.-geolocation js/navigator)
(.getCurrentPosition
(.-geolocation js/navigator)
(fn [position]
(js/console.log "Current location is: " + position)
(dispatch [:set-latitude (.-latitude (.-coords position))])
(dispatch [:set-longitude (.-longitude (.-coords position))])))
(js/console.log "Geolocation not available"))
(catch js/Object any
(js/console.log "Exception while trying to access location: " + any))))
;; (reg-event-fx
;; :feedback
;; (fn [x y]
@ -254,11 +154,21 @@
:db (add-to-feedback db :fetch-locality)}))
(reg-event-db
:get-current-location
(fn [db _]
(js/console.log "Updating current location")
(assoc db :froboz (get-current-location))))
(reg-event-db
:process-locality
(fn
[db [_ response]]
(js/console.log "Updating locality data")
;; loop to do it again
(dispatch [:dispatch-later [{:ms 5000 :dispatch [:fetch-locality]}
{:ms 1000 :dispatch [:get-current-location]}]])
(assoc
(remove-from-feedback db :fetch-locality)
(refresh-map-pins)
@ -270,6 +180,9 @@
(fn [db _]
;; TODO: signal something has failed? It doesn't matter very much, unless it keeps failing.
(js/console.log "Failed to fetch locality data")
;; loop to do it again
(dispatch [:dispatch-later [{:ms 60000 :dispatch [:fetch-locality]}
{:ms 1000 :dispatch [:get-current-location]}]])
(assoc
(remove-from-feedback db :fetch-locality)
:error (cons :fetch-locality (:error db)))))

3
src/cljs/youyesyet/canvasser_app/views/map.cljs
View file

@ -3,7 +3,7 @@
youyesyet.canvasser-app.views.map
(:require [re-frame.core :refer [reg-sub subscribe dispatch dispatch-sync]]
[reagent.core :as reagent]
[youyesyet.canvasser-app.handlers :refer [get-current-location refresh-map-pins]]))
[youyesyet.canvasser-app.gis :refer [refresh-map-pins get-current-location]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@ -28,7 +28,6 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The pattern from the re-com demo (https://github.com/Day8/re-com) is to have
;;; one source file/namespace per view. Each namespace contains a function 'panel'
;;; whose output is an enlive-style specification of the view to be redered.

5
src/cljs/youyesyet/issue_expert_app/README.md Normal file
View file

@ -0,0 +1,5 @@
# Issue Expert app
The Issue Expert app is essentially a whole different app. I think it needs to be an app because it needs a much more slick UI than an old CRUD web system, but it's designed for use on desktop systems with large screens.
It comprises two views: a list of open followup requests, and a view to handle an individual request. The work flow is, pick a request from the list, obtain an exclusive lock on it,

0
src/cljs/youyesyet/issue_expert_app/core.cljs Normal file
View file

52
src/cljs/youyesyet/issue_expert_app/views/list.cljs Normal file
View file

@ -0,0 +1,52 @@
(ns ^{:doc "Issue Expert app list panel."
:author "Simon Brooke"}
youyesyet.canvasser-app.views.issues
(:require [re-frame.core :refer [reg-sub subscribe]]
[youyesyet.canvasser-app.ui-utils :as ui]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; youyesyet.canvasser-app.views.issues: working view for issue experts for youyesyet.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2016 Simon Brooke for Radical Independence Campaign
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The pattern from the re-com demo (https://github.com/Day8/re-com) is to have
;;; one source file/namespace per view. Each namespace contains a function 'panel'
;;; whose output is an enlive-style specification of the view to be redered.
;;; I propose to follow this pattern. This file will provide the issues view.
;;; TODO: This is, in essence, an enturely different app. It really ought to be
;;; in a separate project. But to get it working quickly, it's here for now.
;;; Simple list of the issues of the day.
(defn panel
"Generate the list panel."
[]
(let [issues @(subscribe [:issues])]
(if issues
[:div
[:h1 "Issues"]
[:div.container {:id "main-container"}
(ui/back-link)
[:div {:id "issue-list"}
(map (fn [i] (ui/big-link (:id i) :target (str "#issue/" (:id i)))) issues)]]]
(ui/error-panel "No issues loaded"))))