Copyright | (c) Mike Pilgrem 2017 2018 |
---|---|
Maintainer | public@pilgrem.com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Web.Google.Geocoding
Description
This package has no connection with Google Inc. or its affiliates.
The Google 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 Geocoding API services is subject to the Google Maps Platform Terms of Service, which terms restrict the use of content. End Users’ use of Google Maps is subject to the then-current Google Maps/Google Earth Additional Terms of Service at https://maps.google.com/help/terms_maps.html and Google Privacy Policy at https://www.google.com/policies/privacy/.
The code below is an example console application to test privately the use of the library with the Google 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.Geocoding (Address (..), geocode, GeocodingResponse (..), Geometry (..), Key (..), LatLng (..), Result (..), Status (..)) import Web.Google.Maps.Static (Center (..), Location (..), Size (..), staticmap, Zoom (..)) import System.IO (hFlush, stdout) main :: IO () main = do putStrLn $ "A test of the Google Geocoding API.\nNB: The use of " ++ "the API services is subject to the Google Maps Platform Terms of " ++ "Serivce at https://cloud.google.com/maps-platform/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 Geocoding API" window = InWindow title (w, h) (10, 10) display window white picture Left err -> putStrLn $ "Error while displaying map: " ++ show err
Synopsis
- 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 GoogleGeocodingAPI = ("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 GoogleGeocodingAPI
- newtype Key = Key Text
- newtype Address = Address Text
- data FilterComponent
- data Viewport = Viewport {}
- data Language
- = Albanian
- | Arabic
- | Basque
- | Belarusian
- | Bengali
- | Bulgarian
- | Burmese
- | 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
- | Kazakh
- | Korean
- | Kyrgyz
- | Latvian
- | Lithuanian
- | Macedonian
- | Malayalam
- | Marathi
- | Norwegian
- | Polish
- | Portuguese
- | PortugueseBrazil
- | PortuguesePortugal
- | Punjabi
- | Romanian
- | Russian
- | Serbian
- | Slovak
- | Slovenian
- | Spanish
- | Swedish
- | Tagalog
- | Tamil
- | Telugu
- | Thai
- | Turkish
- | Ukrainian
- | Uzbek
- | 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 Geocoding API services is subject to the Google Maps Platform Terms of Service. End Users’ use of Google Maps is subject to the then-current Google Maps/Google Earth Additional Terms of Service at https://maps.google.com/help/terms_maps.html and Google Privacy Policy at https://www.google.com/policies/privacy/.
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 Geocoding API services is subject to the Google Maps Platform Terms of Service. End Users’ use of Google Maps is subject to the then-current Google Maps/Google Earth Additional Terms of Service at https://maps.google.com/help/terms_maps.html and Google Privacy Policy at https://www.google.com/policies/privacy/.
API
type GoogleGeocodingAPI = ("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 Geocoding API
api :: Proxy GoogleGeocodingAPI Source #
API type
Types
API key
Instances
Eq Key | |
Show Key | |
ToHttpApiData Key | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: Key -> Text # toEncodedUrlPiece :: Key -> Builder # toHeader :: Key -> ByteString # toQueryParam :: Key -> Text # |
Address
Instances
Eq Address | |
Show Address | |
ToHttpApiData Address | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: Address -> Text # toEncodedUrlPiece :: Address -> Builder # toHeader :: Address -> ByteString # toQueryParam :: Address -> Text # |
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 |
Instances
Eq FilterComponent Source # | |
Defined in Web.Google.Geocoding Methods (==) :: FilterComponent -> FilterComponent -> Bool # (/=) :: FilterComponent -> FilterComponent -> Bool # | |
Show FilterComponent Source # | |
Defined in Web.Google.Geocoding Methods showsPrec :: Int -> FilterComponent -> ShowS # show :: FilterComponent -> String # showList :: [FilterComponent] -> ShowS # | |
ToHttpApiData FilterComponent Source # | |
Defined in Web.Google.Geocoding Methods toUrlPiece :: FilterComponent -> Text # toEncodedUrlPiece :: FilterComponent -> Builder # toHeader :: FilterComponent -> ByteString # toQueryParam :: FilterComponent -> Text # | |
ToHttpApiData [FilterComponent] Source # | |
Defined in Web.Google.Geocoding Methods toUrlPiece :: [FilterComponent] -> Text # toEncodedUrlPiece :: [FilterComponent] -> Builder # toHeader :: [FilterComponent] -> ByteString # toQueryParam :: [FilterComponent] -> Text # |
Viewport
Instances
Eq Viewport Source # | |
Show Viewport Source # | |
Generic Viewport Source # | |
FromJSON Viewport Source # | |
ToHttpApiData Viewport Source # | |
Defined in Web.Google.Geocoding Methods toUrlPiece :: Viewport -> Text # toEncodedUrlPiece :: Viewport -> Builder # toHeader :: Viewport -> ByteString # toQueryParam :: Viewport -> Text # | |
type Rep Viewport Source # | |
Defined in Web.Google.Geocoding type Rep Viewport = D1 (MetaData "Viewport" "Web.Google.Geocoding" "google-maps-geocoding-0.5.0.0-FrUejYAwWzf957qZA4diSr" False) (C1 (MetaCons "Viewport" PrefixI True) (S1 (MetaSel (Just "southwest") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 LatLng) :*: S1 (MetaSel (Just "northeast") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 LatLng))) |
Language: supported languages based on the list at https://developers.google.com/maps/faq#languagesupport (as at 29 December 2018).
Constructors
Instances
Eq Language | |
Show Language | |
ToHttpApiData Language | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: Language -> Text # toEncodedUrlPiece :: Language -> Builder # toHeader :: Language -> ByteString # toQueryParam :: Language -> Text # |
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 |
Instances
Eq Region | |
Show Region | |
ToHttpApiData Region | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: Region -> Text # toEncodedUrlPiece :: Region -> Builder # toHeader :: Region -> ByteString # toQueryParam :: Region -> Text # |
data GeocodingResponse Source #
Geocoding Reponse
Constructors
GeocodingResponse | |
Instances
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
|
Instances
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
Eq AddressType Source # | |
Defined in Web.Google.Geocoding | |
Show AddressType Source # | |
Defined in Web.Google.Geocoding Methods showsPrec :: Int -> AddressType -> ShowS # show :: AddressType -> String # showList :: [AddressType] -> ShowS # | |
Generic AddressType Source # | |
Defined in Web.Google.Geocoding Associated Types type Rep AddressType :: Type -> Type # | |
FromJSON AddressType Source # | |
Defined in Web.Google.Geocoding | |
ToHttpApiData AddressType Source # | |
Defined in Web.Google.Geocoding Methods toUrlPiece :: AddressType -> Text # toEncodedUrlPiece :: AddressType -> Builder # toHeader :: AddressType -> ByteString # toQueryParam :: AddressType -> Text # | |
type Rep AddressType Source # | |
Defined in Web.Google.Geocoding type Rep AddressType = D1 (MetaData "AddressType" "Web.Google.Geocoding" "google-maps-geocoding-0.5.0.0-FrUejYAwWzf957qZA4diSr" True) (C1 (MetaCons "AddressType" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text))) |
data AddressComponent Source #
Address component
Constructors
AddressComponent | |
Fields
|
Instances
newtype PostcodeLocality Source #
Postcode locality: a locality contained in a postal code.
Constructors
PostcodeLocality Text |
Instances
Geometry
Constructors
Geometry | |
Fields
|
Instances
Eq Geometry Source # | |
Show Geometry Source # | |
Generic Geometry Source # | |
FromJSON Geometry Source # | |
type Rep Geometry Source # | |
Defined in Web.Google.Geocoding type Rep Geometry = D1 (MetaData "Geometry" "Web.Google.Geocoding" "google-maps-geocoding-0.5.0.0-FrUejYAwWzf957qZA4diSr" False) (C1 (MetaCons "Geometry" PrefixI True) ((S1 (MetaSel (Just "location") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 LatLng) :*: S1 (MetaSel (Just "location_type") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 LocationType)) :*: (S1 (MetaSel (Just "viewport") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Viewport) :*: S1 (MetaSel (Just "bounds") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Viewport))))) |
Latitude and longitude: precision beyond 6 decimal places is ignored.
Constructors
LatLng | |
Instances
Eq LatLng | |
Show LatLng | |
Generic LatLng | |
FromJSON LatLng | |
ToHttpApiData LatLng | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: LatLng -> Text # toEncodedUrlPiece :: LatLng -> Builder # toHeader :: LatLng -> ByteString # toQueryParam :: LatLng -> Text # | |
type Rep LatLng | |
Defined in Web.Google.Maps.Common type Rep LatLng = D1 (MetaData "LatLng" "Web.Google.Maps.Common" "google-static-maps-0.6.0.0-3UHKR7MvECnDaEj7pHDv34" False) (C1 (MetaCons "LatLng" PrefixI True) (S1 (MetaSel (Just "lat") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Double) :*: S1 (MetaSel (Just "lng") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Double))) |
Place id
Instances
Eq PlaceId Source # | |
Show PlaceId Source # | |
Generic PlaceId Source # | |
FromJSON PlaceId Source # | |
ToHttpApiData PlaceId Source # | |
Defined in Web.Google.Geocoding Methods toUrlPiece :: PlaceId -> Text # toEncodedUrlPiece :: PlaceId -> Builder # toHeader :: PlaceId -> ByteString # toQueryParam :: PlaceId -> Text # | |
type Rep PlaceId Source # | |
Defined in Web.Google.Geocoding |
Location
Instances
Eq Location | |
Show Location | |
ToHttpApiData Location | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: Location -> Text # toEncodedUrlPiece :: Location -> Builder # toHeader :: Location -> ByteString # toQueryParam :: Location -> Text # | |
ToHttpApiData [Location] | |
Defined in Web.Google.Maps.Common Methods toUrlPiece :: [Location] -> Text # toEncodedUrlPiece :: [Location] -> Builder # toHeader :: [Location] -> ByteString # toQueryParam :: [Location] -> Text # |
data LocationType Source #
Location type
Constructors
Rooftop | |
RangeInterpolated | |
GeometricCenter | |
Approximate |
Instances
Eq LocationType Source # | |
Defined in Web.Google.Geocoding | |
Show LocationType Source # | |
Defined in Web.Google.Geocoding Methods showsPrec :: Int -> LocationType -> ShowS # show :: LocationType -> String # showList :: [LocationType] -> ShowS # | |
FromJSON LocationType Source # | |
Defined in Web.Google.Geocoding | |
ToHttpApiData LocationType Source # | |
Defined in Web.Google.Geocoding Methods toUrlPiece :: LocationType -> Text # toEncodedUrlPiece :: LocationType -> Builder # toHeader :: LocationType -> ByteString # toQueryParam :: LocationType -> Text # |