| Copyright | (c) Mike Pilgrem 2017 |
|---|---|
| Maintainer | public@pilgrem.com |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Web.Google.Maps.Geocoding
Description
This package has no connection with Google Inc. or its affiliates.
The Google Maps Geocoding API provides a direct way to access geocoding and reverse geocoding services via an HTTP request. This library provides bindings in Haskell to that API.
NB: The use of the Google Maps Geocoding API services is subject to the Google Maps APIs Terms of Service, which terms restrict the use of content (eg no use without a Google map).
The code below is an example console application to test privately the use of the library with the Google Maps Geocoding API.
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Maybe (fromJust)
import Data.Text (Text)
import Data.Text.IO as T (getLine, putStr)
import Graphics.Gloss (Display (..), display, white)
import Graphics.Gloss.Juicy (fromDynamicImage)
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Web.Google.Maps.Geocoding (Address (..), geocode, GeocodingResponse (..),
Geometry (..), Key (..), LatLng (..), Result (..), Status (..))
import Web.Google.Static.Maps (Center (..), Location (..), Size (..),
staticmap, Zoom (..))
import System.IO (hFlush, stdout)
main :: IO ()
main = do
putStrLn "A test of the Google Maps Geocoding API.\nNB: The use of the \
\API services is subject to the Google Maps APIs Terms of Serivce at \
\https://developers.google.com/maps/terms.\n"
txt <- input "Enter full address: "
mgr <- newManager tlsManagerSettings
let apiKey = Key "<REPLACE_THIS_WITH_YOUR_ACTUAL_GOOGLE_API_KEY>"
result <- geocode mgr apiKey (Just $ Address txt) Nothing Nothing
Nothing Nothing
case result of
Right response -> do
let s = status response
case s of
OK -> do
let latlng = location $ geometry $ head $ results
response
center = Center $ Coord latlng
print center
displayMap mgr apiKey center
_ -> putStrLn $ "Error! Status: " ++ show s
_ -> putStrLn $ "Error! Result:\n" ++ show result
input :: Text -> IO Text
input msg = T.putStr msg >> hFlush stdout >> T.getLine
displayMap :: Manager -> Key -> Center -> IO ()
displayMap mgr apiKey center = do
let zoom = Just $ Zoom 17
w = 400
h = 400
size = Size w h
result <- staticmap mgr apiKey Nothing (Just center) zoom size Nothing
Nothing [] Nothing [] [] Nothing
case result of
Right response -> do
let picture = fromJust $ fromDynamicImage response
title = "Test Google Maps Geocoding API"
window = InWindow title (w, h) (10, 10)
display window white picture
Left err -> putStrLn $ "Error while displaying map: " ++ show err- geocode :: Manager -> Key -> Maybe Address -> Maybe [FilterComponent] -> Maybe Viewport -> Maybe Language -> Maybe Region -> IO (Either ServantError GeocodingResponse)
- backGeocode :: Manager -> Key -> Maybe LatLng -> Maybe PlaceId -> Maybe AddressType -> Maybe LocationType -> Maybe Language -> IO (Either ServantError GeocodingResponse)
- type GoogleMapsGeocodingAPI = ("geocode" :> ("json" :> (QueryParam "key" Key :> (QueryParam "address" Address :> (QueryParam "components" [FilterComponent] :> (QueryParam "bounds" Viewport :> (QueryParam "language" Language :> (QueryParam "region" Region :> Get '[JSON] GeocodingResponse)))))))) :<|> ("geocode" :> ("json" :> (QueryParam "key" Key :> (QueryParam "latlng" LatLng :> (QueryParam "place_id" PlaceId :> (QueryParam "result_type" AddressType :> (QueryParam "location_type" LocationType :> (QueryParam "language" Language :> Get '[JSON] GeocodingResponse))))))))
- api :: Proxy GoogleMapsGeocodingAPI
- newtype Key :: * = Key Text
- newtype Address :: * = Address Text
- data FilterComponent
- data Viewport = Viewport {}
- data Language :: *
- = Arabic
- | Basque
- | Bengali
- | Bulgarian
- | Catalan
- | ChineseSimplified
- | ChineseTraditional
- | Croatian
- | Czech
- | Danish
- | Dutch
- | German
- | Greek
- | English
- | EnglishAustralian
- | EnglishBritish
- | Farsi
- | Filipino
- | Finnish
- | French
- | Galician
- | Gujarati
- | Hebrew
- | Hindi
- | Hungarian
- | Indonesian
- | Italian
- | Japanese
- | Kannada
- | Korean
- | Latvian
- | Lithuanian
- | Malayalam
- | Marathi
- | Norwegian
- | Polish
- | Portuguese
- | PortugueseBrazil
- | PortuguesePortugal
- | Romanian
- | Russian
- | Serbian
- | Slovak
- | Slovenian
- | Spanish
- | Swedish
- | Tagalog
- | Tamil
- | Telugu
- | Thai
- | Turkish
- | Ukrainian
- | Vietnamese
- data Region :: *
- = AD
- | AE
- | AF
- | AG
- | AI
- | AL
- | AM
- | AO
- | AQ
- | AR
- | AS
- | AT
- | AU
- | AW
- | AX
- | AZ
- | BA
- | BB
- | BD
- | BE
- | BF
- | BG
- | BH
- | BI
- | BJ
- | BL
- | BM
- | BN
- | BO
- | BQ
- | BR
- | BS
- | BT
- | BV
- | BW
- | BY
- | BZ
- | CA
- | CC
- | CD
- | CF
- | CG
- | CH
- | CI
- | CK
- | CL
- | CM
- | CN
- | CO
- | CR
- | CU
- | CV
- | CW
- | CX
- | CY
- | CZ
- | DE
- | DJ
- | DK
- | DM
- | DO
- | DZ
- | EC
- | EE
- | EG
- | EH
- | ER
- | ES
- | ET
- | FI
- | FJ
- | FK
- | FM
- | FO
- | FR
- | GA
- | GB
- | GD
- | GE
- | GF
- | GG
- | GH
- | GI
- | GL
- | GM
- | GN
- | GP
- | GQ
- | GR
- | GS
- | GT
- | GU
- | GW
- | GY
- | HK
- | HM
- | HN
- | HR
- | HT
- | HU
- | ID
- | IE
- | IL
- | IM
- | IN
- | IO
- | IQ
- | IR
- | IS
- | IT
- | JE
- | JM
- | JO
- | JP
- | KE
- | KG
- | KH
- | KI
- | KM
- | KN
- | KP
- | KR
- | KW
- | KY
- | KZ
- | LA
- | LB
- | LC
- | LI
- | LK
- | LR
- | LS
- | LT
- | LU
- | LV
- | LY
- | MA
- | MC
- | MD
- | ME
- | MF
- | MG
- | MH
- | MK
- | ML
- | MM
- | MN
- | MO
- | MP
- | MQ
- | MR
- | MS
- | MT
- | MU
- | MV
- | MW
- | MX
- | MY
- | MZ
- | NA
- | NC
- | NE
- | NF
- | NG
- | NI
- | NL
- | NO
- | NP
- | NR
- | NU
- | NZ
- | OM
- | PA
- | PE
- | PF
- | PG
- | PH
- | PK
- | PL
- | PM
- | PN
- | PR
- | PS
- | PT
- | PW
- | PY
- | QA
- | RE
- | RO
- | RS
- | RU
- | RW
- | SA
- | SB
- | SC
- | SD
- | SE
- | SG
- | SH
- | SI
- | SJ
- | SK
- | SL
- | SM
- | SN
- | SO
- | SR
- | SS
- | ST
- | SV
- | SX
- | SY
- | SZ
- | TC
- | TD
- | TF
- | TG
- | TH
- | TJ
- | TK
- | TL
- | TM
- | TN
- | TO
- | TR
- | TT
- | TV
- | TW
- | TZ
- | UA
- | UG
- | UM
- | US
- | UY
- | UZ
- | VA
- | VC
- | VE
- | VG
- | VI
- | VN
- | VU
- | WF
- | WS
- | YE
- | YT
- | ZA
- | ZM
- | ZW
- | AC
- | UK
- | EU
- data GeocodingResponse = GeocodingResponse {}
- data Status
- data Result = Result {}
- newtype AddressType = AddressType Text
- data AddressComponent = AddressComponent {}
- newtype PostcodeLocality = PostcodeLocality Text
- data Geometry = Geometry {}
- data LatLng :: * = LatLng {}
- newtype PlaceId = PlaceId Text
- data Location :: *
- data LocationType
Functions
geocode :: Manager -> Key -> Maybe Address -> Maybe [FilterComponent] -> Maybe Viewport -> Maybe Language -> Maybe Region -> IO (Either ServantError GeocodingResponse) Source #
Geocode. NB: The use of the Google Maps Geocoding API services is subject to the Google Maps APIs Terms of Service.
backGeocode :: Manager -> Key -> Maybe LatLng -> Maybe PlaceId -> Maybe AddressType -> Maybe LocationType -> Maybe Language -> IO (Either ServantError GeocodingResponse) Source #
Reverse (back) geocode. NB: The use of the Google Maps Geocoding API services is subject to the Google Maps APIs Terms of Service.
API
type GoogleMapsGeocodingAPI = ("geocode" :> ("json" :> (QueryParam "key" Key :> (QueryParam "address" Address :> (QueryParam "components" [FilterComponent] :> (QueryParam "bounds" Viewport :> (QueryParam "language" Language :> (QueryParam "region" Region :> Get '[JSON] GeocodingResponse)))))))) :<|> ("geocode" :> ("json" :> (QueryParam "key" Key :> (QueryParam "latlng" LatLng :> (QueryParam "place_id" PlaceId :> (QueryParam "result_type" AddressType :> (QueryParam "location_type" LocationType :> (QueryParam "language" Language :> Get '[JSON] GeocodingResponse)))))))) Source #
Google Translate API
api :: Proxy GoogleMapsGeocodingAPI Source #
API type
Types
Address
data FilterComponent Source #
Fliter component: a component that can be used to filter the results returned in a geocoding response.
Constructors
| Route Text | |
| Locality Text | |
| AdministrativeArea Text | |
| PostalCode Text | |
| Country Region |
Viewport
Language: supported languages based on the list at https://developers.google.com/maps/faq#languagesupport (as at 13 March 2017).
Constructors
Region: a ccTLD (country code top level domain).
Constructors
| AD | |
| AE | |
| AF | |
| AG | |
| AI | |
| AL | |
| AM | |
| AO | |
| AQ | |
| AR | |
| AS | |
| AT | |
| AU | |
| AW | |
| AX | |
| AZ | |
| BA | |
| BB | |
| BD | |
| BE | |
| BF | |
| BG | |
| BH | |
| BI | |
| BJ | |
| BL | |
| BM | |
| BN | |
| BO | |
| BQ | |
| BR | |
| BS | |
| BT | |
| BV | |
| BW | |
| BY | |
| BZ | |
| CA | |
| CC | |
| CD | |
| CF | |
| CG | |
| CH | |
| CI | |
| CK | |
| CL | |
| CM | |
| CN | |
| CO | |
| CR | |
| CU | |
| CV | |
| CW | |
| CX | |
| CY | |
| CZ | |
| DE | |
| DJ | |
| DK | |
| DM | |
| DO | |
| DZ | |
| EC | |
| EE | |
| EG | |
| EH | |
| ER | |
| ES | |
| ET | |
| FI | |
| FJ | |
| FK | |
| FM | |
| FO | |
| FR | |
| GA | |
| GB | |
| GD | |
| GE | |
| GF | |
| GG | |
| GH | |
| GI | |
| GL | |
| GM | |
| GN | |
| GP | |
| GQ | |
| GR | |
| GS | |
| GT | |
| GU | |
| GW | |
| GY | |
| HK | |
| HM | |
| HN | |
| HR | |
| HT | |
| HU | |
| ID | |
| IE | |
| IL | |
| IM | |
| IN | |
| IO | |
| IQ | |
| IR | |
| IS | |
| IT | |
| JE | |
| JM | |
| JO | |
| JP | |
| KE | |
| KG | |
| KH | |
| KI | |
| KM | |
| KN | |
| KP | |
| KR | |
| KW | |
| KY | |
| KZ | |
| LA | |
| LB | |
| LC | |
| LI | |
| LK | |
| LR | |
| LS | |
| LT | |
| LU | |
| LV | |
| LY | |
| MA | |
| MC | |
| MD | |
| ME | |
| MF | |
| MG | |
| MH | |
| MK | |
| ML | |
| MM | |
| MN | |
| MO | |
| MP | |
| MQ | |
| MR | |
| MS | |
| MT | |
| MU | |
| MV | |
| MW | |
| MX | |
| MY | |
| MZ | |
| NA | |
| NC | |
| NE | |
| NF | |
| NG | |
| NI | |
| NL | |
| NO | |
| NP | |
| NR | |
| NU | |
| NZ | |
| OM | |
| PA | |
| PE | |
| PF | |
| PG | |
| PH | |
| PK | |
| PL | |
| PM | |
| PN | |
| PR | |
| PS | |
| PT | |
| PW | |
| PY | |
| QA | |
| RE | |
| RO | |
| RS | |
| RU | |
| RW | |
| SA | |
| SB | |
| SC | |
| SD | |
| SE | |
| SG | |
| SH | |
| SI | |
| SJ | |
| SK | |
| SL | |
| SM | |
| SN | |
| SO | |
| SR | |
| SS | |
| ST | |
| SV | |
| SX | |
| SY | |
| SZ | |
| TC | |
| TD | |
| TF | |
| TG | |
| TH | |
| TJ | |
| TK | |
| TL | |
| TM | |
| TN | |
| TO | |
| TR | |
| TT | |
| TV | |
| TW | |
| TZ | |
| UA | |
| UG | |
| UM | |
| US | |
| UY | |
| UZ | |
| VA | |
| VC | |
| VE | |
| VG | |
| VI | |
| VN | |
| VU | |
| WF | |
| WS | |
| YE | |
| YT | |
| ZA | |
| ZM | |
| ZW | |
| AC | |
| UK | |
| EU |
Contains the status of the request and may contain debugging information to help you track down why geocoding is not working.
Constructors
| OK | Indicates that no errors occurred; the address was successfully parsed and at least one geocode was returned. |
| ZeroResults | Indicates that the geocode was successful but returned no results. This may occur if the geocoder was passed a non-existent address. |
| OverQueryLimit | |
| RequestDenied | |
| InvalidRequest | Generally indicates that the query (address, components or latlng) is missing. |
| UnknownError |
A result of the geocoder.
Constructors
| Result | |
Fields
| |
newtype AddressType Source #
Address (and address component) type: The list of types provided by Google (as at 4 March 2017) is incomplete.
Constructors
| AddressType Text |
Instances
data AddressComponent Source #
Address component
Constructors
| AddressComponent | |
Fields
| |
newtype PostcodeLocality Source #
Postcode locality: a locality contained in a postal code.
Constructors
| PostcodeLocality Text |
Geometry
Constructors
| Geometry | |
Fields
| |
Latitude and longitude: precision beyond 6 decimal places is ignored.
Constructors
| LatLng | |
Place id
Location
Instances
data LocationType Source #
Location type
Constructors
| Rooftop | |
| RangeInterpolated | |
| GeometricCenter | |
| Approximate |