From a51eda9f0edffa34b63b5498aaa3f555d64c565b Mon Sep 17 00:00:00 2001 From: Fabien Tregan Date: Sun, 28 May 2017 23:35:25 +0200 Subject: [PATCH 1/4] Adds geolocation. --- Devfriendly.elm | 96 +++++++++++++++++++++++++++++++++++++++++--- devfriendly.css | 9 ++++- elm-package.json | 1 + images/geolocate.svg | 45 +++++++++++++++++++++ 4 files changed, 144 insertions(+), 7 deletions(-) create mode 100644 images/geolocate.svg diff --git a/Devfriendly.elm b/Devfriendly.elm index 90945d1..a801417 100644 --- a/Devfriendly.elm +++ b/Devfriendly.elm @@ -7,6 +7,8 @@ import Json.Decode as Decode exposing (Decoder, field, list) import Json.Decode.Pipeline as Pipe exposing (decode, required, optional, optionalAt) import Http import Navigation +import Geolocation exposing (Location) +import Task exposing (attempt) -- PORTS @@ -27,6 +29,7 @@ type alias Model = , places : List Place , selectedTown : TownSlug , visitedTowns : List TownSlug + , userPosition : Maybe Coordinates } @@ -43,6 +46,57 @@ type alias Place = } +type alias Positionned a = + { a + | latitude : Float + , longitude : Float + } + + +type alias Coordinates = + { latitude : Float + , longitude : Float + } + + +distance : Positionned a -> Positionned b -> Float +distance a b = + sqrt ((a.longitude - b.longitude) ^ 2 + (a.latitude - b.latitude) ^ 2) + + +lower : (a -> comparable) -> a -> a -> a +lower evaluate a b = + if ((evaluate a) <= evaluate b) then + a + else + b + + +bestOf : (a -> a -> a) -> List a -> Maybe a +bestOf better values = + case values of + [] -> + Nothing + + head :: [] -> + Just head + + head :: tail -> + Just + (List.foldr + better + head + tail + ) + + +closerTown : Positionned a -> List Town -> Maybe Town +closerTown position towns = + bestOf + (lower (distance position)) + towns + + -- UPDATE @@ -52,6 +106,8 @@ type Msg | GetTowns (Result Http.Error (List Town)) | GetPlaces (Result Http.Error (List Place)) | UrlChange Navigation.Location + | AttemptGeolocate + | Geolocate (Result Geolocation.Error Location) update : Msg -> Model -> ( Model, Cmd Msg ) @@ -68,7 +124,7 @@ update msg model = case town of Just town -> ( { model | selectedTown = townSlug } - , Cmd.batch (cmdsDisplayTown town model.visitedTowns) + , cmdsDisplayTown town model.visitedTowns ) Nothing -> @@ -127,6 +183,30 @@ update msg model = in ( { model | places = [] }, Cmd.none ) + AttemptGeolocate -> + ( model, (attempt Geolocate Geolocation.now) ) + + Geolocate (Err err) -> + let + _ = + Debug.log "error geolocating" err + in + ( model, Cmd.none ) + + Geolocate (Ok position) -> + let + foundTown = + Debug.log + "Closer town found on Geolocate" + (closerTown position model.towns) + in + case foundTown of + Nothing -> + ( model, Cmd.none ) + + Just town -> + ( { model | selectedTown = slugifyTownName town.name }, cmdsDisplayTown town model.visitedTowns ) + -- VIEW @@ -149,7 +229,10 @@ viewMenu model = ) (List.sortBy .name model.towns) in - select [ id "towns", onChange TownOnChange ] townsOption + span [ class "townsSelector" ] + [ select [ id "towns", onChange TownOnChange ] townsOption + , img [ src "images/geolocate.svg", onClick AttemptGeolocate, height 18, alt "Geolocate" ] [] + ] view : Model -> Html Msg @@ -175,7 +258,7 @@ loadPlaces url = |> Http.send GetPlaces -cmdsDisplayTown : Town -> List TownSlug -> List (Cmd Msg) +cmdsDisplayTown : Town -> List TownSlug -> Cmd Msg cmdsDisplayTown town visitedTowns = let townSlug = @@ -186,10 +269,10 @@ cmdsDisplayTown town visitedTowns = in case isVisited of False -> - [ moveMap town, loadPlaces (placesUrlFor townSlug) ] + Cmd.batch [ moveMap town, loadPlaces (placesUrlFor townSlug) ] True -> - [ moveMap town ] + moveMap town @@ -326,8 +409,9 @@ main = , places = [] , selectedTown = townSlug , visitedTowns = [] + , userPosition = Nothing } - , Cmd.batch [ loadTowns townsUrl ] + , loadTowns townsUrl ) in Navigation.program UrlChange diff --git a/devfriendly.css b/devfriendly.css index 3ea9d01..fe24bb1 100644 --- a/devfriendly.css +++ b/devfriendly.css @@ -11,10 +11,17 @@ div#map { z-index: 1; } -select#towns { +.townsSelector { position: absolute; top: 8em; z-index: 2; +} + +.townsSelector * { + vertical-align: middle; +} + +select#towns { padding: 0; margin-left: 10px; background-color: white; diff --git a/elm-package.json b/elm-package.json index 9b4febf..13ffb40 100644 --- a/elm-package.json +++ b/elm-package.json @@ -10,6 +10,7 @@ "dependencies": { "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/geolocation": "1.0.2 <= v < 2.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", "elm-lang/http": "1.0.0 <= v < 2.0.0", "elm-lang/navigation": "2.1.0 <= v < 3.0.0", diff --git a/images/geolocate.svg b/images/geolocate.svg new file mode 100644 index 0000000..03d8427 --- /dev/null +++ b/images/geolocate.svg @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From b3feb5dc5c8287b242db2deaa56ff3d22b91dd88 Mon Sep 17 00:00:00 2001 From: Fabien Tregan Date: Sun, 28 May 2017 23:44:35 +0200 Subject: [PATCH 2/4] Adds geolocation. From 3716b64bd88137c05a8dbce946b1941da61e4abf Mon Sep 17 00:00:00 2001 From: Fabien Tregan Date: Mon, 29 May 2017 00:00:20 +0200 Subject: [PATCH 3/4] Changes displayed URL when selected town is changed via geolocation. --- Devfriendly.elm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Devfriendly.elm b/Devfriendly.elm index a801417..02ac86c 100644 --- a/Devfriendly.elm +++ b/Devfriendly.elm @@ -199,13 +199,21 @@ update msg model = Debug.log "Closer town found on Geolocate" (closerTown position model.towns) + + hash town = + "#" ++ slugifyTownName town.name in case foundTown of Nothing -> ( model, Cmd.none ) Just town -> - ( { model | selectedTown = slugifyTownName town.name }, cmdsDisplayTown town model.visitedTowns ) + ( { model | selectedTown = slugifyTownName town.name } + , Cmd.batch + [ cmdsDisplayTown town model.visitedTowns + , Navigation.newUrl (hash town) + ] + ) From f2b0e7482e72822182102c6153948c09b54c46d3 Mon Sep 17 00:00:00 2001 From: Fabien Tregan Date: Mon, 5 Jun 2017 17:00:31 +0200 Subject: [PATCH 4/4] Uses real formula for distance calculation. --- Devfriendly.elm | 64 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 42 insertions(+), 22 deletions(-) diff --git a/Devfriendly.elm b/Devfriendly.elm index 02ac86c..bdf50a4 100644 --- a/Devfriendly.elm +++ b/Devfriendly.elm @@ -60,8 +60,35 @@ type alias Coordinates = distance : Positionned a -> Positionned b -> Float -distance a b = - sqrt ((a.longitude - b.longitude) ^ 2 + (a.latitude - b.latitude) ^ 2) +distance p1 p2 = + let + r = + 6.371e6 + + lat1 = + degrees p1.latitude + + lat2 = + degrees p2.latitude + + deltaLat = + lat2 - lat1 + + deltaLong = + degrees (p2.longitude - p1.longitude) + + a = + sin (deltaLat / 2) + * sin (deltaLat / 2) + + cos lat1 + * cos lat2 + * sin (deltaLong / 2) + * sin (deltaLong / 2) + + c = + 2 * (atan2 (sqrt a) (sqrt (1 - a))) + in + r * c lower : (a -> comparable) -> a -> a -> a @@ -194,26 +221,19 @@ update msg model = ( model, Cmd.none ) Geolocate (Ok position) -> - let - foundTown = - Debug.log - "Closer town found on Geolocate" - (closerTown position model.towns) - - hash town = - "#" ++ slugifyTownName town.name - in - case foundTown of - Nothing -> - ( model, Cmd.none ) - - Just town -> - ( { model | selectedTown = slugifyTownName town.name } - , Cmd.batch - [ cmdsDisplayTown town model.visitedTowns - , Navigation.newUrl (hash town) - ] - ) + case (closerTown position model.towns) of + Nothing -> + ( model, Cmd.none ) + + Just town -> + ( { model | selectedTown = slugifyTownName town.name } + , Cmd.batch + [ cmdsDisplayTown town model.visitedTowns + , slugifyTownName town.name + |> String.append "#" + |> Navigation.newUrl + ] + )