{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module Web.Google.Geocoding
(
geocode
, backGeocode
, GoogleGeocodingAPI
, api
, Key (..)
, Address (..)
, FilterComponent (..)
, Viewport (..)
, Language (..)
, Region (..)
, GeocodingResponse (..)
, Status (..)
, Result (..)
, AddressType (..)
, AddressComponent (..)
, PostcodeLocality (..)
, Geometry (..)
, LatLng (..)
, PlaceId (..)
, Location (..)
, LocationType (..)
) where
import Data.Aeson hiding (Result)
import Data.Aeson.Types (Options (..))
import Data.List (intersperse)
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T (concat, unpack)
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager)
import Servant.API
import Servant.Client
import Web.Google.Maps.Common (Address (..), googleMapsApis, Key (..),
Language (..), LatLng (..), Location (..), Region (..))
data FilterComponent
= Route Text
| Locality Text
| AdministrativeArea Text
| PostalCode Text
| Country Region
deriving (Eq, Show)
instance ToHttpApiData FilterComponent where
toUrlPiece filterComponent
| Route route <- filterComponent
= T.concat ["route:", route]
| Locality locality <- filterComponent
= T.concat ["locality:", locality]
| AdministrativeArea adminArea <- filterComponent
= T.concat ["administrative_area:", adminArea]
| PostalCode postalCode <- filterComponent
= T.concat ["postal_code:", postalCode]
| Country country <- filterComponent
= T.concat ["country:", toUrlPiece country]
instance ToHttpApiData [FilterComponent] where
toUrlPiece [] = ""
toUrlPiece cs = T.concat $ intersperse "|" $ map toUrlPiece cs
data GeocodingResponse = GeocodingResponse
{ status :: Status
, error_message :: Maybe Text
, results :: [Result]
} deriving (Eq, Show, Generic)
instance FromJSON GeocodingResponse
data Status
= OK
| ZeroResults
| OverQueryLimit
| RequestDenied
| InvalidRequest
| 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
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
newtype AddressType = AddressType Text
deriving (Eq, Show, Generic, ToHttpApiData)
instance FromJSON AddressType
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
}
newtype PostcodeLocality = PostcodeLocality Text
deriving (Eq, Show, Generic)
instance FromJSON PostcodeLocality
data Geometry = Geometry
{ location :: LatLng
, location_type :: LocationType
, viewport :: Viewport
, bounds :: Maybe Viewport
} deriving (Eq, Show, Generic)
instance FromJSON Geometry
data LocationType
= Rooftop
| RangeInterpolated
| GeometricCenter
| Approximate
deriving (Eq, Show)
instance ToHttpApiData LocationType where
toUrlPiece locationType = case locationType of
Rooftop -> "ROOFTOP"
RangeInterpolated -> "RANGE_INTERPOLATED"
GeometricCenter -> "GEOMETRIC_CENTER"
Approximate -> "APPROXIMATE"
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
data Viewport = Viewport
{ southwest :: LatLng
, northeast :: LatLng
} deriving (Eq, Show, Generic)
instance ToHttpApiData Viewport where
toUrlPiece (Viewport sw ne) = T.concat [toUrlPiece sw, "|", toUrlPiece ne]
instance FromJSON Viewport
newtype PlaceId = PlaceId Text
deriving (Eq, Show, Generic, ToHttpApiData)
instance FromJSON PlaceId
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
api = Proxy
geocode'
:: Maybe Key
-> Maybe Address
-> Maybe [FilterComponent]
-> Maybe Viewport
-> Maybe Language
-> Maybe Region
-> ClientM GeocodingResponse
backGeocode'
:: Maybe Key
-> Maybe LatLng
-> Maybe PlaceId
-> Maybe AddressType
-> Maybe LocationType
-> Maybe Language
-> ClientM GeocodingResponse
geocode' :<|> backGeocode' = client api
geocode
:: Manager
-> Key
-> Maybe Address
-> Maybe [FilterComponent]
-> Maybe Viewport
-> Maybe Language
-> Maybe Region
-> IO (Either ClientError GeocodingResponse)
geocode
mgr
key
addressOpt
filterComponentsOpt
viewportOpt
languageOpt
regionOpt
= runClientM (geocode' (Just key) addressOpt filterComponentsOpt viewportOpt
languageOpt regionOpt)
#if MIN_VERSION_servant_client(0,13,0)
(ClientEnv mgr googleMapsApis Nothing)
#else
(ClientEnv mgr googleMapsApis)
#endif
backGeocode
:: Manager
-> Key
-> Maybe LatLng
-> Maybe PlaceId
-> Maybe AddressType
-> Maybe LocationType
-> Maybe Language
-> IO (Either ClientError GeocodingResponse)
backGeocode
mgr
key
latLngOpt
placeIdOpt
addressTypeOpt
locationTypeOpt
languageOpt
= runClientM (backGeocode' (Just key) latLngOpt placeIdOpt addressTypeOpt
locationTypeOpt languageOpt)
#if MIN_VERSION_servant_client(0,13,0)
(ClientEnv mgr googleMapsApis Nothing)
#else
(ClientEnv mgr googleMapsApis)
#endif