{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Location.GetPlace
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Finds a place by its unique ID. A @PlaceId@ is returned by other search
-- operations.
--
-- A PlaceId is valid only if all of the following are the same in the
-- original search request and the call to @GetPlace@.
--
-- -   Customer AWS account
--
-- -   AWS Region
--
-- -   Data provider specified in the place index resource
module Amazonka.Location.GetPlace
  ( -- * Creating a Request
    GetPlace (..),
    newGetPlace,

    -- * Request Lenses
    getPlace_language,
    getPlace_indexName,
    getPlace_placeId,

    -- * Destructuring the Response
    GetPlaceResponse (..),
    newGetPlaceResponse,

    -- * Response Lenses
    getPlaceResponse_httpStatus,
    getPlaceResponse_place,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Location.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetPlace' smart constructor.
data GetPlace = GetPlace'
  { -- | The preferred language used to return results. The value must be a valid
    -- <https://tools.ietf.org/search/bcp47 BCP 47> language tag, for example,
    -- @en@ for English.
    --
    -- This setting affects the languages used in the results, but not the
    -- results themselves. If no language is specified, or not supported for a
    -- particular result, the partner automatically chooses a language for the
    -- result.
    --
    -- For an example, we\'ll use the Greek language. You search for a location
    -- around Athens, Greece, with the @language@ parameter set to @en@. The
    -- @city@ in the results will most likely be returned as @Athens@.
    --
    -- If you set the @language@ parameter to @el@, for Greek, then the @city@
    -- in the results will more likely be returned as @Αθήνα@.
    --
    -- If the data provider does not have a value for Greek, the result will be
    -- in a language that the provider does support.
    GetPlace -> Maybe Text
language :: Prelude.Maybe Prelude.Text,
    -- | The name of the place index resource that you want to use for the
    -- search.
    GetPlace -> Text
indexName :: Prelude.Text,
    -- | The identifier of the place to find.
    GetPlace -> Text
placeId :: Prelude.Text
  }
  deriving (GetPlace -> GetPlace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPlace -> GetPlace -> Bool
$c/= :: GetPlace -> GetPlace -> Bool
== :: GetPlace -> GetPlace -> Bool
$c== :: GetPlace -> GetPlace -> Bool
Prelude.Eq, ReadPrec [GetPlace]
ReadPrec GetPlace
Int -> ReadS GetPlace
ReadS [GetPlace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPlace]
$creadListPrec :: ReadPrec [GetPlace]
readPrec :: ReadPrec GetPlace
$creadPrec :: ReadPrec GetPlace
readList :: ReadS [GetPlace]
$creadList :: ReadS [GetPlace]
readsPrec :: Int -> ReadS GetPlace
$creadsPrec :: Int -> ReadS GetPlace
Prelude.Read, Int -> GetPlace -> ShowS
[GetPlace] -> ShowS
GetPlace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPlace] -> ShowS
$cshowList :: [GetPlace] -> ShowS
show :: GetPlace -> String
$cshow :: GetPlace -> String
showsPrec :: Int -> GetPlace -> ShowS
$cshowsPrec :: Int -> GetPlace -> ShowS
Prelude.Show, forall x. Rep GetPlace x -> GetPlace
forall x. GetPlace -> Rep GetPlace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPlace x -> GetPlace
$cfrom :: forall x. GetPlace -> Rep GetPlace x
Prelude.Generic)

-- |
-- Create a value of 'GetPlace' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'language', 'getPlace_language' - The preferred language used to return results. The value must be a valid
-- <https://tools.ietf.org/search/bcp47 BCP 47> language tag, for example,
-- @en@ for English.
--
-- This setting affects the languages used in the results, but not the
-- results themselves. If no language is specified, or not supported for a
-- particular result, the partner automatically chooses a language for the
-- result.
--
-- For an example, we\'ll use the Greek language. You search for a location
-- around Athens, Greece, with the @language@ parameter set to @en@. The
-- @city@ in the results will most likely be returned as @Athens@.
--
-- If you set the @language@ parameter to @el@, for Greek, then the @city@
-- in the results will more likely be returned as @Αθήνα@.
--
-- If the data provider does not have a value for Greek, the result will be
-- in a language that the provider does support.
--
-- 'indexName', 'getPlace_indexName' - The name of the place index resource that you want to use for the
-- search.
--
-- 'placeId', 'getPlace_placeId' - The identifier of the place to find.
newGetPlace ::
  -- | 'indexName'
  Prelude.Text ->
  -- | 'placeId'
  Prelude.Text ->
  GetPlace
newGetPlace :: Text -> Text -> GetPlace
newGetPlace Text
pIndexName_ Text
pPlaceId_ =
  GetPlace'
    { $sel:language:GetPlace' :: Maybe Text
language = forall a. Maybe a
Prelude.Nothing,
      $sel:indexName:GetPlace' :: Text
indexName = Text
pIndexName_,
      $sel:placeId:GetPlace' :: Text
placeId = Text
pPlaceId_
    }

-- | The preferred language used to return results. The value must be a valid
-- <https://tools.ietf.org/search/bcp47 BCP 47> language tag, for example,
-- @en@ for English.
--
-- This setting affects the languages used in the results, but not the
-- results themselves. If no language is specified, or not supported for a
-- particular result, the partner automatically chooses a language for the
-- result.
--
-- For an example, we\'ll use the Greek language. You search for a location
-- around Athens, Greece, with the @language@ parameter set to @en@. The
-- @city@ in the results will most likely be returned as @Athens@.
--
-- If you set the @language@ parameter to @el@, for Greek, then the @city@
-- in the results will more likely be returned as @Αθήνα@.
--
-- If the data provider does not have a value for Greek, the result will be
-- in a language that the provider does support.
getPlace_language :: Lens.Lens' GetPlace (Prelude.Maybe Prelude.Text)
getPlace_language :: Lens' GetPlace (Maybe Text)
getPlace_language = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlace' {Maybe Text
language :: Maybe Text
$sel:language:GetPlace' :: GetPlace -> Maybe Text
language} -> Maybe Text
language) (\s :: GetPlace
s@GetPlace' {} Maybe Text
a -> GetPlace
s {$sel:language:GetPlace' :: Maybe Text
language = Maybe Text
a} :: GetPlace)

-- | The name of the place index resource that you want to use for the
-- search.
getPlace_indexName :: Lens.Lens' GetPlace Prelude.Text
getPlace_indexName :: Lens' GetPlace Text
getPlace_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlace' {Text
indexName :: Text
$sel:indexName:GetPlace' :: GetPlace -> Text
indexName} -> Text
indexName) (\s :: GetPlace
s@GetPlace' {} Text
a -> GetPlace
s {$sel:indexName:GetPlace' :: Text
indexName = Text
a} :: GetPlace)

-- | The identifier of the place to find.
getPlace_placeId :: Lens.Lens' GetPlace Prelude.Text
getPlace_placeId :: Lens' GetPlace Text
getPlace_placeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlace' {Text
placeId :: Text
$sel:placeId:GetPlace' :: GetPlace -> Text
placeId} -> Text
placeId) (\s :: GetPlace
s@GetPlace' {} Text
a -> GetPlace
s {$sel:placeId:GetPlace' :: Text
placeId = Text
a} :: GetPlace)

instance Core.AWSRequest GetPlace where
  type AWSResponse GetPlace = GetPlaceResponse
  request :: (Service -> Service) -> GetPlace -> Request GetPlace
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetPlace
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPlace)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Place -> GetPlaceResponse
GetPlaceResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Place")
      )

instance Prelude.Hashable GetPlace where
  hashWithSalt :: Int -> GetPlace -> Int
hashWithSalt Int
_salt GetPlace' {Maybe Text
Text
placeId :: Text
indexName :: Text
language :: Maybe Text
$sel:placeId:GetPlace' :: GetPlace -> Text
$sel:indexName:GetPlace' :: GetPlace -> Text
$sel:language:GetPlace' :: GetPlace -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
language
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
placeId

instance Prelude.NFData GetPlace where
  rnf :: GetPlace -> ()
rnf GetPlace' {Maybe Text
Text
placeId :: Text
indexName :: Text
language :: Maybe Text
$sel:placeId:GetPlace' :: GetPlace -> Text
$sel:indexName:GetPlace' :: GetPlace -> Text
$sel:language:GetPlace' :: GetPlace -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
language
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
placeId

instance Data.ToHeaders GetPlace where
  toHeaders :: GetPlace -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetPlace where
  toPath :: GetPlace -> ByteString
toPath GetPlace' {Maybe Text
Text
placeId :: Text
indexName :: Text
language :: Maybe Text
$sel:placeId:GetPlace' :: GetPlace -> Text
$sel:indexName:GetPlace' :: GetPlace -> Text
$sel:language:GetPlace' :: GetPlace -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/places/v0/indexes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
indexName,
        ByteString
"/places/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
placeId
      ]

instance Data.ToQuery GetPlace where
  toQuery :: GetPlace -> QueryString
toQuery GetPlace' {Maybe Text
Text
placeId :: Text
indexName :: Text
language :: Maybe Text
$sel:placeId:GetPlace' :: GetPlace -> Text
$sel:indexName:GetPlace' :: GetPlace -> Text
$sel:language:GetPlace' :: GetPlace -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"language" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
language]

-- | /See:/ 'newGetPlaceResponse' smart constructor.
data GetPlaceResponse = GetPlaceResponse'
  { -- | The response's http status code.
    GetPlaceResponse -> Int
httpStatus :: Prelude.Int,
    -- | Details about the result, such as its address and position.
    GetPlaceResponse -> Place
place :: Place
  }
  deriving (GetPlaceResponse -> GetPlaceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPlaceResponse -> GetPlaceResponse -> Bool
$c/= :: GetPlaceResponse -> GetPlaceResponse -> Bool
== :: GetPlaceResponse -> GetPlaceResponse -> Bool
$c== :: GetPlaceResponse -> GetPlaceResponse -> Bool
Prelude.Eq, Int -> GetPlaceResponse -> ShowS
[GetPlaceResponse] -> ShowS
GetPlaceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPlaceResponse] -> ShowS
$cshowList :: [GetPlaceResponse] -> ShowS
show :: GetPlaceResponse -> String
$cshow :: GetPlaceResponse -> String
showsPrec :: Int -> GetPlaceResponse -> ShowS
$cshowsPrec :: Int -> GetPlaceResponse -> ShowS
Prelude.Show, forall x. Rep GetPlaceResponse x -> GetPlaceResponse
forall x. GetPlaceResponse -> Rep GetPlaceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPlaceResponse x -> GetPlaceResponse
$cfrom :: forall x. GetPlaceResponse -> Rep GetPlaceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPlaceResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'getPlaceResponse_httpStatus' - The response's http status code.
--
-- 'place', 'getPlaceResponse_place' - Details about the result, such as its address and position.
newGetPlaceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'place'
  Place ->
  GetPlaceResponse
newGetPlaceResponse :: Int -> Place -> GetPlaceResponse
newGetPlaceResponse Int
pHttpStatus_ Place
pPlace_ =
  GetPlaceResponse'
    { $sel:httpStatus:GetPlaceResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:place:GetPlaceResponse' :: Place
place = Place
pPlace_
    }

-- | The response's http status code.
getPlaceResponse_httpStatus :: Lens.Lens' GetPlaceResponse Prelude.Int
getPlaceResponse_httpStatus :: Lens' GetPlaceResponse Int
getPlaceResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaceResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetPlaceResponse' :: GetPlaceResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetPlaceResponse
s@GetPlaceResponse' {} Int
a -> GetPlaceResponse
s {$sel:httpStatus:GetPlaceResponse' :: Int
httpStatus = Int
a} :: GetPlaceResponse)

-- | Details about the result, such as its address and position.
getPlaceResponse_place :: Lens.Lens' GetPlaceResponse Place
getPlaceResponse_place :: Lens' GetPlaceResponse Place
getPlaceResponse_place = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaceResponse' {Place
place :: Place
$sel:place:GetPlaceResponse' :: GetPlaceResponse -> Place
place} -> Place
place) (\s :: GetPlaceResponse
s@GetPlaceResponse' {} Place
a -> GetPlaceResponse
s {$sel:place:GetPlaceResponse' :: Place
place = Place
a} :: GetPlaceResponse)

instance Prelude.NFData GetPlaceResponse where
  rnf :: GetPlaceResponse -> ()
rnf GetPlaceResponse' {Int
Place
place :: Place
httpStatus :: Int
$sel:place:GetPlaceResponse' :: GetPlaceResponse -> Place
$sel:httpStatus:GetPlaceResponse' :: GetPlaceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Place
place