{-# 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.Kendra.GetQuerySuggestions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Fetches the queries that are suggested to your users.
--
-- @GetQuerySuggestions@ is currently not supported in the Amazon Web
-- Services GovCloud (US-West) region.
module Amazonka.Kendra.GetQuerySuggestions
  ( -- * Creating a Request
    GetQuerySuggestions (..),
    newGetQuerySuggestions,

    -- * Request Lenses
    getQuerySuggestions_maxSuggestionsCount,
    getQuerySuggestions_indexId,
    getQuerySuggestions_queryText,

    -- * Destructuring the Response
    GetQuerySuggestionsResponse (..),
    newGetQuerySuggestionsResponse,

    -- * Response Lenses
    getQuerySuggestionsResponse_querySuggestionsId,
    getQuerySuggestionsResponse_suggestions,
    getQuerySuggestionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetQuerySuggestions' smart constructor.
data GetQuerySuggestions = GetQuerySuggestions'
  { -- | The maximum number of query suggestions you want to show to your users.
    GetQuerySuggestions -> Maybe Int
maxSuggestionsCount :: Prelude.Maybe Prelude.Int,
    -- | The identifier of the index you want to get query suggestions from.
    GetQuerySuggestions -> Text
indexId :: Prelude.Text,
    -- | The text of a user\'s query to generate query suggestions.
    --
    -- A query is suggested if the query prefix matches what a user starts to
    -- type as their query.
    --
    -- Amazon Kendra does not show any suggestions if a user types fewer than
    -- two characters or more than 60 characters. A query must also have at
    -- least one search result and contain at least one word of more than four
    -- characters.
    GetQuerySuggestions -> Text
queryText :: Prelude.Text
  }
  deriving (GetQuerySuggestions -> GetQuerySuggestions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQuerySuggestions -> GetQuerySuggestions -> Bool
$c/= :: GetQuerySuggestions -> GetQuerySuggestions -> Bool
== :: GetQuerySuggestions -> GetQuerySuggestions -> Bool
$c== :: GetQuerySuggestions -> GetQuerySuggestions -> Bool
Prelude.Eq, ReadPrec [GetQuerySuggestions]
ReadPrec GetQuerySuggestions
Int -> ReadS GetQuerySuggestions
ReadS [GetQuerySuggestions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQuerySuggestions]
$creadListPrec :: ReadPrec [GetQuerySuggestions]
readPrec :: ReadPrec GetQuerySuggestions
$creadPrec :: ReadPrec GetQuerySuggestions
readList :: ReadS [GetQuerySuggestions]
$creadList :: ReadS [GetQuerySuggestions]
readsPrec :: Int -> ReadS GetQuerySuggestions
$creadsPrec :: Int -> ReadS GetQuerySuggestions
Prelude.Read, Int -> GetQuerySuggestions -> ShowS
[GetQuerySuggestions] -> ShowS
GetQuerySuggestions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQuerySuggestions] -> ShowS
$cshowList :: [GetQuerySuggestions] -> ShowS
show :: GetQuerySuggestions -> String
$cshow :: GetQuerySuggestions -> String
showsPrec :: Int -> GetQuerySuggestions -> ShowS
$cshowsPrec :: Int -> GetQuerySuggestions -> ShowS
Prelude.Show, forall x. Rep GetQuerySuggestions x -> GetQuerySuggestions
forall x. GetQuerySuggestions -> Rep GetQuerySuggestions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetQuerySuggestions x -> GetQuerySuggestions
$cfrom :: forall x. GetQuerySuggestions -> Rep GetQuerySuggestions x
Prelude.Generic)

-- |
-- Create a value of 'GetQuerySuggestions' 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:
--
-- 'maxSuggestionsCount', 'getQuerySuggestions_maxSuggestionsCount' - The maximum number of query suggestions you want to show to your users.
--
-- 'indexId', 'getQuerySuggestions_indexId' - The identifier of the index you want to get query suggestions from.
--
-- 'queryText', 'getQuerySuggestions_queryText' - The text of a user\'s query to generate query suggestions.
--
-- A query is suggested if the query prefix matches what a user starts to
-- type as their query.
--
-- Amazon Kendra does not show any suggestions if a user types fewer than
-- two characters or more than 60 characters. A query must also have at
-- least one search result and contain at least one word of more than four
-- characters.
newGetQuerySuggestions ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'queryText'
  Prelude.Text ->
  GetQuerySuggestions
newGetQuerySuggestions :: Text -> Text -> GetQuerySuggestions
newGetQuerySuggestions Text
pIndexId_ Text
pQueryText_ =
  GetQuerySuggestions'
    { $sel:maxSuggestionsCount:GetQuerySuggestions' :: Maybe Int
maxSuggestionsCount =
        forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:GetQuerySuggestions' :: Text
indexId = Text
pIndexId_,
      $sel:queryText:GetQuerySuggestions' :: Text
queryText = Text
pQueryText_
    }

-- | The maximum number of query suggestions you want to show to your users.
getQuerySuggestions_maxSuggestionsCount :: Lens.Lens' GetQuerySuggestions (Prelude.Maybe Prelude.Int)
getQuerySuggestions_maxSuggestionsCount :: Lens' GetQuerySuggestions (Maybe Int)
getQuerySuggestions_maxSuggestionsCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQuerySuggestions' {Maybe Int
maxSuggestionsCount :: Maybe Int
$sel:maxSuggestionsCount:GetQuerySuggestions' :: GetQuerySuggestions -> Maybe Int
maxSuggestionsCount} -> Maybe Int
maxSuggestionsCount) (\s :: GetQuerySuggestions
s@GetQuerySuggestions' {} Maybe Int
a -> GetQuerySuggestions
s {$sel:maxSuggestionsCount:GetQuerySuggestions' :: Maybe Int
maxSuggestionsCount = Maybe Int
a} :: GetQuerySuggestions)

-- | The identifier of the index you want to get query suggestions from.
getQuerySuggestions_indexId :: Lens.Lens' GetQuerySuggestions Prelude.Text
getQuerySuggestions_indexId :: Lens' GetQuerySuggestions Text
getQuerySuggestions_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQuerySuggestions' {Text
indexId :: Text
$sel:indexId:GetQuerySuggestions' :: GetQuerySuggestions -> Text
indexId} -> Text
indexId) (\s :: GetQuerySuggestions
s@GetQuerySuggestions' {} Text
a -> GetQuerySuggestions
s {$sel:indexId:GetQuerySuggestions' :: Text
indexId = Text
a} :: GetQuerySuggestions)

-- | The text of a user\'s query to generate query suggestions.
--
-- A query is suggested if the query prefix matches what a user starts to
-- type as their query.
--
-- Amazon Kendra does not show any suggestions if a user types fewer than
-- two characters or more than 60 characters. A query must also have at
-- least one search result and contain at least one word of more than four
-- characters.
getQuerySuggestions_queryText :: Lens.Lens' GetQuerySuggestions Prelude.Text
getQuerySuggestions_queryText :: Lens' GetQuerySuggestions Text
getQuerySuggestions_queryText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQuerySuggestions' {Text
queryText :: Text
$sel:queryText:GetQuerySuggestions' :: GetQuerySuggestions -> Text
queryText} -> Text
queryText) (\s :: GetQuerySuggestions
s@GetQuerySuggestions' {} Text
a -> GetQuerySuggestions
s {$sel:queryText:GetQuerySuggestions' :: Text
queryText = Text
a} :: GetQuerySuggestions)

instance Core.AWSRequest GetQuerySuggestions where
  type
    AWSResponse GetQuerySuggestions =
      GetQuerySuggestionsResponse
  request :: (Service -> Service)
-> GetQuerySuggestions -> Request GetQuerySuggestions
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 GetQuerySuggestions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetQuerySuggestions)))
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 ->
          Maybe Text
-> Maybe [Suggestion] -> Int -> GetQuerySuggestionsResponse
GetQuerySuggestionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"QuerySuggestionsId")
            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
"Suggestions" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetQuerySuggestions where
  hashWithSalt :: Int -> GetQuerySuggestions -> Int
hashWithSalt Int
_salt GetQuerySuggestions' {Maybe Int
Text
queryText :: Text
indexId :: Text
maxSuggestionsCount :: Maybe Int
$sel:queryText:GetQuerySuggestions' :: GetQuerySuggestions -> Text
$sel:indexId:GetQuerySuggestions' :: GetQuerySuggestions -> Text
$sel:maxSuggestionsCount:GetQuerySuggestions' :: GetQuerySuggestions -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxSuggestionsCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryText

instance Prelude.NFData GetQuerySuggestions where
  rnf :: GetQuerySuggestions -> ()
rnf GetQuerySuggestions' {Maybe Int
Text
queryText :: Text
indexId :: Text
maxSuggestionsCount :: Maybe Int
$sel:queryText:GetQuerySuggestions' :: GetQuerySuggestions -> Text
$sel:indexId:GetQuerySuggestions' :: GetQuerySuggestions -> Text
$sel:maxSuggestionsCount:GetQuerySuggestions' :: GetQuerySuggestions -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxSuggestionsCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
queryText

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

instance Data.ToJSON GetQuerySuggestions where
  toJSON :: GetQuerySuggestions -> Value
toJSON GetQuerySuggestions' {Maybe Int
Text
queryText :: Text
indexId :: Text
maxSuggestionsCount :: Maybe Int
$sel:queryText:GetQuerySuggestions' :: GetQuerySuggestions -> Text
$sel:indexId:GetQuerySuggestions' :: GetQuerySuggestions -> Text
$sel:maxSuggestionsCount:GetQuerySuggestions' :: GetQuerySuggestions -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxSuggestionsCount" 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 Int
maxSuggestionsCount,
            forall a. a -> Maybe a
Prelude.Just (Key
"IndexId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexId),
            forall a. a -> Maybe a
Prelude.Just (Key
"QueryText" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
queryText)
          ]
      )

instance Data.ToPath GetQuerySuggestions where
  toPath :: GetQuerySuggestions -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetQuerySuggestionsResponse' smart constructor.
data GetQuerySuggestionsResponse = GetQuerySuggestionsResponse'
  { -- | The identifier for a list of query suggestions for an index.
    GetQuerySuggestionsResponse -> Maybe Text
querySuggestionsId :: Prelude.Maybe Prelude.Text,
    -- | A list of query suggestions for an index.
    GetQuerySuggestionsResponse -> Maybe [Suggestion]
suggestions :: Prelude.Maybe [Suggestion],
    -- | The response's http status code.
    GetQuerySuggestionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetQuerySuggestionsResponse -> GetQuerySuggestionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQuerySuggestionsResponse -> GetQuerySuggestionsResponse -> Bool
$c/= :: GetQuerySuggestionsResponse -> GetQuerySuggestionsResponse -> Bool
== :: GetQuerySuggestionsResponse -> GetQuerySuggestionsResponse -> Bool
$c== :: GetQuerySuggestionsResponse -> GetQuerySuggestionsResponse -> Bool
Prelude.Eq, ReadPrec [GetQuerySuggestionsResponse]
ReadPrec GetQuerySuggestionsResponse
Int -> ReadS GetQuerySuggestionsResponse
ReadS [GetQuerySuggestionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQuerySuggestionsResponse]
$creadListPrec :: ReadPrec [GetQuerySuggestionsResponse]
readPrec :: ReadPrec GetQuerySuggestionsResponse
$creadPrec :: ReadPrec GetQuerySuggestionsResponse
readList :: ReadS [GetQuerySuggestionsResponse]
$creadList :: ReadS [GetQuerySuggestionsResponse]
readsPrec :: Int -> ReadS GetQuerySuggestionsResponse
$creadsPrec :: Int -> ReadS GetQuerySuggestionsResponse
Prelude.Read, Int -> GetQuerySuggestionsResponse -> ShowS
[GetQuerySuggestionsResponse] -> ShowS
GetQuerySuggestionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQuerySuggestionsResponse] -> ShowS
$cshowList :: [GetQuerySuggestionsResponse] -> ShowS
show :: GetQuerySuggestionsResponse -> String
$cshow :: GetQuerySuggestionsResponse -> String
showsPrec :: Int -> GetQuerySuggestionsResponse -> ShowS
$cshowsPrec :: Int -> GetQuerySuggestionsResponse -> ShowS
Prelude.Show, forall x.
Rep GetQuerySuggestionsResponse x -> GetQuerySuggestionsResponse
forall x.
GetQuerySuggestionsResponse -> Rep GetQuerySuggestionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetQuerySuggestionsResponse x -> GetQuerySuggestionsResponse
$cfrom :: forall x.
GetQuerySuggestionsResponse -> Rep GetQuerySuggestionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetQuerySuggestionsResponse' 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:
--
-- 'querySuggestionsId', 'getQuerySuggestionsResponse_querySuggestionsId' - The identifier for a list of query suggestions for an index.
--
-- 'suggestions', 'getQuerySuggestionsResponse_suggestions' - A list of query suggestions for an index.
--
-- 'httpStatus', 'getQuerySuggestionsResponse_httpStatus' - The response's http status code.
newGetQuerySuggestionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetQuerySuggestionsResponse
newGetQuerySuggestionsResponse :: Int -> GetQuerySuggestionsResponse
newGetQuerySuggestionsResponse Int
pHttpStatus_ =
  GetQuerySuggestionsResponse'
    { $sel:querySuggestionsId:GetQuerySuggestionsResponse' :: Maybe Text
querySuggestionsId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:suggestions:GetQuerySuggestionsResponse' :: Maybe [Suggestion]
suggestions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetQuerySuggestionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier for a list of query suggestions for an index.
getQuerySuggestionsResponse_querySuggestionsId :: Lens.Lens' GetQuerySuggestionsResponse (Prelude.Maybe Prelude.Text)
getQuerySuggestionsResponse_querySuggestionsId :: Lens' GetQuerySuggestionsResponse (Maybe Text)
getQuerySuggestionsResponse_querySuggestionsId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQuerySuggestionsResponse' {Maybe Text
querySuggestionsId :: Maybe Text
$sel:querySuggestionsId:GetQuerySuggestionsResponse' :: GetQuerySuggestionsResponse -> Maybe Text
querySuggestionsId} -> Maybe Text
querySuggestionsId) (\s :: GetQuerySuggestionsResponse
s@GetQuerySuggestionsResponse' {} Maybe Text
a -> GetQuerySuggestionsResponse
s {$sel:querySuggestionsId:GetQuerySuggestionsResponse' :: Maybe Text
querySuggestionsId = Maybe Text
a} :: GetQuerySuggestionsResponse)

-- | A list of query suggestions for an index.
getQuerySuggestionsResponse_suggestions :: Lens.Lens' GetQuerySuggestionsResponse (Prelude.Maybe [Suggestion])
getQuerySuggestionsResponse_suggestions :: Lens' GetQuerySuggestionsResponse (Maybe [Suggestion])
getQuerySuggestionsResponse_suggestions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQuerySuggestionsResponse' {Maybe [Suggestion]
suggestions :: Maybe [Suggestion]
$sel:suggestions:GetQuerySuggestionsResponse' :: GetQuerySuggestionsResponse -> Maybe [Suggestion]
suggestions} -> Maybe [Suggestion]
suggestions) (\s :: GetQuerySuggestionsResponse
s@GetQuerySuggestionsResponse' {} Maybe [Suggestion]
a -> GetQuerySuggestionsResponse
s {$sel:suggestions:GetQuerySuggestionsResponse' :: Maybe [Suggestion]
suggestions = Maybe [Suggestion]
a} :: GetQuerySuggestionsResponse) 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 response's http status code.
getQuerySuggestionsResponse_httpStatus :: Lens.Lens' GetQuerySuggestionsResponse Prelude.Int
getQuerySuggestionsResponse_httpStatus :: Lens' GetQuerySuggestionsResponse Int
getQuerySuggestionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQuerySuggestionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetQuerySuggestionsResponse' :: GetQuerySuggestionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetQuerySuggestionsResponse
s@GetQuerySuggestionsResponse' {} Int
a -> GetQuerySuggestionsResponse
s {$sel:httpStatus:GetQuerySuggestionsResponse' :: Int
httpStatus = Int
a} :: GetQuerySuggestionsResponse)

instance Prelude.NFData GetQuerySuggestionsResponse where
  rnf :: GetQuerySuggestionsResponse -> ()
rnf GetQuerySuggestionsResponse' {Int
Maybe [Suggestion]
Maybe Text
httpStatus :: Int
suggestions :: Maybe [Suggestion]
querySuggestionsId :: Maybe Text
$sel:httpStatus:GetQuerySuggestionsResponse' :: GetQuerySuggestionsResponse -> Int
$sel:suggestions:GetQuerySuggestionsResponse' :: GetQuerySuggestionsResponse -> Maybe [Suggestion]
$sel:querySuggestionsId:GetQuerySuggestionsResponse' :: GetQuerySuggestionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
querySuggestionsId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Suggestion]
suggestions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus