{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} -- | -- Module : Web.Google.Maps.Geocoding -- Description : Bindings to the Google Maps Geocoding API -- Copyright : (c) Mike Pilgrem 2017 -- Maintainer : public@pilgrem.com -- Stability : experimental -- -- This package has no connection with Google Inc. or its affiliates. -- -- The -- 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 -- , -- which terms restrict the use of content (eg no use without a Google map). -- -- The 'components' and optional parameters in a geocoding request are not yet -- implemented. The reverse geocoding request is not yet implemented. -- -- 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.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 -- > 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 ful address: " -- > mgr <- newManager tlsManagerSettings -- > let apiKey = Key "" -- > result <- geocode mgr apiKey (Address txt) -- > case result of -- > Right response -> do -- > let s = status response -- > case s of -- > OK -> do print $ location $ geometry $ head $ results response -- > putStrLn "Display the location by visiting \ -- > \maps.google.com on the web and entering the latitude \ -- > \and longitude." -- > _ -> putStrLn $ "Error! Status: " ++ show s -- > _ -> putStrLn $ "Error! Result:\n" ++ show result -- > -- > input :: Text -> IO Text -- > input msg = T.putStr msg >> hFlush stdout >> T.getLine module Web.Google.Maps.Geocoding ( -- * Functions geocode -- * API , GoogleMapsGeocodingAPI , api -- * Types , Key (..) , Address (..) , GeocodingResponse (..) , Status (..) , Result (..) , AddressType (..) , AddressComponent (..) , PostcodeLocality (..) , Geometry (..) , PlaceId (..) , Location (..) , LocationType (..) , Viewport (..) ) where import Data.Aeson hiding (Result) import Data.Aeson.Types (Options (..)) import Data.Foldable (asum) import Data.Proxy import Data.Text (Text) import qualified Data.Text as T (unpack) import GHC.Generics import Network.HTTP.Client (Manager) import Servant.API import Servant.Client -- | API key newtype Key = Key Text deriving (Eq, Show, ToHttpApiData) -- | Address newtype Address = Address Text deriving (Eq, Show, ToHttpApiData) -- | Geocoding Reponse data GeocodingResponse = GeocodingResponse { status :: Status , error_message :: Maybe Text , results :: [Result] } deriving (Eq, Show, Generic) instance FromJSON GeocodingResponse -- | Contains the status of the request and may contain debugging information to -- help you track down why geocoding is not working. data Status = 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 deriving (Eq, Show) instance FromJSON Status where parseJSON = withText "Status" $ \t -> case t of "OK" -> return OK "ZERO_RESULTS" -> return ZeroResults "OVER_QUERY_LIMIT" -> return OverQueryLimit "REQUEST_DENIED" -> return RequestDenied "INVALID_REQUEST" -> return InvalidRequest "UNKNOWN_ERROR" -> return UnknownError _ -> fail $ "Unrecognised status type, namely: " ++ T.unpack t -- | A result of the geocoder. data Result = Result { types :: [AddressType] , formatted_address :: Text , address_components :: [AddressComponent] , postcode_localities :: Maybe [PostcodeLocality] , geometry :: Geometry , partial_match :: Maybe Bool , place_id :: PlaceId } deriving (Eq, Show, Generic) instance FromJSON Result -- | Address (and address component) type: The list of types provided by Google -- (as at 4 March 2017) is incomplete. data AddressType = AddressType Text deriving (Eq, Show, Generic) instance FromJSON AddressType -- | Address component data AddressComponent = AddressComponent { address_component_types :: [AddressType] , long_name :: Text , short_name :: Text } deriving (Eq, Show, Generic) instance FromJSON AddressComponent where parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = \l -> case l of "address_component_types" -> "types" _ -> l } -- | Postcode locality: a locality contained in a postal code. newtype PostcodeLocality = PostcodeLocality Text deriving (Eq, Show, Generic) instance FromJSON PostcodeLocality -- | Geometry data Geometry = Geometry { location :: Location , location_type :: LocationType , viewport :: Viewport , bounds :: Maybe Viewport } deriving (Eq, Show, Generic) instance FromJSON Geometry -- | Location data Location = Location { lat :: Double , lng :: Double } deriving (Eq, Show, Generic) instance FromJSON Location -- | Location type data LocationType = Rooftop | RangeInterpolated | GeometricCenter | Approximate deriving (Eq, Show) instance FromJSON LocationType where parseJSON = withText "LocationType" $ \t -> case t of "ROOFTOP" -> return Rooftop "RANGE_INTERPOLATED" -> return RangeInterpolated "GEOMETRIC_CENTER" -> return GeometricCenter "APPROXIMATE" -> return Approximate _ -> fail $ "Unrecognised location type, namely: " ++ T.unpack t -- | Viewport data Viewport = Viewport { southwest :: Location , northeast :: Location } deriving (Eq, Show, Generic) instance FromJSON Viewport -- | Place id newtype PlaceId = PlaceId Text deriving (Eq, Show, Generic) instance FromJSON PlaceId -- | Google Translate API type GoogleMapsGeocodingAPI = "json" :> QueryParam "key" Key :> QueryParam "address" Address :> Get '[JSON] GeocodingResponse -- | API type api :: Proxy GoogleMapsGeocodingAPI api = Proxy geocode' :: Maybe Key -> Maybe Address -> ClientM GeocodingResponse geocode' = client api googleApis :: BaseUrl googleApis = BaseUrl Https "maps.googleapis.com" 443 "/maps/api/geocode" -- | Geocode. NB: The use of the Google Maps Geocoding API services is subject -- to the . geocode :: Manager -> Key -> Address -> IO (Either ServantError GeocodingResponse) geocode mgr key address = runClientM (geocode' (Just key) (Just address)) (ClientEnv mgr googleApis)