{-# 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.SearchPlaceIndexForText
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Geocodes free-form text, such as an address, name, city, or region to
-- allow you to search for Places or points of interest.
--
-- Optional parameters let you narrow your search results by bounding box
-- or country, or bias your search toward a specific position on the globe.
--
-- You can search for places near a given position using @BiasPosition@, or
-- filter results within a bounding box using @FilterBBox@. Providing both
-- parameters simultaneously returns an error.
--
-- Search results are returned in order of highest to lowest relevance.
module Amazonka.Location.SearchPlaceIndexForText
  ( -- * Creating a Request
    SearchPlaceIndexForText (..),
    newSearchPlaceIndexForText,

    -- * Request Lenses
    searchPlaceIndexForText_biasPosition,
    searchPlaceIndexForText_filterBBox,
    searchPlaceIndexForText_filterCountries,
    searchPlaceIndexForText_language,
    searchPlaceIndexForText_maxResults,
    searchPlaceIndexForText_indexName,
    searchPlaceIndexForText_text,

    -- * Destructuring the Response
    SearchPlaceIndexForTextResponse (..),
    newSearchPlaceIndexForTextResponse,

    -- * Response Lenses
    searchPlaceIndexForTextResponse_httpStatus,
    searchPlaceIndexForTextResponse_results,
    searchPlaceIndexForTextResponse_summary,
  )
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:/ 'newSearchPlaceIndexForText' smart constructor.
data SearchPlaceIndexForText = SearchPlaceIndexForText'
  { -- | An optional parameter that indicates a preference for places that are
    -- closer to a specified position.
    --
    -- If provided, this parameter must contain a pair of numbers. The first
    -- number represents the X coordinate, or longitude; the second number
    -- represents the Y coordinate, or latitude.
    --
    -- For example, @[-123.1174, 49.2847]@ represents the position with
    -- longitude @-123.1174@ and latitude @49.2847@.
    --
    -- @BiasPosition@ and @FilterBBox@ are mutually exclusive. Specifying both
    -- options results in an error.
    SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
biasPosition :: Prelude.Maybe (Data.Sensitive (Prelude.NonEmpty Prelude.Double)),
    -- | An optional parameter that limits the search results by returning only
    -- places that are within the provided bounding box.
    --
    -- If provided, this parameter must contain a total of four consecutive
    -- numbers in two pairs. The first pair of numbers represents the X and Y
    -- coordinates (longitude and latitude, respectively) of the southwest
    -- corner of the bounding box; the second pair of numbers represents the X
    -- and Y coordinates (longitude and latitude, respectively) of the
    -- northeast corner of the bounding box.
    --
    -- For example, @[-12.7935, -37.4835, -12.0684, -36.9542]@ represents a
    -- bounding box where the southwest corner has longitude @-12.7935@ and
    -- latitude @-37.4835@, and the northeast corner has longitude @-12.0684@
    -- and latitude @-36.9542@.
    --
    -- @FilterBBox@ and @BiasPosition@ are mutually exclusive. Specifying both
    -- options results in an error.
    SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
filterBBox :: Prelude.Maybe (Data.Sensitive (Prelude.NonEmpty Prelude.Double)),
    -- | An optional parameter that limits the search results by returning only
    -- places that are in a specified list of countries.
    --
    -- -   Valid values include
    --     <https://www.iso.org/iso-3166-country-codes.html ISO 3166> 3-digit
    --     country codes. For example, Australia uses three upper-case
    --     characters: @AUS@.
    SearchPlaceIndexForText -> Maybe (NonEmpty Text)
filterCountries :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | 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
    -- @Athens, Greece@, with the @language@ parameter set to @en@. The result
    -- found will most likely be returned as @Athens@.
    --
    -- If you set the @language@ parameter to @el@, for Greek, then the result
    -- found 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.
    SearchPlaceIndexForText -> Maybe Text
language :: Prelude.Maybe Prelude.Text,
    -- | An optional parameter. The maximum number of results returned per
    -- request.
    --
    -- The default: @50@
    SearchPlaceIndexForText -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The name of the place index resource you want to use for the search.
    SearchPlaceIndexForText -> Text
indexName :: Prelude.Text,
    -- | The address, name, city, or region to be used in the search in free-form
    -- text format. For example, @123 Any Street@.
    SearchPlaceIndexForText -> Sensitive Text
text :: Data.Sensitive Prelude.Text
  }
  deriving (SearchPlaceIndexForText -> SearchPlaceIndexForText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchPlaceIndexForText -> SearchPlaceIndexForText -> Bool
$c/= :: SearchPlaceIndexForText -> SearchPlaceIndexForText -> Bool
== :: SearchPlaceIndexForText -> SearchPlaceIndexForText -> Bool
$c== :: SearchPlaceIndexForText -> SearchPlaceIndexForText -> Bool
Prelude.Eq, Int -> SearchPlaceIndexForText -> ShowS
[SearchPlaceIndexForText] -> ShowS
SearchPlaceIndexForText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchPlaceIndexForText] -> ShowS
$cshowList :: [SearchPlaceIndexForText] -> ShowS
show :: SearchPlaceIndexForText -> String
$cshow :: SearchPlaceIndexForText -> String
showsPrec :: Int -> SearchPlaceIndexForText -> ShowS
$cshowsPrec :: Int -> SearchPlaceIndexForText -> ShowS
Prelude.Show, forall x. Rep SearchPlaceIndexForText x -> SearchPlaceIndexForText
forall x. SearchPlaceIndexForText -> Rep SearchPlaceIndexForText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchPlaceIndexForText x -> SearchPlaceIndexForText
$cfrom :: forall x. SearchPlaceIndexForText -> Rep SearchPlaceIndexForText x
Prelude.Generic)

-- |
-- Create a value of 'SearchPlaceIndexForText' 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:
--
-- 'biasPosition', 'searchPlaceIndexForText_biasPosition' - An optional parameter that indicates a preference for places that are
-- closer to a specified position.
--
-- If provided, this parameter must contain a pair of numbers. The first
-- number represents the X coordinate, or longitude; the second number
-- represents the Y coordinate, or latitude.
--
-- For example, @[-123.1174, 49.2847]@ represents the position with
-- longitude @-123.1174@ and latitude @49.2847@.
--
-- @BiasPosition@ and @FilterBBox@ are mutually exclusive. Specifying both
-- options results in an error.
--
-- 'filterBBox', 'searchPlaceIndexForText_filterBBox' - An optional parameter that limits the search results by returning only
-- places that are within the provided bounding box.
--
-- If provided, this parameter must contain a total of four consecutive
-- numbers in two pairs. The first pair of numbers represents the X and Y
-- coordinates (longitude and latitude, respectively) of the southwest
-- corner of the bounding box; the second pair of numbers represents the X
-- and Y coordinates (longitude and latitude, respectively) of the
-- northeast corner of the bounding box.
--
-- For example, @[-12.7935, -37.4835, -12.0684, -36.9542]@ represents a
-- bounding box where the southwest corner has longitude @-12.7935@ and
-- latitude @-37.4835@, and the northeast corner has longitude @-12.0684@
-- and latitude @-36.9542@.
--
-- @FilterBBox@ and @BiasPosition@ are mutually exclusive. Specifying both
-- options results in an error.
--
-- 'filterCountries', 'searchPlaceIndexForText_filterCountries' - An optional parameter that limits the search results by returning only
-- places that are in a specified list of countries.
--
-- -   Valid values include
--     <https://www.iso.org/iso-3166-country-codes.html ISO 3166> 3-digit
--     country codes. For example, Australia uses three upper-case
--     characters: @AUS@.
--
-- 'language', 'searchPlaceIndexForText_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
-- @Athens, Greece@, with the @language@ parameter set to @en@. The result
-- found will most likely be returned as @Athens@.
--
-- If you set the @language@ parameter to @el@, for Greek, then the result
-- found 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.
--
-- 'maxResults', 'searchPlaceIndexForText_maxResults' - An optional parameter. The maximum number of results returned per
-- request.
--
-- The default: @50@
--
-- 'indexName', 'searchPlaceIndexForText_indexName' - The name of the place index resource you want to use for the search.
--
-- 'text', 'searchPlaceIndexForText_text' - The address, name, city, or region to be used in the search in free-form
-- text format. For example, @123 Any Street@.
newSearchPlaceIndexForText ::
  -- | 'indexName'
  Prelude.Text ->
  -- | 'text'
  Prelude.Text ->
  SearchPlaceIndexForText
newSearchPlaceIndexForText :: Text -> Text -> SearchPlaceIndexForText
newSearchPlaceIndexForText Text
pIndexName_ Text
pText_ =
  SearchPlaceIndexForText'
    { $sel:biasPosition:SearchPlaceIndexForText' :: Maybe (Sensitive (NonEmpty Double))
biasPosition =
        forall a. Maybe a
Prelude.Nothing,
      $sel:filterBBox:SearchPlaceIndexForText' :: Maybe (Sensitive (NonEmpty Double))
filterBBox = forall a. Maybe a
Prelude.Nothing,
      $sel:filterCountries:SearchPlaceIndexForText' :: Maybe (NonEmpty Text)
filterCountries = forall a. Maybe a
Prelude.Nothing,
      $sel:language:SearchPlaceIndexForText' :: Maybe Text
language = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:SearchPlaceIndexForText' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:indexName:SearchPlaceIndexForText' :: Text
indexName = Text
pIndexName_,
      $sel:text:SearchPlaceIndexForText' :: Sensitive Text
text = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pText_
    }

-- | An optional parameter that indicates a preference for places that are
-- closer to a specified position.
--
-- If provided, this parameter must contain a pair of numbers. The first
-- number represents the X coordinate, or longitude; the second number
-- represents the Y coordinate, or latitude.
--
-- For example, @[-123.1174, 49.2847]@ represents the position with
-- longitude @-123.1174@ and latitude @49.2847@.
--
-- @BiasPosition@ and @FilterBBox@ are mutually exclusive. Specifying both
-- options results in an error.
searchPlaceIndexForText_biasPosition :: Lens.Lens' SearchPlaceIndexForText (Prelude.Maybe (Prelude.NonEmpty Prelude.Double))
searchPlaceIndexForText_biasPosition :: Lens' SearchPlaceIndexForText (Maybe (NonEmpty Double))
searchPlaceIndexForText_biasPosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForText' {Maybe (Sensitive (NonEmpty Double))
biasPosition :: Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
biasPosition} -> Maybe (Sensitive (NonEmpty Double))
biasPosition) (\s :: SearchPlaceIndexForText
s@SearchPlaceIndexForText' {} Maybe (Sensitive (NonEmpty Double))
a -> SearchPlaceIndexForText
s {$sel:biasPosition:SearchPlaceIndexForText' :: Maybe (Sensitive (NonEmpty Double))
biasPosition = Maybe (Sensitive (NonEmpty Double))
a} :: SearchPlaceIndexForText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | An optional parameter that limits the search results by returning only
-- places that are within the provided bounding box.
--
-- If provided, this parameter must contain a total of four consecutive
-- numbers in two pairs. The first pair of numbers represents the X and Y
-- coordinates (longitude and latitude, respectively) of the southwest
-- corner of the bounding box; the second pair of numbers represents the X
-- and Y coordinates (longitude and latitude, respectively) of the
-- northeast corner of the bounding box.
--
-- For example, @[-12.7935, -37.4835, -12.0684, -36.9542]@ represents a
-- bounding box where the southwest corner has longitude @-12.7935@ and
-- latitude @-37.4835@, and the northeast corner has longitude @-12.0684@
-- and latitude @-36.9542@.
--
-- @FilterBBox@ and @BiasPosition@ are mutually exclusive. Specifying both
-- options results in an error.
searchPlaceIndexForText_filterBBox :: Lens.Lens' SearchPlaceIndexForText (Prelude.Maybe (Prelude.NonEmpty Prelude.Double))
searchPlaceIndexForText_filterBBox :: Lens' SearchPlaceIndexForText (Maybe (NonEmpty Double))
searchPlaceIndexForText_filterBBox = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForText' {Maybe (Sensitive (NonEmpty Double))
filterBBox :: Maybe (Sensitive (NonEmpty Double))
$sel:filterBBox:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
filterBBox} -> Maybe (Sensitive (NonEmpty Double))
filterBBox) (\s :: SearchPlaceIndexForText
s@SearchPlaceIndexForText' {} Maybe (Sensitive (NonEmpty Double))
a -> SearchPlaceIndexForText
s {$sel:filterBBox:SearchPlaceIndexForText' :: Maybe (Sensitive (NonEmpty Double))
filterBBox = Maybe (Sensitive (NonEmpty Double))
a} :: SearchPlaceIndexForText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | An optional parameter that limits the search results by returning only
-- places that are in a specified list of countries.
--
-- -   Valid values include
--     <https://www.iso.org/iso-3166-country-codes.html ISO 3166> 3-digit
--     country codes. For example, Australia uses three upper-case
--     characters: @AUS@.
searchPlaceIndexForText_filterCountries :: Lens.Lens' SearchPlaceIndexForText (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
searchPlaceIndexForText_filterCountries :: Lens' SearchPlaceIndexForText (Maybe (NonEmpty Text))
searchPlaceIndexForText_filterCountries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForText' {Maybe (NonEmpty Text)
filterCountries :: Maybe (NonEmpty Text)
$sel:filterCountries:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (NonEmpty Text)
filterCountries} -> Maybe (NonEmpty Text)
filterCountries) (\s :: SearchPlaceIndexForText
s@SearchPlaceIndexForText' {} Maybe (NonEmpty Text)
a -> SearchPlaceIndexForText
s {$sel:filterCountries:SearchPlaceIndexForText' :: Maybe (NonEmpty Text)
filterCountries = Maybe (NonEmpty Text)
a} :: SearchPlaceIndexForText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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
-- @Athens, Greece@, with the @language@ parameter set to @en@. The result
-- found will most likely be returned as @Athens@.
--
-- If you set the @language@ parameter to @el@, for Greek, then the result
-- found 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.
searchPlaceIndexForText_language :: Lens.Lens' SearchPlaceIndexForText (Prelude.Maybe Prelude.Text)
searchPlaceIndexForText_language :: Lens' SearchPlaceIndexForText (Maybe Text)
searchPlaceIndexForText_language = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForText' {Maybe Text
language :: Maybe Text
$sel:language:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Text
language} -> Maybe Text
language) (\s :: SearchPlaceIndexForText
s@SearchPlaceIndexForText' {} Maybe Text
a -> SearchPlaceIndexForText
s {$sel:language:SearchPlaceIndexForText' :: Maybe Text
language = Maybe Text
a} :: SearchPlaceIndexForText)

-- | An optional parameter. The maximum number of results returned per
-- request.
--
-- The default: @50@
searchPlaceIndexForText_maxResults :: Lens.Lens' SearchPlaceIndexForText (Prelude.Maybe Prelude.Natural)
searchPlaceIndexForText_maxResults :: Lens' SearchPlaceIndexForText (Maybe Natural)
searchPlaceIndexForText_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForText' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: SearchPlaceIndexForText
s@SearchPlaceIndexForText' {} Maybe Natural
a -> SearchPlaceIndexForText
s {$sel:maxResults:SearchPlaceIndexForText' :: Maybe Natural
maxResults = Maybe Natural
a} :: SearchPlaceIndexForText)

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

-- | The address, name, city, or region to be used in the search in free-form
-- text format. For example, @123 Any Street@.
searchPlaceIndexForText_text :: Lens.Lens' SearchPlaceIndexForText Prelude.Text
searchPlaceIndexForText_text :: Lens' SearchPlaceIndexForText Text
searchPlaceIndexForText_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForText' {Sensitive Text
text :: Sensitive Text
$sel:text:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Sensitive Text
text} -> Sensitive Text
text) (\s :: SearchPlaceIndexForText
s@SearchPlaceIndexForText' {} Sensitive Text
a -> SearchPlaceIndexForText
s {$sel:text:SearchPlaceIndexForText' :: Sensitive Text
text = Sensitive Text
a} :: SearchPlaceIndexForText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest SearchPlaceIndexForText where
  type
    AWSResponse SearchPlaceIndexForText =
      SearchPlaceIndexForTextResponse
  request :: (Service -> Service)
-> SearchPlaceIndexForText -> Request SearchPlaceIndexForText
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SearchPlaceIndexForText
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SearchPlaceIndexForText)))
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
-> [SearchForTextResult]
-> SearchPlaceIndexForTextSummary
-> SearchPlaceIndexForTextResponse
SearchPlaceIndexForTextResponse'
            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 (Maybe a)
Data..?> Key
"Results" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"Summary")
      )

instance Prelude.Hashable SearchPlaceIndexForText where
  hashWithSalt :: Int -> SearchPlaceIndexForText -> Int
hashWithSalt Int
_salt SearchPlaceIndexForText' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive (NonEmpty Double))
Text
Sensitive Text
text :: Sensitive Text
indexName :: Text
maxResults :: Maybe Natural
language :: Maybe Text
filterCountries :: Maybe (NonEmpty Text)
filterBBox :: Maybe (Sensitive (NonEmpty Double))
biasPosition :: Maybe (Sensitive (NonEmpty Double))
$sel:text:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Sensitive Text
$sel:indexName:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Text
$sel:maxResults:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Natural
$sel:language:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (NonEmpty Double))
biasPosition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (NonEmpty Double))
filterBBox
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
filterCountries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
language
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
text

instance Prelude.NFData SearchPlaceIndexForText where
  rnf :: SearchPlaceIndexForText -> ()
rnf SearchPlaceIndexForText' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive (NonEmpty Double))
Text
Sensitive Text
text :: Sensitive Text
indexName :: Text
maxResults :: Maybe Natural
language :: Maybe Text
filterCountries :: Maybe (NonEmpty Text)
filterBBox :: Maybe (Sensitive (NonEmpty Double))
biasPosition :: Maybe (Sensitive (NonEmpty Double))
$sel:text:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Sensitive Text
$sel:indexName:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Text
$sel:maxResults:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Natural
$sel:language:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (NonEmpty Double))
biasPosition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (NonEmpty Double))
filterBBox
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
filterCountries
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Natural
maxResults
      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 Sensitive Text
text

instance Data.ToHeaders SearchPlaceIndexForText where
  toHeaders :: SearchPlaceIndexForText -> 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.ToJSON SearchPlaceIndexForText where
  toJSON :: SearchPlaceIndexForText -> Value
toJSON SearchPlaceIndexForText' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive (NonEmpty Double))
Text
Sensitive Text
text :: Sensitive Text
indexName :: Text
maxResults :: Maybe Natural
language :: Maybe Text
filterCountries :: Maybe (NonEmpty Text)
filterBBox :: Maybe (Sensitive (NonEmpty Double))
biasPosition :: Maybe (Sensitive (NonEmpty Double))
$sel:text:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Sensitive Text
$sel:indexName:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Text
$sel:maxResults:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Natural
$sel:language:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BiasPosition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive (NonEmpty Double))
biasPosition,
            (Key
"FilterBBox" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive (NonEmpty Double))
filterBBox,
            (Key
"FilterCountries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
filterCountries,
            (Key
"Language" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
language,
            (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            forall a. a -> Maybe a
Prelude.Just (Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
text)
          ]
      )

instance Data.ToPath SearchPlaceIndexForText where
  toPath :: SearchPlaceIndexForText -> ByteString
toPath SearchPlaceIndexForText' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive (NonEmpty Double))
Text
Sensitive Text
text :: Sensitive Text
indexName :: Text
maxResults :: Maybe Natural
language :: Maybe Text
filterCountries :: Maybe (NonEmpty Text)
filterBBox :: Maybe (Sensitive (NonEmpty Double))
biasPosition :: Maybe (Sensitive (NonEmpty Double))
$sel:text:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Sensitive Text
$sel:indexName:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Text
$sel:maxResults:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Natural
$sel:language:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForText' :: SearchPlaceIndexForText -> Maybe (Sensitive (NonEmpty Double))
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/places/v0/indexes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
indexName,
        ByteString
"/search/text"
      ]

instance Data.ToQuery SearchPlaceIndexForText where
  toQuery :: SearchPlaceIndexForText -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newSearchPlaceIndexForTextResponse' smart constructor.
data SearchPlaceIndexForTextResponse = SearchPlaceIndexForTextResponse'
  { -- | The response's http status code.
    SearchPlaceIndexForTextResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of Places matching the input text. Each result contains
    -- additional information about the specific point of interest.
    --
    -- Not all response properties are included with all responses. Some
    -- properties may only be returned by specific data partners.
    SearchPlaceIndexForTextResponse -> [SearchForTextResult]
results :: [SearchForTextResult],
    -- | Contains a summary of the request. Echoes the input values for
    -- @BiasPosition@, @FilterBBox@, @FilterCountries@, @Language@,
    -- @MaxResults@, and @Text@. Also includes the @DataSource@ of the place
    -- index and the bounding box, @ResultBBox@, which surrounds the search
    -- results.
    SearchPlaceIndexForTextResponse -> SearchPlaceIndexForTextSummary
summary :: SearchPlaceIndexForTextSummary
  }
  deriving (SearchPlaceIndexForTextResponse
-> SearchPlaceIndexForTextResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchPlaceIndexForTextResponse
-> SearchPlaceIndexForTextResponse -> Bool
$c/= :: SearchPlaceIndexForTextResponse
-> SearchPlaceIndexForTextResponse -> Bool
== :: SearchPlaceIndexForTextResponse
-> SearchPlaceIndexForTextResponse -> Bool
$c== :: SearchPlaceIndexForTextResponse
-> SearchPlaceIndexForTextResponse -> Bool
Prelude.Eq, Int -> SearchPlaceIndexForTextResponse -> ShowS
[SearchPlaceIndexForTextResponse] -> ShowS
SearchPlaceIndexForTextResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchPlaceIndexForTextResponse] -> ShowS
$cshowList :: [SearchPlaceIndexForTextResponse] -> ShowS
show :: SearchPlaceIndexForTextResponse -> String
$cshow :: SearchPlaceIndexForTextResponse -> String
showsPrec :: Int -> SearchPlaceIndexForTextResponse -> ShowS
$cshowsPrec :: Int -> SearchPlaceIndexForTextResponse -> ShowS
Prelude.Show, forall x.
Rep SearchPlaceIndexForTextResponse x
-> SearchPlaceIndexForTextResponse
forall x.
SearchPlaceIndexForTextResponse
-> Rep SearchPlaceIndexForTextResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SearchPlaceIndexForTextResponse x
-> SearchPlaceIndexForTextResponse
$cfrom :: forall x.
SearchPlaceIndexForTextResponse
-> Rep SearchPlaceIndexForTextResponse x
Prelude.Generic)

-- |
-- Create a value of 'SearchPlaceIndexForTextResponse' 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', 'searchPlaceIndexForTextResponse_httpStatus' - The response's http status code.
--
-- 'results', 'searchPlaceIndexForTextResponse_results' - A list of Places matching the input text. Each result contains
-- additional information about the specific point of interest.
--
-- Not all response properties are included with all responses. Some
-- properties may only be returned by specific data partners.
--
-- 'summary', 'searchPlaceIndexForTextResponse_summary' - Contains a summary of the request. Echoes the input values for
-- @BiasPosition@, @FilterBBox@, @FilterCountries@, @Language@,
-- @MaxResults@, and @Text@. Also includes the @DataSource@ of the place
-- index and the bounding box, @ResultBBox@, which surrounds the search
-- results.
newSearchPlaceIndexForTextResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'summary'
  SearchPlaceIndexForTextSummary ->
  SearchPlaceIndexForTextResponse
newSearchPlaceIndexForTextResponse :: Int
-> SearchPlaceIndexForTextSummary
-> SearchPlaceIndexForTextResponse
newSearchPlaceIndexForTextResponse
  Int
pHttpStatus_
  SearchPlaceIndexForTextSummary
pSummary_ =
    SearchPlaceIndexForTextResponse'
      { $sel:httpStatus:SearchPlaceIndexForTextResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:results:SearchPlaceIndexForTextResponse' :: [SearchForTextResult]
results = forall a. Monoid a => a
Prelude.mempty,
        $sel:summary:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextSummary
summary = SearchPlaceIndexForTextSummary
pSummary_
      }

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

-- | A list of Places matching the input text. Each result contains
-- additional information about the specific point of interest.
--
-- Not all response properties are included with all responses. Some
-- properties may only be returned by specific data partners.
searchPlaceIndexForTextResponse_results :: Lens.Lens' SearchPlaceIndexForTextResponse [SearchForTextResult]
searchPlaceIndexForTextResponse_results :: Lens' SearchPlaceIndexForTextResponse [SearchForTextResult]
searchPlaceIndexForTextResponse_results = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForTextResponse' {[SearchForTextResult]
results :: [SearchForTextResult]
$sel:results:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextResponse -> [SearchForTextResult]
results} -> [SearchForTextResult]
results) (\s :: SearchPlaceIndexForTextResponse
s@SearchPlaceIndexForTextResponse' {} [SearchForTextResult]
a -> SearchPlaceIndexForTextResponse
s {$sel:results:SearchPlaceIndexForTextResponse' :: [SearchForTextResult]
results = [SearchForTextResult]
a} :: SearchPlaceIndexForTextResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Contains a summary of the request. Echoes the input values for
-- @BiasPosition@, @FilterBBox@, @FilterCountries@, @Language@,
-- @MaxResults@, and @Text@. Also includes the @DataSource@ of the place
-- index and the bounding box, @ResultBBox@, which surrounds the search
-- results.
searchPlaceIndexForTextResponse_summary :: Lens.Lens' SearchPlaceIndexForTextResponse SearchPlaceIndexForTextSummary
searchPlaceIndexForTextResponse_summary :: Lens'
  SearchPlaceIndexForTextResponse SearchPlaceIndexForTextSummary
searchPlaceIndexForTextResponse_summary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForTextResponse' {SearchPlaceIndexForTextSummary
summary :: SearchPlaceIndexForTextSummary
$sel:summary:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextResponse -> SearchPlaceIndexForTextSummary
summary} -> SearchPlaceIndexForTextSummary
summary) (\s :: SearchPlaceIndexForTextResponse
s@SearchPlaceIndexForTextResponse' {} SearchPlaceIndexForTextSummary
a -> SearchPlaceIndexForTextResponse
s {$sel:summary:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextSummary
summary = SearchPlaceIndexForTextSummary
a} :: SearchPlaceIndexForTextResponse)

instance
  Prelude.NFData
    SearchPlaceIndexForTextResponse
  where
  rnf :: SearchPlaceIndexForTextResponse -> ()
rnf SearchPlaceIndexForTextResponse' {Int
[SearchForTextResult]
SearchPlaceIndexForTextSummary
summary :: SearchPlaceIndexForTextSummary
results :: [SearchForTextResult]
httpStatus :: Int
$sel:summary:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextResponse -> SearchPlaceIndexForTextSummary
$sel:results:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextResponse -> [SearchForTextResult]
$sel:httpStatus:SearchPlaceIndexForTextResponse' :: SearchPlaceIndexForTextResponse -> 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 [SearchForTextResult]
results
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SearchPlaceIndexForTextSummary
summary