{-# 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

-- 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/intro 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
/= :: FilterComponent -> FilterComponent -> Bool
$c/= :: FilterComponent -> FilterComponent -> Bool
== :: FilterComponent -> FilterComponent -> Bool
$c== :: 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
showList :: [FilterComponent] -> ShowS
$cshowList :: [FilterComponent] -> ShowS
show :: FilterComponent -> String
$cshow :: FilterComponent -> String
showsPrec :: Int -> FilterComponent -> ShowS
$cshowsPrec :: Int -> 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
/= :: GeocodingResponse -> GeocodingResponse -> Bool
$c/= :: GeocodingResponse -> GeocodingResponse -> Bool
== :: GeocodingResponse -> GeocodingResponse -> Bool
$c== :: 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
showList :: [GeocodingResponse] -> ShowS
$cshowList :: [GeocodingResponse] -> ShowS
show :: GeocodingResponse -> String
$cshow :: GeocodingResponse -> String
showsPrec :: Int -> GeocodingResponse -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GeocodingResponse x -> GeocodingResponse
$cfrom :: forall x. GeocodingResponse -> Rep GeocodingResponse x
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
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: 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
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
return Status
OK
        Text
"ZERO_RESULTS"     -> Status -> Parser Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
ZeroResults
        Text
"OVER_QUERY_LIMIT" -> Status -> Parser Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
OverQueryLimit
        Text
"REQUEST_DENIED"   -> Status -> Parser Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
RequestDenied
        Text
"INVALID_REQUEST"  -> Status -> Parser Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
InvalidRequest
        Text
"UNKNOWN_ERROR"    -> Status -> Parser Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
UnknownError
        Text
_                  -> String -> Parser Status
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
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: 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
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Result x -> Result
$cfrom :: forall x. Result -> Rep Result x
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
/= :: AddressType -> AddressType -> Bool
$c/= :: AddressType -> AddressType -> Bool
== :: AddressType -> AddressType -> Bool
$c== :: 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
showList :: [AddressType] -> ShowS
$cshowList :: [AddressType] -> ShowS
show :: AddressType -> String
$cshow :: AddressType -> String
showsPrec :: Int -> AddressType -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep AddressType x -> AddressType
$cfrom :: forall x. AddressType -> Rep AddressType x
Generic, AddressType -> ByteString
AddressType -> Builder
AddressType -> Text
(AddressType -> Text)
-> (AddressType -> Builder)
-> (AddressType -> ByteString)
-> (AddressType -> Text)
-> ToHttpApiData AddressType
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: AddressType -> Text
$ctoQueryParam :: AddressType -> Text
toHeader :: AddressType -> ByteString
$ctoHeader :: AddressType -> ByteString
toEncodedUrlPiece :: AddressType -> Builder
$ctoEncodedUrlPiece :: AddressType -> Builder
toUrlPiece :: AddressType -> Text
$ctoUrlPiece :: AddressType -> Text
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
/= :: AddressComponent -> AddressComponent -> Bool
$c/= :: AddressComponent -> AddressComponent -> Bool
== :: AddressComponent -> AddressComponent -> Bool
$c== :: 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
showList :: [AddressComponent] -> ShowS
$cshowList :: [AddressComponent] -> ShowS
show :: AddressComponent -> String
$cshow :: AddressComponent -> String
showsPrec :: Int -> AddressComponent -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep AddressComponent x -> AddressComponent
$cfrom :: forall x. AddressComponent -> Rep AddressComponent x
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 :: ShowS
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
/= :: PostcodeLocality -> PostcodeLocality -> Bool
$c/= :: PostcodeLocality -> PostcodeLocality -> Bool
== :: PostcodeLocality -> PostcodeLocality -> Bool
$c== :: 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
showList :: [PostcodeLocality] -> ShowS
$cshowList :: [PostcodeLocality] -> ShowS
show :: PostcodeLocality -> String
$cshow :: PostcodeLocality -> String
showsPrec :: Int -> PostcodeLocality -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PostcodeLocality x -> PostcodeLocality
$cfrom :: forall x. PostcodeLocality -> Rep PostcodeLocality x
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
/= :: Geometry -> Geometry -> Bool
$c/= :: Geometry -> Geometry -> Bool
== :: Geometry -> Geometry -> Bool
$c== :: 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
showList :: [Geometry] -> ShowS
$cshowList :: [Geometry] -> ShowS
show :: Geometry -> String
$cshow :: Geometry -> String
showsPrec :: Int -> Geometry -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Geometry x -> Geometry
$cfrom :: forall x. Geometry -> Rep Geometry x
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
/= :: LocationType -> LocationType -> Bool
$c/= :: LocationType -> LocationType -> Bool
== :: LocationType -> LocationType -> Bool
$c== :: 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
showList :: [LocationType] -> ShowS
$cshowList :: [LocationType] -> ShowS
show :: LocationType -> String
$cshow :: LocationType -> String
showsPrec :: Int -> LocationType -> ShowS
$cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
return LocationType
Rooftop
        Text
"RANGE_INTERPOLATED" -> LocationType -> Parser LocationType
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
RangeInterpolated
        Text
"GEOMETRIC_CENTER"   -> LocationType -> Parser LocationType
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
GeometricCenter
        Text
"APPROXIMATE"        -> LocationType -> Parser LocationType
forall (m :: * -> *) a. Monad m => a -> m a
return LocationType
Approximate
        Text
_ -> String -> Parser LocationType
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
/= :: Viewport -> Viewport -> Bool
$c/= :: Viewport -> Viewport -> Bool
== :: Viewport -> Viewport -> Bool
$c== :: 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
showList :: [Viewport] -> ShowS
$cshowList :: [Viewport] -> ShowS
show :: Viewport -> String
$cshow :: Viewport -> String
showsPrec :: Int -> Viewport -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Viewport x -> Viewport
$cfrom :: forall x. Viewport -> Rep Viewport x
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
/= :: PlaceId -> PlaceId -> Bool
$c/= :: PlaceId -> PlaceId -> Bool
== :: PlaceId -> PlaceId -> Bool
$c== :: 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
showList :: [PlaceId] -> ShowS
$cshowList :: [PlaceId] -> ShowS
show :: PlaceId -> String
$cshow :: PlaceId -> String
showsPrec :: Int -> PlaceId -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PlaceId x -> PlaceId
$cfrom :: forall x. PlaceId -> Rep PlaceId x
Generic, PlaceId -> ByteString
PlaceId -> Builder
PlaceId -> Text
(PlaceId -> Text)
-> (PlaceId -> Builder)
-> (PlaceId -> ByteString)
-> (PlaceId -> Text)
-> ToHttpApiData PlaceId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: PlaceId -> Text
$ctoQueryParam :: PlaceId -> Text
toHeader :: PlaceId -> ByteString
$ctoHeader :: PlaceId -> ByteString
toEncodedUrlPiece :: PlaceId -> Builder
$ctoEncodedUrlPiece :: PlaceId -> Builder
toUrlPiece :: PlaceId -> Text
$ctoUrlPiece :: PlaceId -> Text
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)
-- makeClientRequest supported from servant-client-0.17

#if MIN_VERSION_servant_client(0,17,0)
          (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> Request)
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
googleMapsApis Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> Request
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)
-- makeClientRequest supported from servant-client-0.17

#if MIN_VERSION_servant_client(0,17,0)
          (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> Request)
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
googleMapsApis Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> Request
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