Skip to content

Commit 0a69394

Browse files
dnulnetsdnulnets
committed
Implemented the users view
1 parent a1c0d3c commit 0a69394

File tree

3 files changed

+78
-114
lines changed

3 files changed

+78
-114
lines changed

‎portal/src/Accessibility/Component/MapNearby.purs‎

Lines changed: 45 additions & 109 deletions
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,8 @@ import Prelude
1111
-- Data imports
1212
import Data.Array((!!), catMaybes, length)
1313
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe')
14-
import Data.Foldable (sequence_, for_)
15-
import Data.Traversable (sequence, traverse)
14+
import Data.Foldable (sequence_)
15+
import Data.Traversable (sequence)
1616
import Data.Tuple (Tuple(..), fst, snd)
1717
import Math (pi)
1818

@@ -46,7 +46,6 @@ import Web.DOM.ParentNode as WDPN
4646

4747
-- Openlayers imports
4848
import OpenLayers.Interaction.Select as Select
49-
import OpenLayers.MapBrowserEvent as MapBrowserEvent
5049
import OpenLayers.Feature as Feature
5150
import OpenLayers.Source.OSM as OSM
5251
import OpenLayers.Layer.Tile as Tile
@@ -68,12 +67,13 @@ import OpenLayers.Collection as Collection
6867
import OpenLayers.Events.Condition as Condition
6968
import OpenLayers.Coordinate as Coordinate
7069
import OpenLayers.Style.RegularShape as RegularShape
70+
import OpenLayers.Size as Size
71+
import OpenLayers.Render.Event as Event
7172

7273
-- Our own imports
73-
import Accessibility.Data.Route (Page(..)) as ADR
7474
import Accessibility.Component.HTML.Utils (css)
7575
import Accessibility.Util.Result (evaluateResult)
76-
import Accessibility.Interface.Navigate (class ManageNavigation, gotoPage)
76+
import Accessibility.Interface.Navigate (class ManageNavigation)
7777
import Accessibility.Interface.Item (class ManageItem, queryItems, Item)
7878
import Accessibility.Interface.Entity (class ManageEntity, Value, queryEntities, Entity(..))
7979

@@ -107,18 +107,13 @@ initialState _ = { subscription : []
107107
data Action = Initialize
108108
| Finalize
109109
| Update
110-
| UpdateCursor
111-
| EditItem
112110
| Center
113-
| CenterCursor
114-
| AddItem
115-
| AddItemCursor
116111
| FeatureSelect Select.SelectEvent
117112
| GPSError
118113
| GPSPosition Geolocation.Geolocation Feature.Feature
119114
| GPSAccuracy Geolocation.Geolocation Feature.Feature
120115
| GPSCenter Geolocation.Geolocation Map.Map VectorLayer.Vector
121-
| MAPPosition Feature.Feature MapBrowserEvent.MapBrowserEvent
116+
| MAPRenderComplete Event.RenderEvent
122117

123118
-- | The output from this component
124119
data Output = AuthenticationError
@@ -147,7 +142,7 @@ render :: forall m . MonadAff m
147142
-> H.ComponentHTML Action () m -- ^ The components HTML
148143
render state = HH.div
149144
[css "d-flex flex-column ha-nearby"]
150-
[HH.div [css "row"] [HH.div[css "col-xs-12 col-md-12"][HH.h2 [][HH.text "POI Administration"]]],
145+
[HH.div [css "row"] [HH.div[css "col-xs-12 col-md-12"][HH.h2 [][HH.text "Points Of Interest"]]],
151146
HH.div [css "row flex-grow-1 ha-nearby-map"] [HH.div[css "col-xs-12 col-md-12"][HH.div [HP.id_ "ha-map"][]]]
152147
]
153148

@@ -183,14 +178,6 @@ handleAction Initialize = do
183178
, geo = Just gps
184179
, layer = Just poiLayer})
185180

186-
-- | Add an item to the database based on the current position
187-
handleAction AddItem = do
188-
state <- H.get
189-
mpos <- H.liftEffect $ join <$> traverse Geolocation.getPosition state.geo
190-
for_ mpos \pos -> do
191-
sequence_ $ gotoPage <$> (ADR.AddPoint <$> (Coordinate.latitude $ Proj.toLonLat' pos)
192-
<*> (Coordinate.longitude $ Proj.toLonLat' pos))
193-
194181
-- | Finalize action, clean up the component
195182
handleAction Finalize = do
196183
state <- H.get
@@ -200,61 +187,35 @@ handleAction Finalize = do
200187
sequence_ $ Map.clearTarget <$> state.map
201188
H.put state { map = Nothing, geo = Nothing, select = Nothing }
202189

203-
-- | Add an item to the database based on the current position
204-
handleAction AddItemCursor = do
205-
state <- H.get
206-
for_ state.crosshair \pos -> do
207-
sequence_ $ gotoPage <$> (ADR.AddPoint <$> (Coordinate.latitude $ Proj.toLonLat' pos)
208-
<*> (Coordinate.longitude $ Proj.toLonLat' pos))
209-
210-
-- |Edit the selected item
211-
handleAction EditItem = do
212-
state <- H.get
213-
H.liftEffect $ log "Edit a selected item"
214-
cf <- H.liftEffect $ sequence $ Select.getFeatures <$> state.select
215-
sequence_ $ gotoPage <$> (ADR.Point <$> (feature cf) <*> (Just false))
216-
where
217-
feature cf = join $ (Feature.get "id") <$> (join $ (Collection.item 0) <$> cf)
218-
219190
-- | Update the POI around the GPS location
220191
handleAction Update = do
221192

222193
-- Clear the alert
223194
state <- H.modify $ _ {alert = Nothing}
224195

225-
-- Get the GPS position
226-
pos <- H.liftEffect $ join <$> (sequence $ Geolocation.getPosition <$> state.geo)
227-
228-
-- Get the POI from our own backend
229-
when (isJust pos) do
230-
231-
ditems <- queryItems {longitude : join $ (Coordinate.longitude <<< Proj.toLonLat') <$> pos
232-
, latitude: join $ (Coordinate.latitude <<< Proj.toLonLat') <$> pos
233-
, distance: Just state.distance
234-
, limit: Nothing
235-
, text: Nothing } >>= evaluateResult AuthenticationError
236-
vs <- H.liftEffect $ maybe' (\_->VectorSource.create') (\i->do
237-
flist <- sequence $ fromItem <$> i
238-
VectorSource.create { features: VectorSource.features.asArray flist }) ditems
239-
240-
-- Set the source to the POI-layer
241-
H.liftEffect $ sequence_ $ (VectorLayer.setSource vs) <$> state.layer
196+
-- Get the MAP center position
197+
pos <- H.liftEffect do
198+
view <- join <$> (sequence $ Map.getView <$> state.map)
199+
join <$> (sequence $ View.getCenter <$> view)
242200

243-
-- Set the alert
244-
(Alert <$> H.gets _.alert) >>= H.raise
201+
-- Get the size of the view in meters
202+
distance <- H.liftEffect do
203+
view <- join <$> (sequence $ Map.getView <$> state.map)
204+
resolution <- join <$> (sequence $ View.getResolution <$> view)
205+
size <- join <$> (sequence $ Map.getSize <$> state.map)
206+
pure $ div <$> (max <$> (mul <$> resolution <*> (join (Size.width <$> size)))
207+
<*> (mul <$> resolution <*> (join (Size.height <$> size))))
208+
<*> Just 2.0
245209

246-
-- | Update the POI around the current cursor/crosshair
247-
handleAction UpdateCursor = do
210+
H.liftEffect $ log $ "Radius for search is " <> (show distance)
211+
H.liftEffect $ log $ "Position for search is " <> (show pos)
248212

249-
-- Clear the alert
250-
state <- H.modify $ _ {alert = Nothing}
251-
252213
-- Get the POI from our own backend
253-
when (isJust state.crosshair) do
214+
when (isJust pos) do
254215

255-
ditems <- queryItems {longitude : join $ (Coordinate.longitude <<< Proj.toLonLat') <$> state.crosshair
256-
, latitude: join $ (Coordinate.latitude <<< Proj.toLonLat') <$> state.crosshair
257-
, distance: Just state.distance
216+
ditems <- queryItems {longitude : join $ (Coordinate.longitude <<< Proj.toLonLat') <$> pos
217+
, latitude: join $ (Coordinate.latitude <<< Proj.toLonLat') <$> pos
218+
, distance: Just $ fromMaybe state.distance distance
258219
, limit: Nothing
259220
, text: Nothing } >>= evaluateResult AuthenticationError
260221
vs <- H.liftEffect $ maybe' (\_->VectorSource.create') (\i->do
@@ -275,13 +236,6 @@ handleAction Center = do
275236
view <- join <$> (sequence $ Map.getView <$> state.map)
276237
sequence_ $ View.setCenter <$> pos <*> view
277238

278-
-- | Center the map around the Cursor/Crosshair
279-
handleAction CenterCursor = do
280-
state <- H.get
281-
H.liftEffect do
282-
view <- join <$> (sequence $ Map.getView <$> state.map)
283-
sequence_ $ View.setCenter <$> state.crosshair <*> view
284-
285239
-- | Feature is selected
286240
handleAction (FeatureSelect e) = H.liftEffect $ do
287241
log "Feature selected!"
@@ -305,17 +259,27 @@ handleAction (GPSAccuracy geo feature) = H.liftEffect $ do
305259
-- | GPS Center - Center the map based on geolocation and add all POI:s
306260
handleAction (GPSCenter geo map vl) = do
307261
state <- H.get
262+
308263
pos <- H.liftEffect $ Geolocation.getPosition geo
309264
H.liftEffect $ do
310265
mv <- Map.getView map
311266
sequence_ $ View.setCenter <$> pos <*> mv
312267

268+
-- Get the size of the view in meters
269+
distance <- H.liftEffect do
270+
view <- Map.getView map
271+
resolution <- join <$> (sequence $ View.getResolution <$> view)
272+
size <- join <$> (sequence $ Map.getSize <$> state.map)
273+
pure $ div <$> (max <$> (mul <$> resolution <*> (join (Size.width <$> size)))
274+
<*> (mul <$> resolution <*> (join (Size.height <$> size))))
275+
<*> Just 2.0
276+
313277
-- Get the POI from our own backend
314278
when (isJust pos) do
315279

316280
ditems <- queryItems {longitude : join $ (Coordinate.longitude <<< Proj.toLonLat') <$> pos
317281
, latitude: join $ (Coordinate.latitude <<< Proj.toLonLat') <$> pos
318-
, distance: Just state.distance
282+
, distance: Just $ fromMaybe state.distance distance
319283
, limit: Nothing
320284
, text: Nothing } >>= evaluateResult AuthenticationError
321285
vs <- H.liftEffect $ maybe' (\_->VectorSource.create') (\i->do
@@ -329,11 +293,8 @@ handleAction (GPSCenter geo map vl) = do
329293
(Alert <$> H.gets _.alert) >>= H.raise
330294

331295
-- | Position the cursor/croasshair on the MAP
332-
handleAction (MAPPosition f mbe) = do
333-
H.modify_ $ _ {crosshair = Just $ MapBrowserEvent.coordinate mbe}
334-
H.liftEffect $ do
335-
point <- Point.create' $ MapBrowserEvent.coordinate mbe
336-
Feature.setGeometry point f
296+
handleAction (MAPRenderComplete e) = do
297+
H.liftEffect $ log $ "Render completed!"
337298

338299
--
339300
-- Creates the map and attaches openstreetmap as a source
@@ -355,41 +316,21 @@ createMap = do
355316

356317
-- Extend the map with a set of buttons
357318
ctrl <- Ctrl.defaults'
358-
elemAdd <- createMapButton "A" "ha-id-add-item" "ha-map-add-item"
359-
elemSAdd <- createMapButton "a" "ha-id-sadd-item" "ha-map-sadd-item"
360-
elemEdit <- createMapButton "E" "ha-id-edit-item" "ha-map-edit-item"
361319
elemCenter <- createMapButton "C" "ha-id-center" "ha-map-center"
362-
elemSCenter <- createMapButton "c" "ha-id-scenter" "ha-map-scenter"
363320
elemRefresh <- createMapButton "R" "ha-id-refresh" "ha-map-refresh"
364-
elemSRefresh <- createMapButton "r" "ha-id-srefresh" "ha-map-srefresh"
365321

366322
domDocument <- window >>= WHW.document <#> WHHD.toDocument
367323
elem <- WDD.createElement "div" domDocument
368324
WDE.setClassName "ha-map-ctrl ol-unselectable ol-control" elem
369325

370326
elem1 <- WDD.createElement "div" domDocument
371-
WDE.setClassName "tomas" elem1
372-
void $ WDN.appendChild (WDE.toNode elemAdd) (WDE.toNode elem1)
373-
void $ WDN.appendChild (WDE.toNode elemSAdd) (WDE.toNode elem1)
327+
void $ WDN.appendChild (WDE.toNode elemRefresh) (WDE.toNode elem1)
374328
void $ WDN.appendChild (WDE.toNode elem1) (WDE.toNode elem)
375329

376330
elem2 <- WDD.createElement "div" domDocument
377-
WDE.setClassName "tomas" elem2
378-
void $ WDN.appendChild (WDE.toNode elemEdit) (WDE.toNode elem2)
331+
void $ WDN.appendChild (WDE.toNode elemCenter) (WDE.toNode elem2)
379332
void $ WDN.appendChild (WDE.toNode elem2) (WDE.toNode elem)
380333

381-
elem3 <- WDD.createElement "div" domDocument
382-
WDE.setClassName "tomas" elem3
383-
void $ WDN.appendChild (WDE.toNode elemRefresh) (WDE.toNode elem3)
384-
void $ WDN.appendChild (WDE.toNode elemSRefresh) (WDE.toNode elem3)
385-
void $ WDN.appendChild (WDE.toNode elem3) (WDE.toNode elem)
386-
387-
elem4 <- WDD.createElement "div" domDocument
388-
WDE.setClassName "tomas" elem4
389-
void $ WDN.appendChild (WDE.toNode elemCenter) (WDE.toNode elem4)
390-
void $ WDN.appendChild (WDE.toNode elemSCenter) (WDE.toNode elem4)
391-
void $ WDN.appendChild (WDE.toNode elem4) (WDE.toNode elem)
392-
393334
ctrlButtons <- Control.create { element: elem }
394335

395336
-- Create the map and set up the controls, layers and view
@@ -430,14 +371,9 @@ createButtonHandlers:: forall o m . MonadAff m
430371
createButtonHandlers = do
431372

432373
-- Add a listener to every button on the map
433-
sadd <- addMapButtonHandler AddItem "#ha-id-add-item"
434-
ssadd <- addMapButtonHandler AddItemCursor "#ha-id-sadd-item"
435-
sedit <- addMapButtonHandler EditItem "#ha-id-edit-item"
436374
supd <- addMapButtonHandler Update "#ha-id-refresh"
437-
ssupd <- addMapButtonHandler UpdateCursor "#ha-id-srefresh"
438375
scen <- addMapButtonHandler Center "#ha-id-center"
439-
sscen <- addMapButtonHandler CenterCursor "#ha-id-scenter"
440-
pure $ catMaybes [sadd, sedit, supd, scen, ssadd, ssupd, sscen]
376+
pure $ catMaybes [supd, scen]
441377

442378
where
443379

@@ -578,12 +514,12 @@ createLayers map = do
578514
Map.addLayer plvector map
579515
pure pfeat
580516

581-
-- Get a MapBrowser Event for singleclick
517+
-- Get a RenderComplete Event when the rendering is complete
582518
void $ H.subscribe $ HQE.effectEventSource \emitter -> do
583-
key <- Map.on "singleclick" (\e -> do
584-
HQE.emit emitter (MAPPosition fcursor e)
519+
key <- Map.onRenderComplete (\e -> do
520+
HQE.emit emitter (MAPRenderComplete e)
585521
pure true) map
586-
pure (HQE.Finalizer (Map.un "singleclick" key map))
522+
pure (HQE.Finalizer (Map.unRenderComplete key map))
587523

588524
-- Get the weather data from the IoT Hub
589525
dentities <- queryEntities "WeatherObserved" >>= evaluateResult AuthenticationError

‎portal/src/Accessibility/Data/Route.purs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,8 @@ import Routing.Duplex.Generic.Syntax ((/))
2626

2727
-- |All possible routes
2828
data Page = Home -- ^ The home page
29+
| MapAdmin -- ^ The admin page for POI:s
30+
| UserAdmin -- ^ The admin page for users
2931
| Login -- ^ The login page
3032
| Point String Boolean -- ^ The point management page, contains item key and readonly boolean
3133
| AddPoint Number Number -- ^The addpoint page, contains the latitude and longitude of the point
@@ -40,10 +42,12 @@ instance showPage :: Show Page where
4042
-- | Routing function that creates data types based on the URL, we only deal with home and
4143
-- login pages
4244
router :: Match Page -- ^ The router
43-
router = home <|> login
45+
router = home <|> login <|> admin <|> useradmin
4446
where
4547
home = Home <$ lit ""
4648
login = Login <$ lit "login"
49+
admin = MapAdmin <$ lit "mapadmin"
50+
useradmin = UserAdmin <$ lit "useradmin"
4751

4852

4953
-- |Add a parser for number as a segment
@@ -58,6 +62,8 @@ num = as show number
5862
routeCodec :: RouteDuplex' Page -- ^The router codec
5963
routeCodec = root $ sum
6064
{ "Home": noArgs
65+
, "MapAdmin": "mapadmin" / noArgs
66+
, "UserAdmin": "useradmin" / noArgs
6167
, "Login": "login" / noArgs
6268
, "Error": "error" / noArgs
6369
, "Point": "point" / string segment / boolean segment

‎portal/src/Accessibility/Root.purs‎

Lines changed: 26 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Accessibility.Component.HTML.Utils
3838
, href)
3939
import Accessibility.Component.Login as Login
4040
import Accessibility.Component.MapAdmin as MapAdmin
41+
import Accessibility.Component.MapNearby as MapNearby
4142
import Accessibility.Component.Point as Point
4243
import Accessibility.Interface.Navigate (class ManageNavigation, gotoPage)
4344
import Accessibility.Interface.Authenticate (class ManageAuthentication
@@ -67,11 +68,13 @@ data Action = SetUser (Maybe UserInfo) -- ^Sets the user
6768
-- | The set of slots for the root container
6869
type ChildSlots = ( login ∷ Login.Slot Unit,
6970
mapadmin :: MapAdmin.Slot Unit,
71+
mapnearby :: MapNearby.Slot Unit,
7072
point :: Point.Slot Unit )
7173

7274
_login = SProxy::SProxy "login"
7375
_mapadmin = SProxy::SProxy "mapadmin"
7476
_point = SProxy::SProxy "point"
77+
_mapnearby = SProxy::SProxy "mapnearby"
7578

7679
component ∷ ∀ r o m. MonadAff m
7780
=> ManageAuthentication m
@@ -117,13 +120,26 @@ navbarHeader header = [HH.button [css "navbar-toggler",
117120
[HH.text header]
118121
]
119122

123+
navbarLeftAdmin∷forall p . State -> Array(HH.HTML p Action)
124+
navbarLeftAdmin p = maybe [] (const [
125+
HH.li [css "nav-item dropdown"] [
126+
HH.a [css "nav-link dropdown-toggle active", prop "data-toggle" "dropdown"] [HH.text "Admin"],
127+
HH.div [css "dropdown-menu dropdown-primary"] [
128+
HH.a [css "dropdown-item", href MapAdmin] [HH.text "POI:s"],
129+
HH.a [css "dropdown-item", href Home] [HH.text "Users"]
130+
]
131+
]]) p.userInfo
132+
133+
navbarLeftDefault∷forall p . State -> Array (HH.HTML p Action)
134+
navbarLeftDefault p = maybe [] (const [HH.li [css "nav-item active"] [
135+
HH.a [css "nav-link", href Home] [HH.text "Home"]]]) p.userInfo
136+
120137
-- |The left navigation bar
121138
navbarLeft∷forall p . State -> HH.HTML p Action
122139
navbarLeft state = HH.div [css "collapse navbar-collapse", HP.id_ "navbarCollapse"]
123140
[HH.ul [css "navbar-nav mr-auto"] ([] <>
124-
maybe [] (\_->[HH.li [css "nav-item active"] [HH.a [css "nav-link", href Home] [HH.text "Map"]]]) state.userInfo
125-
-- , HH.li [css "nav-item"] [HH.a [css "nav-link", href (Point "0000000000000001" false)] [HH.text "Add POI"]]
126-
<> [])
141+
(navbarLeftDefault state)
142+
<> (navbarLeftAdmin state))
127143
]
128144

129145
-- |The right navigation bar
@@ -151,7 +167,8 @@ view ∷ ∀ r m. MonadAff m
151167
⇒ MonadAsk r m
152168
⇒ Page → H.ComponentHTML Action ChildSlots m
153169
view Login = HH.slot _login unit Login.component unit (Just <<< loginMessageConv)
154-
view Home = HH.slot _mapadmin unit MapAdmin.component unit (Just <<< mapadminMessageConv)
170+
view MapAdmin = HH.slot _mapadmin unit MapAdmin.component unit (Just <<< mapadminMessageConv)
171+
view Home = HH.slot _mapnearby unit MapNearby.component unit (Just <<< mapnearbyMessageConv)
155172
view (Point k true) = HH.slot _point unit Point.component (Point.ViewPOI k) (Just <<< pointMessageConv)
156173
view (Point k false) = HH.slot _point unit Point.component (Point.UpdatePOI k) (Just <<< pointMessageConv)
157174
view (AddPoint la lo) = HH.slot _point unit Point.component (Point.AddPOI la lo) (Just <<< pointMessageConv)
@@ -181,6 +198,11 @@ mapadminMessageConv::MapAdmin.Output->Action
181198
mapadminMessageConv MapAdmin.AuthenticationError = AuthenticationError
182199
mapadminMessageConv (MapAdmin.Alert s) = Alert s
183200

201+
-- |Converts mapamin messages to root actions
202+
mapnearbyMessageConv::MapNearby.Output->Action
203+
mapnearbyMessageConv MapNearby.AuthenticationError = AuthenticationError
204+
mapnearbyMessageConv (MapNearby.Alert s) = Alert s
205+
184206
-- |Converts point messages to root actions
185207
pointMessageConv::Point.Output->Action
186208
pointMessageConv Point.Submitted = PointSubmitted

0 commit comments

Comments
 (0)