Skip to content

Geolocation #4

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
FabienTregan wants to merge 6 commits into
base: dev
Choose a base branch
from
Open

Geolocation #4

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
287f609
Merge pull request #2 from devfriendlyplaces/dev
May 28, 2017
a51eda9
Adds geolocation.
FabienTregan May 28, 2017
566a1d4
Merge remote-tracking branch 'upstream/master' into dev
FabienTregan May 28, 2017
b3feb5d
Adds geolocation.
FabienTregan May 28, 2017
3716b64
Changes displayed URL when selected town is changed via geolocation.
FabienTregan May 28, 2017
f2b0e74
Uses real formula for distance calculation.
FabienTregan Jun 5, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
124 changes: 118 additions & 6 deletions Devfriendly.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -27,6 +29,7 @@ type alias Model =
, places : List Place
, selectedTown : TownSlug
, visitedTowns : List TownSlug
, userPosition : Maybe Coordinates
}


Expand All @@ -43,6 +46,84 @@ 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 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
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

Expand All @@ -52,6 +133,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 )
Expand All @@ -68,7 +151,7 @@ update msg model =
case town of
Just town ->
( { model | selectedTown = townSlug }
, Cmd.batch (cmdsDisplayTown town model.visitedTowns)
, cmdsDisplayTown town model.visitedTowns
)

Nothing ->
Expand Down Expand Up @@ -127,6 +210,31 @@ 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) ->
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
]
)



-- VIEW
Expand All @@ -149,7 +257,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
Expand All @@ -175,7 +286,7 @@ loadPlaces url =
|> Http.send GetPlaces


cmdsDisplayTown : Town -> List TownSlug -> List (Cmd Msg)
cmdsDisplayTown : Town -> List TownSlug -> Cmd Msg
cmdsDisplayTown town visitedTowns =
let
townSlug =
Expand All @@ -186,10 +297,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



Expand Down Expand Up @@ -326,8 +437,9 @@ main =
, places = []
, selectedTown = townSlug
, visitedTowns = []
, userPosition = Nothing
}
, Cmd.batch [ loadTowns townsUrl ]
, loadTowns townsUrl
)
in
Navigation.program UrlChange
Expand Down
9 changes: 8 additions & 1 deletion devfriendly.css
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
1 change: 1 addition & 0 deletions elm-package.json
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
45 changes: 45 additions & 0 deletions images/geolocate.svg
View file
Open in desktop
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.