{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeOperators              #-}

-- |

-- Module      : Web.Google.Geocoding

-- Description : Bindings to the Google Geocoding API (formerly Maps Geocoding

--               API)

-- Copyright   : (c) Mike Pilgrem 2017, 2018, 2024

-- Maintainer  : public@pilgrem.com

-- Stability   : experimental

--

-- This package has no connection with Google Inc. or its affiliates.

--

-- The <https://developers.google.com/maps/documentation/geocoding 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

-- <https://cloud.google.com/maps-platform/terms/ 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

module Web.Google.Geocoding
  ( -- * Functions

    geocode
  , backGeocode
    -- * API

  , GoogleGeocodingAPI
  , api
    -- * Types

  , Key                  (..)
  , Address              (..)
  , FilterComponent      (..)
  , Viewport             (..)
  , Language             (..)
  , Region               (..)
  , GeocodingResponse    (..)
  , Status               (..)
  , Result               (..)
  , AddressType          (..)
  , AddressComponent     (..)
  , PostcodeLocality     (..)
  , Geometry             (..)
  , LatLng               (..)
  , PlaceId              (..)
  , Location             (..)
  , LocationType         (..)
  ) where

import           Data.Aeson
                   ( FromJSON (parseJSON), Options (fieldLabelModifier)
                   , defaultOptions, genericParseJSON, withText
                   )
import           Data.List ( intersperse )
import           Data.Proxy ( 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
                   ( type (:<|>) (..), type (:>), Get, JSON, QueryParam
                   , ToHttpApiData (toUrlPiece)
                   )
import           Servant.Client
                   ( ClientError, ClientEnv (ClientEnv), ClientM, client
                   , runClientM
                   )
#if MIN_VERSION_servant_client(0,17,0)
import           Servant.Client ( defaultMakeClientRequest )
#endif
import           Web.Google.Maps.Common
                   ( Address (..), Key (..), Language (..), LatLng (..)
                   , Location (..), Region (..), googleMapsApis
                   )

-- | Fliter component: a component that can be used to filter the results

-- returned in a geocoding response.

data FilterComponent
  = Route Text
  | Locality Text
  | AdministrativeArea Text
  | PostalCode Text
  | Country Region
  deriving (FilterComponent -> FilterComponent -> Bool
(FilterComponent -> FilterComponent -> Bool)
-> (FilterComponent -> FilterComponent -> Bool)
-> Eq FilterComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilterComponent -> FilterComponent -> Bool
== :: FilterComponent -> FilterComponent -> Bool
$c/= :: FilterComponent -> FilterComponent -> Bool
/= :: FilterComponent -> FilterComponent -> Bool
Eq, Int -> FilterComponent -> ShowS
[FilterComponent] -> ShowS
FilterComponent -> String
(Int -> FilterComponent -> ShowS)
-> (FilterComponent -> String)
-> ([FilterComponent] -> ShowS)
-> Show FilterComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilterComponent -> ShowS
showsPrec :: Int -> FilterComponent -> ShowS
$cshow :: FilterComponent -> String
show :: FilterComponent -> String
$cshowList :: [FilterComponent] -> ShowS
showList :: [FilterComponent] -> ShowS
Show)

instance ToHttpApiData FilterComponent where
  toUrlPiece :: FilterComponent -> Text
toUrlPiece FilterComponent
filterComponent
    | Route Text
route <- FilterComponent
filterComponent
      = [Text] -> Text
T.concat [Text
"route:", Text
route]
    | Locality Text
locality <- FilterComponent
filterComponent
      = [Text] -> Text
T.concat [Text
"locality:", Text
locality]
    | AdministrativeArea Text
adminArea <- FilterComponent
filterComponent
      = [Text] -> Text
T.concat [Text
"administrative_area:", Text
adminArea]
    | PostalCode Text
postalCode <- FilterComponent
filterComponent
      = [Text] -> Text
T.concat [Text
"postal_code:", Text
postalCode]
    | Country Region
country <- FilterComponent
filterComponent
      = [Text] -> Text
T.concat [Text
"country:", Region -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Region
country]

instance ToHttpApiData [FilterComponent] where
  toUrlPiece :: [FilterComponent] -> Text
toUrlPiece [] = Text
""
  toUrlPiece [FilterComponent]
cs = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"|" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (FilterComponent -> Text) -> [FilterComponent] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilterComponent -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [FilterComponent]
cs

-- | Geocoding Reponse

data GeocodingResponse = GeocodingResponse
  { GeocodingResponse -> Status
status        :: Status
  , GeocodingResponse -> Maybe Text
error_message :: Maybe Text
  , GeocodingResponse -> [Result]
results       :: [Result]
  } deriving (GeocodingResponse -> GeocodingResponse -> Bool
(GeocodingResponse -> GeocodingResponse -> Bool)
-> (GeocodingResponse -> GeocodingResponse -> Bool)
-> Eq GeocodingResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeocodingResponse -> GeocodingResponse -> Bool
== :: GeocodingResponse -> GeocodingResponse -> Bool
$c/= :: GeocodingResponse -> GeocodingResponse -> Bool
/= :: GeocodingResponse -> GeocodingResponse -> Bool
Eq, Int -> GeocodingResponse -> ShowS
[GeocodingResponse] -> ShowS
GeocodingResponse -> String
(Int -> GeocodingResponse -> ShowS)
-> (GeocodingResponse -> String)
-> ([GeocodingResponse] -> ShowS)
-> Show GeocodingResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeocodingResponse -> ShowS
showsPrec :: Int -> GeocodingResponse -> ShowS
$cshow :: GeocodingResponse -> String
show :: GeocodingResponse -> String
$cshowList :: [GeocodingResponse] -> ShowS
showList :: [GeocodingResponse] -> ShowS
Show, (forall x. GeocodingResponse -> Rep GeocodingResponse x)
-> (forall x. Rep GeocodingResponse x -> GeocodingResponse)
-> Generic GeocodingResponse
forall x. Rep GeocodingResponse x -> GeocodingResponse
forall x. GeocodingResponse -> Rep GeocodingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeocodingResponse -> Rep GeocodingResponse x
from :: forall x. GeocodingResponse -> Rep GeocodingResponse x
$cto :: forall x. Rep GeocodingResponse x -> GeocodingResponse
to :: forall x. Rep GeocodingResponse x -> GeocodingResponse
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 (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

instance FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON = String -> (Text -> Parser Status) -> Value -> Parser Status
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Status" ((Text -> Parser Status) -> Value -> Parser Status)
-> (Text -> Parser Status) -> Value -> Parser Status
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"OK"               -> Status -> Parser Status
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
OK
    Text
"ZERO_RESULTS"     -> Status -> Parser Status
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
ZeroResults
    Text
"OVER_QUERY_LIMIT" -> Status -> Parser Status
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
OverQueryLimit
    Text
"REQUEST_DENIED"   -> Status -> Parser Status
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
RequestDenied
    Text
"INVALID_REQUEST"  -> Status -> Parser Status
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
InvalidRequest
    Text
"UNKNOWN_ERROR"    -> Status -> Parser Status
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
UnknownError
    Text
_                  -> String -> Parser Status
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Status) -> String -> Parser Status
forall a b. (a -> b) -> a -> b
$ String
"Unrecognised status type, namely: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                            Text -> String
T.unpack Text
t

-- | A result of the geocoder.

data Result = Result
  { Result -> [AddressType]
types :: [AddressType]
  , Result -> Text
formatted_address :: Text
  , Result -> [AddressComponent]
address_components :: [AddressComponent]
  , Result -> Maybe [PostcodeLocality]
postcode_localities :: Maybe [PostcodeLocality]
  , Result -> Geometry
geometry :: Geometry
  , Result -> Maybe Bool
partial_match :: Maybe Bool
  , Result -> PlaceId
place_id :: PlaceId
  } deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
/= :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> String
show :: Result -> String
$cshowList :: [Result] -> ShowS
showList :: [Result] -> ShowS
Show, (forall x. Result -> Rep Result x)
-> (forall x. Rep Result x -> Result) -> Generic Result
forall x. Rep Result x -> Result
forall x. Result -> Rep Result x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Result -> Rep Result x
from :: forall x. Result -> Rep Result x
$cto :: forall x. Rep Result x -> Result
to :: forall x. Rep Result x -> Result
Generic)

instance FromJSON Result

-- | Address (and address component) type: The list of types provided by Google

-- (as at 4 March 2017) is incomplete.

newtype AddressType = AddressType Text
  deriving (AddressType -> AddressType -> Bool
(AddressType -> AddressType -> Bool)
-> (AddressType -> AddressType -> Bool) -> Eq AddressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressType -> AddressType -> Bool
== :: AddressType -> AddressType -> Bool
$c/= :: AddressType -> AddressType -> Bool
/= :: AddressType -> AddressType -> Bool
Eq, Int -> AddressType -> ShowS
[AddressType] -> ShowS
AddressType -> String
(Int -> AddressType -> ShowS)
-> (AddressType -> String)
-> ([AddressType] -> ShowS)
-> Show AddressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressType -> ShowS
showsPrec :: Int -> AddressType -> ShowS
$cshow :: AddressType -> String
show :: AddressType -> String
$cshowList :: [AddressType] -> ShowS
showList :: [AddressType] -> ShowS
Show, (forall x. AddressType -> Rep AddressType x)
-> (forall x. Rep AddressType x -> AddressType)
-> Generic AddressType
forall x. Rep AddressType x -> AddressType
forall x. AddressType -> Rep AddressType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddressType -> Rep AddressType x
from :: forall x. AddressType -> Rep AddressType x
$cto :: forall x. Rep AddressType x -> AddressType
to :: forall x. Rep AddressType x -> AddressType
Generic, AddressType -> ByteString
AddressType -> Text
AddressType -> Builder
(AddressType -> Text)
-> (AddressType -> Builder)
-> (AddressType -> ByteString)
-> (AddressType -> Text)
-> (AddressType -> Builder)
-> ToHttpApiData AddressType
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: AddressType -> Text
toUrlPiece :: AddressType -> Text
$ctoEncodedUrlPiece :: AddressType -> Builder
toEncodedUrlPiece :: AddressType -> Builder
$ctoHeader :: AddressType -> ByteString
toHeader :: AddressType -> ByteString
$ctoQueryParam :: AddressType -> Text
toQueryParam :: AddressType -> Text
$ctoEncodedQueryParam :: AddressType -> Builder
toEncodedQueryParam :: AddressType -> Builder
ToHttpApiData)

instance FromJSON AddressType

-- | Address component

data AddressComponent = AddressComponent
  { AddressComponent -> [AddressType]
address_component_types      :: [AddressType]
  , AddressComponent -> Text
long_name  :: Text
  , AddressComponent -> Text
short_name :: Text
  } deriving (AddressComponent -> AddressComponent -> Bool
(AddressComponent -> AddressComponent -> Bool)
-> (AddressComponent -> AddressComponent -> Bool)
-> Eq AddressComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressComponent -> AddressComponent -> Bool
== :: AddressComponent -> AddressComponent -> Bool
$c/= :: AddressComponent -> AddressComponent -> Bool
/= :: AddressComponent -> AddressComponent -> Bool
Eq, Int -> AddressComponent -> ShowS
[AddressComponent] -> ShowS
AddressComponent -> String
(Int -> AddressComponent -> ShowS)
-> (AddressComponent -> String)
-> ([AddressComponent] -> ShowS)
-> Show AddressComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressComponent -> ShowS
showsPrec :: Int -> AddressComponent -> ShowS
$cshow :: AddressComponent -> String
show :: AddressComponent -> String
$cshowList :: [AddressComponent] -> ShowS
showList :: [AddressComponent] -> ShowS
Show, (forall x. AddressComponent -> Rep AddressComponent x)
-> (forall x. Rep AddressComponent x -> AddressComponent)
-> Generic AddressComponent
forall x. Rep AddressComponent x -> AddressComponent
forall x. AddressComponent -> Rep AddressComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddressComponent -> Rep AddressComponent x
from :: forall x. AddressComponent -> Rep AddressComponent x
$cto :: forall x. Rep AddressComponent x -> AddressComponent
to :: forall x. Rep AddressComponent x -> AddressComponent
Generic)

instance FromJSON AddressComponent where
  parseJSON :: Value -> Parser AddressComponent
parseJSON = Options -> Value -> Parser AddressComponent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
    { fieldLabelModifier = \String
l -> case String
l of
        String
"address_component_types" -> String
"types"
        String
_ -> String
l
    }

-- | Postcode locality: a locality contained in a postal code.

newtype PostcodeLocality = PostcodeLocality Text
  deriving (PostcodeLocality -> PostcodeLocality -> Bool
(PostcodeLocality -> PostcodeLocality -> Bool)
-> (PostcodeLocality -> PostcodeLocality -> Bool)
-> Eq PostcodeLocality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostcodeLocality -> PostcodeLocality -> Bool
== :: PostcodeLocality -> PostcodeLocality -> Bool
$c/= :: PostcodeLocality -> PostcodeLocality -> Bool
/= :: PostcodeLocality -> PostcodeLocality -> Bool
Eq, Int -> PostcodeLocality -> ShowS
[PostcodeLocality] -> ShowS
PostcodeLocality -> String
(Int -> PostcodeLocality -> ShowS)
-> (PostcodeLocality -> String)
-> ([PostcodeLocality] -> ShowS)
-> Show PostcodeLocality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostcodeLocality -> ShowS
showsPrec :: Int -> PostcodeLocality -> ShowS
$cshow :: PostcodeLocality -> String
show :: PostcodeLocality -> String
$cshowList :: [PostcodeLocality] -> ShowS
showList :: [PostcodeLocality] -> ShowS
Show, (forall x. PostcodeLocality -> Rep PostcodeLocality x)
-> (forall x. Rep PostcodeLocality x -> PostcodeLocality)
-> Generic PostcodeLocality
forall x. Rep PostcodeLocality x -> PostcodeLocality
forall x. PostcodeLocality -> Rep PostcodeLocality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostcodeLocality -> Rep PostcodeLocality x
from :: forall x. PostcodeLocality -> Rep PostcodeLocality x
$cto :: forall x. Rep PostcodeLocality x -> PostcodeLocality
to :: forall x. Rep PostcodeLocality x -> PostcodeLocality
Generic)

instance FromJSON PostcodeLocality

-- | Geometry

data Geometry = Geometry
  { Geometry -> LatLng
location :: LatLng
  , Geometry -> LocationType
location_type :: LocationType
  , Geometry -> Viewport
viewport :: Viewport
  , Geometry -> Maybe Viewport
bounds :: Maybe Viewport
  } deriving (Geometry -> Geometry -> Bool
(Geometry -> Geometry -> Bool)
-> (Geometry -> Geometry -> Bool) -> Eq Geometry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Geometry -> Geometry -> Bool
== :: Geometry -> Geometry -> Bool
$c/= :: Geometry -> Geometry -> Bool
/= :: Geometry -> Geometry -> Bool
Eq, Int -> Geometry -> ShowS
[Geometry] -> ShowS
Geometry -> String
(Int -> Geometry -> ShowS)
-> (Geometry -> String) -> ([Geometry] -> ShowS) -> Show Geometry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Geometry -> ShowS
showsPrec :: Int -> Geometry -> ShowS
$cshow :: Geometry -> String
show :: Geometry -> String
$cshowList :: [Geometry] -> ShowS
showList :: [Geometry] -> ShowS
Show, (forall x. Geometry -> Rep Geometry x)
-> (forall x. Rep Geometry x -> Geometry) -> Generic Geometry
forall x. Rep Geometry x -> Geometry
forall x. Geometry -> Rep Geometry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Geometry -> Rep Geometry x
from :: forall x. Geometry -> Rep Geometry x
$cto :: forall x. Rep Geometry x -> Geometry
to :: forall x. Rep Geometry x -> Geometry
Generic)

instance FromJSON Geometry

-- | Location type

data LocationType
  = Rooftop
  | RangeInterpolated
  | GeometricCenter
  | Approximate
  deriving (LocationType -> LocationType -> Bool
(LocationType -> LocationType -> Bool)
-> (LocationType -> LocationType -> Bool) -> Eq LocationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocationType -> LocationType -> Bool
== :: LocationType -> LocationType -> Bool
$c/= :: LocationType -> LocationType -> Bool
/= :: LocationType -> LocationType -> Bool
Eq, Int -> LocationType -> ShowS
[LocationType] -> ShowS
LocationType -> String
(Int -> LocationType -> ShowS)
-> (LocationType -> String)
-> ([LocationType] -> ShowS)
-> Show LocationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocationType -> ShowS
showsPrec :: Int -> LocationType -> ShowS
$cshow :: LocationType -> String
show :: LocationType -> String
$cshowList :: [LocationType] -> ShowS
showList :: [LocationType] -> ShowS
Show)

instance ToHttpApiData LocationType where
  toUrlPiece :: LocationType -> Text
toUrlPiece LocationType
locationType = case LocationType
locationType of
    LocationType
Rooftop           -> Text
"ROOFTOP"
    LocationType
RangeInterpolated -> Text
"RANGE_INTERPOLATED"
    LocationType
GeometricCenter   -> Text
"GEOMETRIC_CENTER"
    LocationType
Approximate       -> Text
"APPROXIMATE"

instance FromJSON LocationType where
  parseJSON :: Value -> Parser LocationType
parseJSON = String
-> (Text -> Parser LocationType) -> Value -> Parser LocationType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LocationType" ((Text -> Parser LocationType) -> Value -> Parser LocationType)
-> (Text -> Parser LocationType) -> Value -> Parser LocationType
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"ROOFTOP"            -> LocationType -> Parser LocationType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
Rooftop
    Text
"RANGE_INTERPOLATED" -> LocationType -> Parser LocationType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
RangeInterpolated
    Text
"GEOMETRIC_CENTER"   -> LocationType -> Parser LocationType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
GeometricCenter
    Text
"APPROXIMATE"        -> LocationType -> Parser LocationType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
Approximate
    Text
_ -> String -> Parser LocationType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LocationType) -> String -> Parser LocationType
forall a b. (a -> b) -> a -> b
$ String
"Unrecognised location type, namely: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t

-- | Viewport

data Viewport = Viewport
  { Viewport -> LatLng
southwest :: LatLng
  , Viewport -> LatLng
northeast :: LatLng
  } deriving (Viewport -> Viewport -> Bool
(Viewport -> Viewport -> Bool)
-> (Viewport -> Viewport -> Bool) -> Eq Viewport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Viewport -> Viewport -> Bool
== :: Viewport -> Viewport -> Bool
$c/= :: Viewport -> Viewport -> Bool
/= :: Viewport -> Viewport -> Bool
Eq, Int -> Viewport -> ShowS
[Viewport] -> ShowS
Viewport -> String
(Int -> Viewport -> ShowS)
-> (Viewport -> String) -> ([Viewport] -> ShowS) -> Show Viewport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Viewport -> ShowS
showsPrec :: Int -> Viewport -> ShowS
$cshow :: Viewport -> String
show :: Viewport -> String
$cshowList :: [Viewport] -> ShowS
showList :: [Viewport] -> ShowS
Show, (forall x. Viewport -> Rep Viewport x)
-> (forall x. Rep Viewport x -> Viewport) -> Generic Viewport
forall x. Rep Viewport x -> Viewport
forall x. Viewport -> Rep Viewport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Viewport -> Rep Viewport x
from :: forall x. Viewport -> Rep Viewport x
$cto :: forall x. Rep Viewport x -> Viewport
to :: forall x. Rep Viewport x -> Viewport
Generic)

instance ToHttpApiData Viewport where
  toUrlPiece :: Viewport -> Text
toUrlPiece (Viewport LatLng
sw LatLng
ne) = [Text] -> Text
T.concat [LatLng -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece LatLng
sw, Text
"|", LatLng -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece LatLng
ne]

instance FromJSON Viewport

-- | Place id

newtype PlaceId = PlaceId Text
  deriving (PlaceId -> PlaceId -> Bool
(PlaceId -> PlaceId -> Bool)
-> (PlaceId -> PlaceId -> Bool) -> Eq PlaceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlaceId -> PlaceId -> Bool
== :: PlaceId -> PlaceId -> Bool
$c/= :: PlaceId -> PlaceId -> Bool
/= :: PlaceId -> PlaceId -> Bool
Eq, Int -> PlaceId -> ShowS
[PlaceId] -> ShowS
PlaceId -> String
(Int -> PlaceId -> ShowS)
-> (PlaceId -> String) -> ([PlaceId] -> ShowS) -> Show PlaceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlaceId -> ShowS
showsPrec :: Int -> PlaceId -> ShowS
$cshow :: PlaceId -> String
show :: PlaceId -> String
$cshowList :: [PlaceId] -> ShowS
showList :: [PlaceId] -> ShowS
Show, (forall x. PlaceId -> Rep PlaceId x)
-> (forall x. Rep PlaceId x -> PlaceId) -> Generic PlaceId
forall x. Rep PlaceId x -> PlaceId
forall x. PlaceId -> Rep PlaceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PlaceId -> Rep PlaceId x
from :: forall x. PlaceId -> Rep PlaceId x
$cto :: forall x. Rep PlaceId x -> PlaceId
to :: forall x. Rep PlaceId x -> PlaceId
Generic, PlaceId -> ByteString
PlaceId -> Text
PlaceId -> Builder
(PlaceId -> Text)
-> (PlaceId -> Builder)
-> (PlaceId -> ByteString)
-> (PlaceId -> Text)
-> (PlaceId -> Builder)
-> ToHttpApiData PlaceId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PlaceId -> Text
toUrlPiece :: PlaceId -> Text
$ctoEncodedUrlPiece :: PlaceId -> Builder
toEncodedUrlPiece :: PlaceId -> Builder
$ctoHeader :: PlaceId -> ByteString
toHeader :: PlaceId -> ByteString
$ctoQueryParam :: PlaceId -> Text
toQueryParam :: PlaceId -> Text
$ctoEncodedQueryParam :: PlaceId -> Builder
toEncodedQueryParam :: PlaceId -> Builder
ToHttpApiData)

instance FromJSON PlaceId

-- | Google Geocoding 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

-- | API type

api :: Proxy GoogleGeocodingAPI
api :: Proxy GoogleGeocodingAPI
api = Proxy GoogleGeocodingAPI
forall {k} (t :: k). Proxy t
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
Maybe Key
-> Maybe Address
-> Maybe [FilterComponent]
-> Maybe Viewport
-> Maybe Language
-> Maybe Region
-> ClientM GeocodingResponse
geocode' :<|> Maybe Key
-> Maybe LatLng
-> Maybe PlaceId
-> Maybe AddressType
-> Maybe LocationType
-> Maybe Language
-> ClientM GeocodingResponse
backGeocode' = Proxy GoogleGeocodingAPI -> Client ClientM GoogleGeocodingAPI
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy GoogleGeocodingAPI
api

-- | Geocode. NB: The use of the Google Geocoding API services is subject to the

-- <https://cloud.google.com/maps-platform/terms/ 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/>.

geocode ::
     Manager
  -> Key
  -> Maybe Address
  -> Maybe [FilterComponent]
  -> Maybe Viewport
  -> Maybe Language
  -> Maybe Region
  -> IO (Either ClientError GeocodingResponse)
geocode :: Manager
-> Key
-> Maybe Address
-> Maybe [FilterComponent]
-> Maybe Viewport
-> Maybe Language
-> Maybe Region
-> IO (Either ClientError GeocodingResponse)
geocode
  Manager
mgr
  Key
key
  Maybe Address
addressOpt
  Maybe [FilterComponent]
filterComponentsOpt
  Maybe Viewport
viewportOpt
  Maybe Language
languageOpt
  Maybe Region
regionOpt
  = ClientM GeocodingResponse
-> ClientEnv -> IO (Either ClientError GeocodingResponse)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (Maybe Key
-> Maybe Address
-> Maybe [FilterComponent]
-> Maybe Viewport
-> Maybe Language
-> Maybe Region
-> ClientM GeocodingResponse
geocode' (Key -> Maybe Key
forall a. a -> Maybe a
Just Key
key) Maybe Address
addressOpt Maybe [FilterComponent]
filterComponentsOpt Maybe Viewport
viewportOpt
        Maybe Language
languageOpt Maybe Region
regionOpt)
-- Middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
googleMapsApis Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr googleMapsApis Nothing defaultMakeClientRequest)
-- CookieJar supported from servant-client-0.13

#elif MIN_VERSION_servant_client(0,13,0)
      (ClientEnv mgr googleMapsApis Nothing)
#else
      (ClientEnv mgr googleMapsApis)
#endif

-- | Reverse (back) geocode. NB: The use of the Google Geocoding API services is

-- subject to the

-- <https://cloud.google.com/maps-platform/terms/ 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)
backGeocode :: Manager
-> Key
-> Maybe LatLng
-> Maybe PlaceId
-> Maybe AddressType
-> Maybe LocationType
-> Maybe Language
-> IO (Either ClientError GeocodingResponse)
backGeocode
  Manager
mgr
  Key
key
  Maybe LatLng
latLngOpt
  Maybe PlaceId
placeIdOpt
  Maybe AddressType
addressTypeOpt
  Maybe LocationType
locationTypeOpt
  Maybe Language
languageOpt
  = ClientM GeocodingResponse
-> ClientEnv -> IO (Either ClientError GeocodingResponse)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (Maybe Key
-> Maybe LatLng
-> Maybe PlaceId
-> Maybe AddressType
-> Maybe LocationType
-> Maybe Language
-> ClientM GeocodingResponse
backGeocode' (Key -> Maybe Key
forall a. a -> Maybe a
Just Key
key) Maybe LatLng
latLngOpt Maybe PlaceId
placeIdOpt Maybe AddressType
addressTypeOpt
        Maybe LocationType
locationTypeOpt Maybe Language
languageOpt)
-- Middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
googleMapsApis Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr googleMapsApis Nothing defaultMakeClientRequest)
-- CookieJar supported from servant-client-0.13

#elif MIN_VERSION_servant_client(0,13,0)
      (ClientEnv mgr googleMapsApis Nothing)
#else
      (ClientEnv mgr googleMapsApis)
#endif