| Copyright | (c) Mike Pilgrem 2017 |
|---|---|
| Maintainer | public@pilgrem.com |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Web.Google.Maps.Geocoding
Description
The Google Maps Geocoding API provides a direct way to access geocoding and reverse geocoding services via an HTTP request.
The components and optional parameters in a geocoding request are not yet
implemented. The reverse geocoding request is not yet implemented.
Below is an example of use.
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Text (Text)
import Data.Text.IO as T (getLine, putStr)
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Web.Google.Maps.Geocoding (Address (..), geocode, GeocodingResponse (..),
Geometry (..), Key (..), Location (..), Result (..), Status (..))
import System.IO (hFlush, stdout)
main :: IO ()
main = do
txt <- input "Enter full address: "
mgr <- newManager tlsManagerSettings
let apiKey = Key "<GOOGLE_API_KEY>"
result <- geocode mgr apiKey (Address txt)
case result of
Right response -> do
let s = status response
case s of
OK -> print $ location $ geometry $ head $ results response
_ -> putStrLn $ "Error! Status: " ++ show s
_ -> putStrLn $ "Error! Result:\n" ++ show result
input :: Text -> IO Text
input msg = T.putStr msg >> hFlush stdout >> T.getLine- geocode :: Manager -> Key -> Address -> IO (Either ServantError GeocodingResponse)
- type GoogleMapsGeocodingAPI = "json" :> (QueryParam "key" Key :> (QueryParam "address" Address :> Get '[JSON] GeocodingResponse))
- api :: Proxy GoogleMapsGeocodingAPI
- newtype Key = Key Text
- newtype Address = Address Text
- data GeocodingResponse = GeocodingResponse {}
- data Status
- data Result = Result {}
- data AddressType = AddressType Text
- data AddressComponent = AddressComponent {}
- newtype PostcodeLocality = PostcodeLocality Text
- data Geometry = Geometry {}
- newtype PlaceId = PlaceId Text
- data Location = Location {}
- data LocationType
- data Viewport = Viewport {}
Functions
geocode :: Manager -> Key -> Address -> IO (Either ServantError GeocodingResponse) Source #
Geocode
API
type GoogleMapsGeocodingAPI = "json" :> (QueryParam "key" Key :> (QueryParam "address" Address :> Get '[JSON] GeocodingResponse)) Source #
Google Translate API
api :: Proxy GoogleMapsGeocodingAPI Source #
API type
Types
API key
Address
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
| |
data 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
| |
Place id
Location
data LocationType Source #
Location type
Constructors
| Rooftop | |
| RangeInterpolated | |
| GeometricCenter | |
| Approximate |
Instances