google-maps-geocoding-0.7.0.1: Bindings to the Google Geocoding API (formerly Maps Geocoding API)
Copyright(c) Mike Pilgrem 2017 2018
Maintainerpublic@pilgrem.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

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

Functions

geocode :: Manager -> Key -> Maybe Address -> Maybe [FilterComponent] -> Maybe Viewport -> Maybe Language -> Maybe Region -> IO (Either ClientError 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 ClientError 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

Types

newtype Key #

API key

Constructors

Key Text 

Instances

Instances details
Eq Key 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: Key -> Key -> Bool #

(/=) :: Key -> Key -> Bool #

Show Key 
Instance details

Defined in Web.Google.Maps.Common

Methods

showsPrec :: Int -> Key -> ShowS #

show :: Key -> String #

showList :: [Key] -> ShowS #

ToHttpApiData Key 
Instance details

Defined in Web.Google.Maps.Common

newtype Address #

Address

Constructors

Address Text 

Instances

Instances details
Eq Address 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: Address -> Address -> Bool #

(/=) :: Address -> Address -> Bool #

Show Address 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData Address 
Instance details

Defined in Web.Google.Maps.Common

data Viewport Source #

Viewport

Constructors

Viewport 

Instances

Instances details
Eq Viewport Source # 
Instance details

Defined in Web.Google.Geocoding

Show Viewport Source # 
Instance details

Defined in Web.Google.Geocoding

Generic Viewport Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep Viewport :: Type -> Type #

Methods

from :: Viewport -> Rep Viewport x #

to :: Rep Viewport x -> Viewport #

FromJSON Viewport Source # 
Instance details

Defined in Web.Google.Geocoding

ToHttpApiData Viewport Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep Viewport Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep Viewport = D1 ('MetaData "Viewport" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" 'False) (C1 ('MetaCons "Viewport" 'PrefixI 'True) (S1 ('MetaSel ('Just "southwest") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LatLng) :*: S1 ('MetaSel ('Just "northeast") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LatLng)))

data Language #

Language: supported languages based on the list at https://developers.google.com/maps/faq#languagesupport (as at 20 March 2022).

Constructors

Afrikaans

Since: google-static-maps-0.7.0.0

Albanian 
Amharic

Since: google-static-maps-0.7.0.0

Arabic 
Armenian

Since: google-static-maps-0.7.0.0

Azerbaijani

Since: google-static-maps-0.7.0.0

Basque 
Belarusian 
Bengali 
Bosnian

Since: google-static-maps-0.7.0.0

Bulgarian 
Burmese 
Catalan 
Chinese

Since: google-static-maps-0.7.0.0

ChineseSimplified 
ChineseHongKong

Since: google-static-maps-0.7.0.0

ChineseTraditional 
Croatian 
Czech 
Danish 
Dutch 
English 
EnglishAustralian 
EnglishBritish 
Estonian

Since: google-static-maps-0.7.0.0

Farsi 
Filipino 
Finnish 
French 
FrenchCanadian

Since: google-static-maps-0.7.0.0

Galician 
Georgian

Since: google-static-maps-0.7.0.0

German 
Greek 
Gujarati 
Hebrew 
Hindi 
Icelandic

Since: google-static-maps-0.7.0.0

Hungarian 
Indonesian 
Italian 
Japanese 
Kannada 
Kazakh 
Khmer

Since: google-static-maps-0.7.0.0

Korean 
Kyrgyz 
Lao

Since: google-static-maps-0.7.0.0

Latvian 
Lithuanian 
Macedonian 
Malay

Since: google-static-maps-0.7.0.0

Malayalam 
Marathi 
Mongolian

Since: google-static-maps-0.7.0.0

Nepali

Since: google-static-maps-0.7.0.0

Norwegian 
Polish 
Portuguese 
PortugueseBrazil 
PortuguesePortugal 
Punjabi 
Romanian 
Russian 
Serbian 
Sinhalese

Since: google-static-maps-0.7.0.0

Slovak 
Slovenian 
Spanish 
SpanishLatinAmerican

Since: google-static-maps-0.7.0.0

Swahili

Since: google-static-maps-0.7.0.0

Swedish 
Tagalog

No longer listed by Google at 12 June 2021. See Filipino.

Tamil 
Telugu 
Thai 
Turkish 
Ukrainian 
Urdu

Since: google-static-maps-0.7.0.0

Uzbek 
Vietnamese 
Zulu

Since: google-static-maps-0.7.0.0

Instances

Instances details
Eq Language 
Instance details

Defined in Web.Google.Maps.Common

Show Language 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData Language 
Instance details

Defined in Web.Google.Maps.Common

data Region #

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

Instances details
Eq Region 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: Region -> Region -> Bool #

(/=) :: Region -> Region -> Bool #

Show Region 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData Region 
Instance details

Defined in Web.Google.Maps.Common

data GeocodingResponse Source #

Geocoding Reponse

Instances

Instances details
Eq GeocodingResponse Source # 
Instance details

Defined in Web.Google.Geocoding

Show GeocodingResponse Source # 
Instance details

Defined in Web.Google.Geocoding

Generic GeocodingResponse Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep GeocodingResponse :: Type -> Type #

FromJSON GeocodingResponse Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep GeocodingResponse Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep GeocodingResponse = D1 ('MetaData "GeocodingResponse" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" 'False) (C1 ('MetaCons "GeocodingResponse" 'PrefixI 'True) (S1 ('MetaSel ('Just "status") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Status) :*: (S1 ('MetaSel ('Just "error_message") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "results") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Result]))))

data Status Source #

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 

Instances

Instances details
Eq Status Source # 
Instance details

Defined in Web.Google.Geocoding

Methods

(==) :: Status -> Status -> Bool #

(/=) :: Status -> Status -> Bool #

Show Status Source # 
Instance details

Defined in Web.Google.Geocoding

FromJSON Status Source # 
Instance details

Defined in Web.Google.Geocoding

data Result Source #

A result of the geocoder.

Instances

Instances details
Eq Result Source # 
Instance details

Defined in Web.Google.Geocoding

Methods

(==) :: Result -> Result -> Bool #

(/=) :: Result -> Result -> Bool #

Show Result Source # 
Instance details

Defined in Web.Google.Geocoding

Generic Result Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep Result :: Type -> Type #

Methods

from :: Result -> Rep Result x #

to :: Rep Result x -> Result #

FromJSON Result Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep Result Source # 
Instance details

Defined in Web.Google.Geocoding

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

Instances details
Eq AddressType Source # 
Instance details

Defined in Web.Google.Geocoding

Show AddressType Source # 
Instance details

Defined in Web.Google.Geocoding

Generic AddressType Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep AddressType :: Type -> Type #

FromJSON AddressType Source # 
Instance details

Defined in Web.Google.Geocoding

ToHttpApiData AddressType Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep AddressType Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep AddressType = D1 ('MetaData "AddressType" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" 'True) (C1 ('MetaCons "AddressType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data AddressComponent Source #

Address component

Instances

Instances details
Eq AddressComponent Source # 
Instance details

Defined in Web.Google.Geocoding

Show AddressComponent Source # 
Instance details

Defined in Web.Google.Geocoding

Generic AddressComponent Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep AddressComponent :: Type -> Type #

FromJSON AddressComponent Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep AddressComponent Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep AddressComponent = D1 ('MetaData "AddressComponent" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" 'False) (C1 ('MetaCons "AddressComponent" 'PrefixI 'True) (S1 ('MetaSel ('Just "address_component_types") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AddressType]) :*: (S1 ('MetaSel ('Just "long_name") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "short_name") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))))

newtype PostcodeLocality Source #

Postcode locality: a locality contained in a postal code.

Constructors

PostcodeLocality Text 

Instances

Instances details
Eq PostcodeLocality Source # 
Instance details

Defined in Web.Google.Geocoding

Show PostcodeLocality Source # 
Instance details

Defined in Web.Google.Geocoding

Generic PostcodeLocality Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep PostcodeLocality :: Type -> Type #

FromJSON PostcodeLocality Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep PostcodeLocality Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep PostcodeLocality = D1 ('MetaData "PostcodeLocality" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" 'True) (C1 ('MetaCons "PostcodeLocality" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data Geometry Source #

Geometry

Instances

Instances details
Eq Geometry Source # 
Instance details

Defined in Web.Google.Geocoding

Show Geometry Source # 
Instance details

Defined in Web.Google.Geocoding

Generic Geometry Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep Geometry :: Type -> Type #

Methods

from :: Geometry -> Rep Geometry x #

to :: Rep Geometry x -> Geometry #

FromJSON Geometry Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep Geometry Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep Geometry = D1 ('MetaData "Geometry" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" '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)))))

data LatLng #

Latitude and longitude: precision beyond 6 decimal places is ignored.

Constructors

LatLng 

Fields

  • lat :: Double

    Takes any value between -90 and 90.

  • lng :: Double

    Takes any value between -180 and 180.

Instances

Instances details
Eq LatLng 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: LatLng -> LatLng -> Bool #

(/=) :: LatLng -> LatLng -> Bool #

Show LatLng 
Instance details

Defined in Web.Google.Maps.Common

Generic LatLng 
Instance details

Defined in Web.Google.Maps.Common

Associated Types

type Rep LatLng :: Type -> Type #

Methods

from :: LatLng -> Rep LatLng x #

to :: Rep LatLng x -> LatLng #

FromJSON LatLng 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData LatLng 
Instance details

Defined in Web.Google.Maps.Common

type Rep LatLng 
Instance details

Defined in Web.Google.Maps.Common

type Rep LatLng = D1 ('MetaData "LatLng" "Web.Google.Maps.Common" "google-static-maps-0.7.0.1-GWY4hm1MPquHe3YiI2aYKo" 'False) (C1 ('MetaCons "LatLng" 'PrefixI 'True) (S1 ('MetaSel ('Just "lat") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double) :*: S1 ('MetaSel ('Just "lng") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)))

newtype PlaceId Source #

Place id

Constructors

PlaceId Text 

Instances

Instances details
Eq PlaceId Source # 
Instance details

Defined in Web.Google.Geocoding

Methods

(==) :: PlaceId -> PlaceId -> Bool #

(/=) :: PlaceId -> PlaceId -> Bool #

Show PlaceId Source # 
Instance details

Defined in Web.Google.Geocoding

Generic PlaceId Source # 
Instance details

Defined in Web.Google.Geocoding

Associated Types

type Rep PlaceId :: Type -> Type #

Methods

from :: PlaceId -> Rep PlaceId x #

to :: Rep PlaceId x -> PlaceId #

FromJSON PlaceId Source # 
Instance details

Defined in Web.Google.Geocoding

ToHttpApiData PlaceId Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep PlaceId Source # 
Instance details

Defined in Web.Google.Geocoding

type Rep PlaceId = D1 ('MetaData "PlaceId" "Web.Google.Geocoding" "google-maps-geocoding-0.7.0.1-Ey2EE0RuaS1USPb0g6hX9" 'True) (C1 ('MetaCons "PlaceId" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data Location #

Location

Constructors

Coords LatLng 
Locale Address