{-# 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.SearchPlaceIndexForSuggestions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates suggestions for addresses and points of interest based on
-- partial or misspelled free-form text. This operation is also known as
-- autocomplete, autosuggest, or fuzzy matching.
--
-- 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 suggested place names near a specified position by
-- using @BiasPosition@, or filter results within a bounding box by using
-- @FilterBBox@. These parameters are mutually exclusive; using both
-- @BiasPosition@ and @FilterBBox@ in the same command returns an error.
module Amazonka.Location.SearchPlaceIndexForSuggestions
  ( -- * Creating a Request
    SearchPlaceIndexForSuggestions (..),
    newSearchPlaceIndexForSuggestions,

    -- * Request Lenses
    searchPlaceIndexForSuggestions_biasPosition,
    searchPlaceIndexForSuggestions_filterBBox,
    searchPlaceIndexForSuggestions_filterCountries,
    searchPlaceIndexForSuggestions_language,
    searchPlaceIndexForSuggestions_maxResults,
    searchPlaceIndexForSuggestions_indexName,
    searchPlaceIndexForSuggestions_text,

    -- * Destructuring the Response
    SearchPlaceIndexForSuggestionsResponse (..),
    newSearchPlaceIndexForSuggestionsResponse,

    -- * Response Lenses
    searchPlaceIndexForSuggestionsResponse_httpStatus,
    searchPlaceIndexForSuggestionsResponse_results,
    searchPlaceIndexForSuggestionsResponse_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:/ 'newSearchPlaceIndexForSuggestions' smart constructor.
data SearchPlaceIndexForSuggestions = SearchPlaceIndexForSuggestions'
  { -- | An optional parameter that indicates a preference for place suggestions
    -- 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.
    SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
biasPosition :: Prelude.Maybe (Data.Sensitive (Prelude.NonEmpty Prelude.Double)),
    -- | An optional parameter that limits the search results by returning only
    -- suggestions within a specified 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.
    SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
filterBBox :: Prelude.Maybe (Data.Sensitive (Prelude.NonEmpty Prelude.Double)),
    -- | An optional parameter that limits the search results by returning only
    -- suggestions within the provided list of countries.
    --
    -- -   Use the <https://www.iso.org/iso-3166-country-codes.html ISO 3166>
    --     3-digit country code. For example, Australia uses three upper-case
    --     characters: @AUS@.
    SearchPlaceIndexForSuggestions -> 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. 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, Gr@ to get suggestions with the @language@ parameter set to
    -- @en@. The results found will most likely be returned as
    -- @Athens, Greece@.
    --
    -- 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.
    SearchPlaceIndexForSuggestions -> Maybe Text
language :: Prelude.Maybe Prelude.Text,
    -- | An optional parameter. The maximum number of results returned per
    -- request.
    --
    -- The default: @5@
    SearchPlaceIndexForSuggestions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The name of the place index resource you want to use for the search.
    SearchPlaceIndexForSuggestions -> Text
indexName :: Prelude.Text,
    -- | The free-form partial text to use to generate place suggestions. For
    -- example, @eiffel tow@.
    SearchPlaceIndexForSuggestions -> Sensitive Text
text :: Data.Sensitive Prelude.Text
  }
  deriving (SearchPlaceIndexForSuggestions
-> SearchPlaceIndexForSuggestions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchPlaceIndexForSuggestions
-> SearchPlaceIndexForSuggestions -> Bool
$c/= :: SearchPlaceIndexForSuggestions
-> SearchPlaceIndexForSuggestions -> Bool
== :: SearchPlaceIndexForSuggestions
-> SearchPlaceIndexForSuggestions -> Bool
$c== :: SearchPlaceIndexForSuggestions
-> SearchPlaceIndexForSuggestions -> Bool
Prelude.Eq, Int -> SearchPlaceIndexForSuggestions -> ShowS
[SearchPlaceIndexForSuggestions] -> ShowS
SearchPlaceIndexForSuggestions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchPlaceIndexForSuggestions] -> ShowS
$cshowList :: [SearchPlaceIndexForSuggestions] -> ShowS
show :: SearchPlaceIndexForSuggestions -> String
$cshow :: SearchPlaceIndexForSuggestions -> String
showsPrec :: Int -> SearchPlaceIndexForSuggestions -> ShowS
$cshowsPrec :: Int -> SearchPlaceIndexForSuggestions -> ShowS
Prelude.Show, forall x.
Rep SearchPlaceIndexForSuggestions x
-> SearchPlaceIndexForSuggestions
forall x.
SearchPlaceIndexForSuggestions
-> Rep SearchPlaceIndexForSuggestions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SearchPlaceIndexForSuggestions x
-> SearchPlaceIndexForSuggestions
$cfrom :: forall x.
SearchPlaceIndexForSuggestions
-> Rep SearchPlaceIndexForSuggestions x
Prelude.Generic)

-- |
-- Create a value of 'SearchPlaceIndexForSuggestions' 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', 'searchPlaceIndexForSuggestions_biasPosition' - An optional parameter that indicates a preference for place suggestions
-- 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', 'searchPlaceIndexForSuggestions_filterBBox' - An optional parameter that limits the search results by returning only
-- suggestions within a specified 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', 'searchPlaceIndexForSuggestions_filterCountries' - An optional parameter that limits the search results by returning only
-- suggestions within the provided list of countries.
--
-- -   Use the <https://www.iso.org/iso-3166-country-codes.html ISO 3166>
--     3-digit country code. For example, Australia uses three upper-case
--     characters: @AUS@.
--
-- 'language', 'searchPlaceIndexForSuggestions_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. 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, Gr@ to get suggestions with the @language@ parameter set to
-- @en@. The results found will most likely be returned as
-- @Athens, Greece@.
--
-- 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', 'searchPlaceIndexForSuggestions_maxResults' - An optional parameter. The maximum number of results returned per
-- request.
--
-- The default: @5@
--
-- 'indexName', 'searchPlaceIndexForSuggestions_indexName' - The name of the place index resource you want to use for the search.
--
-- 'text', 'searchPlaceIndexForSuggestions_text' - The free-form partial text to use to generate place suggestions. For
-- example, @eiffel tow@.
newSearchPlaceIndexForSuggestions ::
  -- | 'indexName'
  Prelude.Text ->
  -- | 'text'
  Prelude.Text ->
  SearchPlaceIndexForSuggestions
newSearchPlaceIndexForSuggestions :: Text -> Text -> SearchPlaceIndexForSuggestions
newSearchPlaceIndexForSuggestions Text
pIndexName_ Text
pText_ =
  SearchPlaceIndexForSuggestions'
    { $sel:biasPosition:SearchPlaceIndexForSuggestions' :: Maybe (Sensitive (NonEmpty Double))
biasPosition =
        forall a. Maybe a
Prelude.Nothing,
      $sel:filterBBox:SearchPlaceIndexForSuggestions' :: Maybe (Sensitive (NonEmpty Double))
filterBBox = forall a. Maybe a
Prelude.Nothing,
      $sel:filterCountries:SearchPlaceIndexForSuggestions' :: Maybe (NonEmpty Text)
filterCountries = forall a. Maybe a
Prelude.Nothing,
      $sel:language:SearchPlaceIndexForSuggestions' :: Maybe Text
language = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:SearchPlaceIndexForSuggestions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:indexName:SearchPlaceIndexForSuggestions' :: Text
indexName = Text
pIndexName_,
      $sel:text:SearchPlaceIndexForSuggestions' :: 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 place suggestions
-- 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.
searchPlaceIndexForSuggestions_biasPosition :: Lens.Lens' SearchPlaceIndexForSuggestions (Prelude.Maybe (Prelude.NonEmpty Prelude.Double))
searchPlaceIndexForSuggestions_biasPosition :: Lens' SearchPlaceIndexForSuggestions (Maybe (NonEmpty Double))
searchPlaceIndexForSuggestions_biasPosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestions' {Maybe (Sensitive (NonEmpty Double))
biasPosition :: Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
biasPosition} -> Maybe (Sensitive (NonEmpty Double))
biasPosition) (\s :: SearchPlaceIndexForSuggestions
s@SearchPlaceIndexForSuggestions' {} Maybe (Sensitive (NonEmpty Double))
a -> SearchPlaceIndexForSuggestions
s {$sel:biasPosition:SearchPlaceIndexForSuggestions' :: Maybe (Sensitive (NonEmpty Double))
biasPosition = Maybe (Sensitive (NonEmpty Double))
a} :: SearchPlaceIndexForSuggestions) 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
-- suggestions within a specified 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.
searchPlaceIndexForSuggestions_filterBBox :: Lens.Lens' SearchPlaceIndexForSuggestions (Prelude.Maybe (Prelude.NonEmpty Prelude.Double))
searchPlaceIndexForSuggestions_filterBBox :: Lens' SearchPlaceIndexForSuggestions (Maybe (NonEmpty Double))
searchPlaceIndexForSuggestions_filterBBox = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestions' {Maybe (Sensitive (NonEmpty Double))
filterBBox :: Maybe (Sensitive (NonEmpty Double))
$sel:filterBBox:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
filterBBox} -> Maybe (Sensitive (NonEmpty Double))
filterBBox) (\s :: SearchPlaceIndexForSuggestions
s@SearchPlaceIndexForSuggestions' {} Maybe (Sensitive (NonEmpty Double))
a -> SearchPlaceIndexForSuggestions
s {$sel:filterBBox:SearchPlaceIndexForSuggestions' :: Maybe (Sensitive (NonEmpty Double))
filterBBox = Maybe (Sensitive (NonEmpty Double))
a} :: SearchPlaceIndexForSuggestions) 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
-- suggestions within the provided list of countries.
--
-- -   Use the <https://www.iso.org/iso-3166-country-codes.html ISO 3166>
--     3-digit country code. For example, Australia uses three upper-case
--     characters: @AUS@.
searchPlaceIndexForSuggestions_filterCountries :: Lens.Lens' SearchPlaceIndexForSuggestions (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
searchPlaceIndexForSuggestions_filterCountries :: Lens' SearchPlaceIndexForSuggestions (Maybe (NonEmpty Text))
searchPlaceIndexForSuggestions_filterCountries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestions' {Maybe (NonEmpty Text)
filterCountries :: Maybe (NonEmpty Text)
$sel:filterCountries:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe (NonEmpty Text)
filterCountries} -> Maybe (NonEmpty Text)
filterCountries) (\s :: SearchPlaceIndexForSuggestions
s@SearchPlaceIndexForSuggestions' {} Maybe (NonEmpty Text)
a -> SearchPlaceIndexForSuggestions
s {$sel:filterCountries:SearchPlaceIndexForSuggestions' :: Maybe (NonEmpty Text)
filterCountries = Maybe (NonEmpty Text)
a} :: SearchPlaceIndexForSuggestions) 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. 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, Gr@ to get suggestions with the @language@ parameter set to
-- @en@. The results found will most likely be returned as
-- @Athens, Greece@.
--
-- 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.
searchPlaceIndexForSuggestions_language :: Lens.Lens' SearchPlaceIndexForSuggestions (Prelude.Maybe Prelude.Text)
searchPlaceIndexForSuggestions_language :: Lens' SearchPlaceIndexForSuggestions (Maybe Text)
searchPlaceIndexForSuggestions_language = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestions' {Maybe Text
language :: Maybe Text
$sel:language:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Text
language} -> Maybe Text
language) (\s :: SearchPlaceIndexForSuggestions
s@SearchPlaceIndexForSuggestions' {} Maybe Text
a -> SearchPlaceIndexForSuggestions
s {$sel:language:SearchPlaceIndexForSuggestions' :: Maybe Text
language = Maybe Text
a} :: SearchPlaceIndexForSuggestions)

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

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

-- | The free-form partial text to use to generate place suggestions. For
-- example, @eiffel tow@.
searchPlaceIndexForSuggestions_text :: Lens.Lens' SearchPlaceIndexForSuggestions Prelude.Text
searchPlaceIndexForSuggestions_text :: Lens' SearchPlaceIndexForSuggestions Text
searchPlaceIndexForSuggestions_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestions' {Sensitive Text
text :: Sensitive Text
$sel:text:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Sensitive Text
text} -> Sensitive Text
text) (\s :: SearchPlaceIndexForSuggestions
s@SearchPlaceIndexForSuggestions' {} Sensitive Text
a -> SearchPlaceIndexForSuggestions
s {$sel:text:SearchPlaceIndexForSuggestions' :: Sensitive Text
text = Sensitive Text
a} :: SearchPlaceIndexForSuggestions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance
  Core.AWSRequest
    SearchPlaceIndexForSuggestions
  where
  type
    AWSResponse SearchPlaceIndexForSuggestions =
      SearchPlaceIndexForSuggestionsResponse
  request :: (Service -> Service)
-> SearchPlaceIndexForSuggestions
-> Request SearchPlaceIndexForSuggestions
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 SearchPlaceIndexForSuggestions
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse SearchPlaceIndexForSuggestions)))
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
-> [SearchForSuggestionsResult]
-> SearchPlaceIndexForSuggestionsSummary
-> SearchPlaceIndexForSuggestionsResponse
SearchPlaceIndexForSuggestionsResponse'
            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
    SearchPlaceIndexForSuggestions
  where
  hashWithSalt :: Int -> SearchPlaceIndexForSuggestions -> Int
hashWithSalt
    Int
_salt
    SearchPlaceIndexForSuggestions' {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:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Sensitive Text
$sel:indexName:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Text
$sel:maxResults:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Natural
$sel:language:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> 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
    SearchPlaceIndexForSuggestions
  where
  rnf :: SearchPlaceIndexForSuggestions -> ()
rnf SearchPlaceIndexForSuggestions' {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:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Sensitive Text
$sel:indexName:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Text
$sel:maxResults:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Natural
$sel:language:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> 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
    SearchPlaceIndexForSuggestions
  where
  toHeaders :: SearchPlaceIndexForSuggestions -> 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 SearchPlaceIndexForSuggestions where
  toJSON :: SearchPlaceIndexForSuggestions -> Value
toJSON SearchPlaceIndexForSuggestions' {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:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Sensitive Text
$sel:indexName:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Text
$sel:maxResults:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Natural
$sel:language:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> 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 SearchPlaceIndexForSuggestions where
  toPath :: SearchPlaceIndexForSuggestions -> ByteString
toPath SearchPlaceIndexForSuggestions' {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:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Sensitive Text
$sel:indexName:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Text
$sel:maxResults:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Natural
$sel:language:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe Text
$sel:filterCountries:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions -> Maybe (NonEmpty Text)
$sel:filterBBox:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> Maybe (Sensitive (NonEmpty Double))
$sel:biasPosition:SearchPlaceIndexForSuggestions' :: SearchPlaceIndexForSuggestions
-> 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/suggestions"
      ]

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

-- | /See:/ 'newSearchPlaceIndexForSuggestionsResponse' smart constructor.
data SearchPlaceIndexForSuggestionsResponse = SearchPlaceIndexForSuggestionsResponse'
  { -- | The response's http status code.
    SearchPlaceIndexForSuggestionsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of place suggestions that best match the search text.
    SearchPlaceIndexForSuggestionsResponse
-> [SearchForSuggestionsResult]
results :: [SearchForSuggestionsResult],
    -- | 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.
    SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsSummary
summary :: SearchPlaceIndexForSuggestionsSummary
  }
  deriving (SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsResponse -> Bool
$c/= :: SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsResponse -> Bool
== :: SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsResponse -> Bool
$c== :: SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsResponse -> Bool
Prelude.Eq, Int -> SearchPlaceIndexForSuggestionsResponse -> ShowS
[SearchPlaceIndexForSuggestionsResponse] -> ShowS
SearchPlaceIndexForSuggestionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchPlaceIndexForSuggestionsResponse] -> ShowS
$cshowList :: [SearchPlaceIndexForSuggestionsResponse] -> ShowS
show :: SearchPlaceIndexForSuggestionsResponse -> String
$cshow :: SearchPlaceIndexForSuggestionsResponse -> String
showsPrec :: Int -> SearchPlaceIndexForSuggestionsResponse -> ShowS
$cshowsPrec :: Int -> SearchPlaceIndexForSuggestionsResponse -> ShowS
Prelude.Show, forall x.
Rep SearchPlaceIndexForSuggestionsResponse x
-> SearchPlaceIndexForSuggestionsResponse
forall x.
SearchPlaceIndexForSuggestionsResponse
-> Rep SearchPlaceIndexForSuggestionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SearchPlaceIndexForSuggestionsResponse x
-> SearchPlaceIndexForSuggestionsResponse
$cfrom :: forall x.
SearchPlaceIndexForSuggestionsResponse
-> Rep SearchPlaceIndexForSuggestionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'SearchPlaceIndexForSuggestionsResponse' 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', 'searchPlaceIndexForSuggestionsResponse_httpStatus' - The response's http status code.
--
-- 'results', 'searchPlaceIndexForSuggestionsResponse_results' - A list of place suggestions that best match the search text.
--
-- 'summary', 'searchPlaceIndexForSuggestionsResponse_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.
newSearchPlaceIndexForSuggestionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'summary'
  SearchPlaceIndexForSuggestionsSummary ->
  SearchPlaceIndexForSuggestionsResponse
newSearchPlaceIndexForSuggestionsResponse :: Int
-> SearchPlaceIndexForSuggestionsSummary
-> SearchPlaceIndexForSuggestionsResponse
newSearchPlaceIndexForSuggestionsResponse
  Int
pHttpStatus_
  SearchPlaceIndexForSuggestionsSummary
pSummary_ =
    SearchPlaceIndexForSuggestionsResponse'
      { $sel:httpStatus:SearchPlaceIndexForSuggestionsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:results:SearchPlaceIndexForSuggestionsResponse' :: [SearchForSuggestionsResult]
results = forall a. Monoid a => a
Prelude.mempty,
        $sel:summary:SearchPlaceIndexForSuggestionsResponse' :: SearchPlaceIndexForSuggestionsSummary
summary = SearchPlaceIndexForSuggestionsSummary
pSummary_
      }

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

-- | A list of place suggestions that best match the search text.
searchPlaceIndexForSuggestionsResponse_results :: Lens.Lens' SearchPlaceIndexForSuggestionsResponse [SearchForSuggestionsResult]
searchPlaceIndexForSuggestionsResponse_results :: Lens'
  SearchPlaceIndexForSuggestionsResponse [SearchForSuggestionsResult]
searchPlaceIndexForSuggestionsResponse_results = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestionsResponse' {[SearchForSuggestionsResult]
results :: [SearchForSuggestionsResult]
$sel:results:SearchPlaceIndexForSuggestionsResponse' :: SearchPlaceIndexForSuggestionsResponse
-> [SearchForSuggestionsResult]
results} -> [SearchForSuggestionsResult]
results) (\s :: SearchPlaceIndexForSuggestionsResponse
s@SearchPlaceIndexForSuggestionsResponse' {} [SearchForSuggestionsResult]
a -> SearchPlaceIndexForSuggestionsResponse
s {$sel:results:SearchPlaceIndexForSuggestionsResponse' :: [SearchForSuggestionsResult]
results = [SearchForSuggestionsResult]
a} :: SearchPlaceIndexForSuggestionsResponse) 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.
searchPlaceIndexForSuggestionsResponse_summary :: Lens.Lens' SearchPlaceIndexForSuggestionsResponse SearchPlaceIndexForSuggestionsSummary
searchPlaceIndexForSuggestionsResponse_summary :: Lens'
  SearchPlaceIndexForSuggestionsResponse
  SearchPlaceIndexForSuggestionsSummary
searchPlaceIndexForSuggestionsResponse_summary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchPlaceIndexForSuggestionsResponse' {SearchPlaceIndexForSuggestionsSummary
summary :: SearchPlaceIndexForSuggestionsSummary
$sel:summary:SearchPlaceIndexForSuggestionsResponse' :: SearchPlaceIndexForSuggestionsResponse
-> SearchPlaceIndexForSuggestionsSummary
summary} -> SearchPlaceIndexForSuggestionsSummary
summary) (\s :: SearchPlaceIndexForSuggestionsResponse
s@SearchPlaceIndexForSuggestionsResponse' {} SearchPlaceIndexForSuggestionsSummary
a -> SearchPlaceIndexForSuggestionsResponse
s {$sel:summary:SearchPlaceIndexForSuggestionsResponse' :: SearchPlaceIndexForSuggestionsSummary
summary = SearchPlaceIndexForSuggestionsSummary
a} :: SearchPlaceIndexForSuggestionsResponse)

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