module Web.Google.Maps.Geocoding
(
geocode
, GoogleMapsGeocodingAPI
, api
, 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
newtype Key = Key Text
deriving (Eq, Show, ToHttpApiData)
newtype Address = Address Text
deriving (Eq, Show, ToHttpApiData)
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
data AddressType = AddressType Text
deriving (Eq, Show, Generic)
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 :: Location
, location_type :: LocationType
, viewport :: Viewport
, bounds :: Maybe Viewport
} deriving (Eq, Show, Generic)
instance FromJSON Geometry
data Location = Location
{ lat :: Double
, lng :: Double
} deriving (Eq, Show, Generic)
instance FromJSON Location
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
data Viewport = Viewport
{ southwest :: Location
, northeast :: Location
} deriving (Eq, Show, Generic)
instance FromJSON Viewport
newtype PlaceId = PlaceId Text
deriving (Eq, Show, Generic)
instance FromJSON PlaceId
type GoogleMapsGeocodingAPI
= "json"
:> QueryParam "key" Key
:> QueryParam "address" Address
:> Get '[JSON] GeocodingResponse
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
:: Manager
-> Key
-> Address
-> IO (Either ServantError GeocodingResponse)
geocode mgr key address =
runClientM (geocode' (Just key) (Just address)) (ClientEnv mgr googleApis)