{-# 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.Transcribe.ListVocabularyFilters
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides a list of custom vocabulary filters that match the specified
-- criteria. If no criteria are specified, all custom vocabularies are
-- returned.
--
-- To get detailed information about a specific custom vocabulary filter,
-- use the operation.
module Amazonka.Transcribe.ListVocabularyFilters
  ( -- * Creating a Request
    ListVocabularyFilters (..),
    newListVocabularyFilters,

    -- * Request Lenses
    listVocabularyFilters_maxResults,
    listVocabularyFilters_nameContains,
    listVocabularyFilters_nextToken,

    -- * Destructuring the Response
    ListVocabularyFiltersResponse (..),
    newListVocabularyFiltersResponse,

    -- * Response Lenses
    listVocabularyFiltersResponse_nextToken,
    listVocabularyFiltersResponse_vocabularyFilters,
    listVocabularyFiltersResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListVocabularyFilters' smart constructor.
data ListVocabularyFilters = ListVocabularyFilters'
  { -- | The maximum number of custom vocabulary filters to return in each page
    -- of results. If there are fewer results than the value that you specify,
    -- only the actual results are returned. If you don\'t specify a value, a
    -- default of 5 is used.
    ListVocabularyFilters -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Returns only the custom vocabulary filters that contain the specified
    -- string. The search is not case sensitive.
    ListVocabularyFilters -> Maybe Text
nameContains :: Prelude.Maybe Prelude.Text,
    -- | If your @ListVocabularyFilters@ request returns more results than can be
    -- displayed, @NextToken@ is displayed in the response with an associated
    -- string. To get the next page of results, copy this string and repeat
    -- your request, including @NextToken@ with the value of the copied string.
    -- Repeat as needed to view all your results.
    ListVocabularyFilters -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListVocabularyFilters -> ListVocabularyFilters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVocabularyFilters -> ListVocabularyFilters -> Bool
$c/= :: ListVocabularyFilters -> ListVocabularyFilters -> Bool
== :: ListVocabularyFilters -> ListVocabularyFilters -> Bool
$c== :: ListVocabularyFilters -> ListVocabularyFilters -> Bool
Prelude.Eq, ReadPrec [ListVocabularyFilters]
ReadPrec ListVocabularyFilters
Int -> ReadS ListVocabularyFilters
ReadS [ListVocabularyFilters]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVocabularyFilters]
$creadListPrec :: ReadPrec [ListVocabularyFilters]
readPrec :: ReadPrec ListVocabularyFilters
$creadPrec :: ReadPrec ListVocabularyFilters
readList :: ReadS [ListVocabularyFilters]
$creadList :: ReadS [ListVocabularyFilters]
readsPrec :: Int -> ReadS ListVocabularyFilters
$creadsPrec :: Int -> ReadS ListVocabularyFilters
Prelude.Read, Int -> ListVocabularyFilters -> ShowS
[ListVocabularyFilters] -> ShowS
ListVocabularyFilters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVocabularyFilters] -> ShowS
$cshowList :: [ListVocabularyFilters] -> ShowS
show :: ListVocabularyFilters -> String
$cshow :: ListVocabularyFilters -> String
showsPrec :: Int -> ListVocabularyFilters -> ShowS
$cshowsPrec :: Int -> ListVocabularyFilters -> ShowS
Prelude.Show, forall x. Rep ListVocabularyFilters x -> ListVocabularyFilters
forall x. ListVocabularyFilters -> Rep ListVocabularyFilters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListVocabularyFilters x -> ListVocabularyFilters
$cfrom :: forall x. ListVocabularyFilters -> Rep ListVocabularyFilters x
Prelude.Generic)

-- |
-- Create a value of 'ListVocabularyFilters' 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:
--
-- 'maxResults', 'listVocabularyFilters_maxResults' - The maximum number of custom vocabulary filters to return in each page
-- of results. If there are fewer results than the value that you specify,
-- only the actual results are returned. If you don\'t specify a value, a
-- default of 5 is used.
--
-- 'nameContains', 'listVocabularyFilters_nameContains' - Returns only the custom vocabulary filters that contain the specified
-- string. The search is not case sensitive.
--
-- 'nextToken', 'listVocabularyFilters_nextToken' - If your @ListVocabularyFilters@ request returns more results than can be
-- displayed, @NextToken@ is displayed in the response with an associated
-- string. To get the next page of results, copy this string and repeat
-- your request, including @NextToken@ with the value of the copied string.
-- Repeat as needed to view all your results.
newListVocabularyFilters ::
  ListVocabularyFilters
newListVocabularyFilters :: ListVocabularyFilters
newListVocabularyFilters =
  ListVocabularyFilters'
    { $sel:maxResults:ListVocabularyFilters' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nameContains:ListVocabularyFilters' :: Maybe Text
nameContains = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListVocabularyFilters' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of custom vocabulary filters to return in each page
-- of results. If there are fewer results than the value that you specify,
-- only the actual results are returned. If you don\'t specify a value, a
-- default of 5 is used.
listVocabularyFilters_maxResults :: Lens.Lens' ListVocabularyFilters (Prelude.Maybe Prelude.Natural)
listVocabularyFilters_maxResults :: Lens' ListVocabularyFilters (Maybe Natural)
listVocabularyFilters_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVocabularyFilters' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListVocabularyFilters
s@ListVocabularyFilters' {} Maybe Natural
a -> ListVocabularyFilters
s {$sel:maxResults:ListVocabularyFilters' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListVocabularyFilters)

-- | Returns only the custom vocabulary filters that contain the specified
-- string. The search is not case sensitive.
listVocabularyFilters_nameContains :: Lens.Lens' ListVocabularyFilters (Prelude.Maybe Prelude.Text)
listVocabularyFilters_nameContains :: Lens' ListVocabularyFilters (Maybe Text)
listVocabularyFilters_nameContains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVocabularyFilters' {Maybe Text
nameContains :: Maybe Text
$sel:nameContains:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
nameContains} -> Maybe Text
nameContains) (\s :: ListVocabularyFilters
s@ListVocabularyFilters' {} Maybe Text
a -> ListVocabularyFilters
s {$sel:nameContains:ListVocabularyFilters' :: Maybe Text
nameContains = Maybe Text
a} :: ListVocabularyFilters)

-- | If your @ListVocabularyFilters@ request returns more results than can be
-- displayed, @NextToken@ is displayed in the response with an associated
-- string. To get the next page of results, copy this string and repeat
-- your request, including @NextToken@ with the value of the copied string.
-- Repeat as needed to view all your results.
listVocabularyFilters_nextToken :: Lens.Lens' ListVocabularyFilters (Prelude.Maybe Prelude.Text)
listVocabularyFilters_nextToken :: Lens' ListVocabularyFilters (Maybe Text)
listVocabularyFilters_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVocabularyFilters' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListVocabularyFilters
s@ListVocabularyFilters' {} Maybe Text
a -> ListVocabularyFilters
s {$sel:nextToken:ListVocabularyFilters' :: Maybe Text
nextToken = Maybe Text
a} :: ListVocabularyFilters)

instance Core.AWSRequest ListVocabularyFilters where
  type
    AWSResponse ListVocabularyFilters =
      ListVocabularyFiltersResponse
  request :: (Service -> Service)
-> ListVocabularyFilters -> Request ListVocabularyFilters
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 ListVocabularyFilters
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListVocabularyFilters)))
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 [VocabularyFilterInfo]
-> Int
-> ListVocabularyFiltersResponse
ListVocabularyFiltersResponse'
            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
"NextToken")
            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
"VocabularyFilters"
                            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 ListVocabularyFilters where
  hashWithSalt :: Int -> ListVocabularyFilters -> Int
hashWithSalt Int
_salt ListVocabularyFilters' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
$sel:nameContains:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
$sel:maxResults:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nameContains
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListVocabularyFilters where
  rnf :: ListVocabularyFilters -> ()
rnf ListVocabularyFilters' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
$sel:nameContains:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
$sel:maxResults:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Natural
..} =
    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 Maybe Text
nameContains
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListVocabularyFilters where
  toHeaders :: ListVocabularyFilters -> 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
"Transcribe.ListVocabularyFilters" ::
                          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 ListVocabularyFilters where
  toJSON :: ListVocabularyFilters -> Value
toJSON ListVocabularyFilters' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
$sel:nameContains:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Text
$sel:maxResults:ListVocabularyFilters' :: ListVocabularyFilters -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            (Key
"NameContains" 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
nameContains,
            (Key
"NextToken" 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
nextToken
          ]
      )

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

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

-- | /See:/ 'newListVocabularyFiltersResponse' smart constructor.
data ListVocabularyFiltersResponse = ListVocabularyFiltersResponse'
  { -- | If @NextToken@ is present in your response, it indicates that not all
    -- results are displayed. To view the next set of results, copy the string
    -- associated with the @NextToken@ parameter in your results output, then
    -- run your request again including @NextToken@ with the value of the
    -- copied string. Repeat as needed to view all your results.
    ListVocabularyFiltersResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Provides information about the custom vocabulary filters that match the
    -- criteria specified in your request.
    ListVocabularyFiltersResponse -> Maybe [VocabularyFilterInfo]
vocabularyFilters :: Prelude.Maybe [VocabularyFilterInfo],
    -- | The response's http status code.
    ListVocabularyFiltersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListVocabularyFiltersResponse
-> ListVocabularyFiltersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVocabularyFiltersResponse
-> ListVocabularyFiltersResponse -> Bool
$c/= :: ListVocabularyFiltersResponse
-> ListVocabularyFiltersResponse -> Bool
== :: ListVocabularyFiltersResponse
-> ListVocabularyFiltersResponse -> Bool
$c== :: ListVocabularyFiltersResponse
-> ListVocabularyFiltersResponse -> Bool
Prelude.Eq, ReadPrec [ListVocabularyFiltersResponse]
ReadPrec ListVocabularyFiltersResponse
Int -> ReadS ListVocabularyFiltersResponse
ReadS [ListVocabularyFiltersResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVocabularyFiltersResponse]
$creadListPrec :: ReadPrec [ListVocabularyFiltersResponse]
readPrec :: ReadPrec ListVocabularyFiltersResponse
$creadPrec :: ReadPrec ListVocabularyFiltersResponse
readList :: ReadS [ListVocabularyFiltersResponse]
$creadList :: ReadS [ListVocabularyFiltersResponse]
readsPrec :: Int -> ReadS ListVocabularyFiltersResponse
$creadsPrec :: Int -> ReadS ListVocabularyFiltersResponse
Prelude.Read, Int -> ListVocabularyFiltersResponse -> ShowS
[ListVocabularyFiltersResponse] -> ShowS
ListVocabularyFiltersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVocabularyFiltersResponse] -> ShowS
$cshowList :: [ListVocabularyFiltersResponse] -> ShowS
show :: ListVocabularyFiltersResponse -> String
$cshow :: ListVocabularyFiltersResponse -> String
showsPrec :: Int -> ListVocabularyFiltersResponse -> ShowS
$cshowsPrec :: Int -> ListVocabularyFiltersResponse -> ShowS
Prelude.Show, forall x.
Rep ListVocabularyFiltersResponse x
-> ListVocabularyFiltersResponse
forall x.
ListVocabularyFiltersResponse
-> Rep ListVocabularyFiltersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListVocabularyFiltersResponse x
-> ListVocabularyFiltersResponse
$cfrom :: forall x.
ListVocabularyFiltersResponse
-> Rep ListVocabularyFiltersResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListVocabularyFiltersResponse' 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:
--
-- 'nextToken', 'listVocabularyFiltersResponse_nextToken' - If @NextToken@ is present in your response, it indicates that not all
-- results are displayed. To view the next set of results, copy the string
-- associated with the @NextToken@ parameter in your results output, then
-- run your request again including @NextToken@ with the value of the
-- copied string. Repeat as needed to view all your results.
--
-- 'vocabularyFilters', 'listVocabularyFiltersResponse_vocabularyFilters' - Provides information about the custom vocabulary filters that match the
-- criteria specified in your request.
--
-- 'httpStatus', 'listVocabularyFiltersResponse_httpStatus' - The response's http status code.
newListVocabularyFiltersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListVocabularyFiltersResponse
newListVocabularyFiltersResponse :: Int -> ListVocabularyFiltersResponse
newListVocabularyFiltersResponse Int
pHttpStatus_ =
  ListVocabularyFiltersResponse'
    { $sel:nextToken:ListVocabularyFiltersResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyFilters:ListVocabularyFiltersResponse' :: Maybe [VocabularyFilterInfo]
vocabularyFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListVocabularyFiltersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If @NextToken@ is present in your response, it indicates that not all
-- results are displayed. To view the next set of results, copy the string
-- associated with the @NextToken@ parameter in your results output, then
-- run your request again including @NextToken@ with the value of the
-- copied string. Repeat as needed to view all your results.
listVocabularyFiltersResponse_nextToken :: Lens.Lens' ListVocabularyFiltersResponse (Prelude.Maybe Prelude.Text)
listVocabularyFiltersResponse_nextToken :: Lens' ListVocabularyFiltersResponse (Maybe Text)
listVocabularyFiltersResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVocabularyFiltersResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVocabularyFiltersResponse' :: ListVocabularyFiltersResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListVocabularyFiltersResponse
s@ListVocabularyFiltersResponse' {} Maybe Text
a -> ListVocabularyFiltersResponse
s {$sel:nextToken:ListVocabularyFiltersResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListVocabularyFiltersResponse)

-- | Provides information about the custom vocabulary filters that match the
-- criteria specified in your request.
listVocabularyFiltersResponse_vocabularyFilters :: Lens.Lens' ListVocabularyFiltersResponse (Prelude.Maybe [VocabularyFilterInfo])
listVocabularyFiltersResponse_vocabularyFilters :: Lens' ListVocabularyFiltersResponse (Maybe [VocabularyFilterInfo])
listVocabularyFiltersResponse_vocabularyFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVocabularyFiltersResponse' {Maybe [VocabularyFilterInfo]
vocabularyFilters :: Maybe [VocabularyFilterInfo]
$sel:vocabularyFilters:ListVocabularyFiltersResponse' :: ListVocabularyFiltersResponse -> Maybe [VocabularyFilterInfo]
vocabularyFilters} -> Maybe [VocabularyFilterInfo]
vocabularyFilters) (\s :: ListVocabularyFiltersResponse
s@ListVocabularyFiltersResponse' {} Maybe [VocabularyFilterInfo]
a -> ListVocabularyFiltersResponse
s {$sel:vocabularyFilters:ListVocabularyFiltersResponse' :: Maybe [VocabularyFilterInfo]
vocabularyFilters = Maybe [VocabularyFilterInfo]
a} :: ListVocabularyFiltersResponse) 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.
listVocabularyFiltersResponse_httpStatus :: Lens.Lens' ListVocabularyFiltersResponse Prelude.Int
listVocabularyFiltersResponse_httpStatus :: Lens' ListVocabularyFiltersResponse Int
listVocabularyFiltersResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVocabularyFiltersResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListVocabularyFiltersResponse' :: ListVocabularyFiltersResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListVocabularyFiltersResponse
s@ListVocabularyFiltersResponse' {} Int
a -> ListVocabularyFiltersResponse
s {$sel:httpStatus:ListVocabularyFiltersResponse' :: Int
httpStatus = Int
a} :: ListVocabularyFiltersResponse)

instance Prelude.NFData ListVocabularyFiltersResponse where
  rnf :: ListVocabularyFiltersResponse -> ()
rnf ListVocabularyFiltersResponse' {Int
Maybe [VocabularyFilterInfo]
Maybe Text
httpStatus :: Int
vocabularyFilters :: Maybe [VocabularyFilterInfo]
nextToken :: Maybe Text
$sel:httpStatus:ListVocabularyFiltersResponse' :: ListVocabularyFiltersResponse -> Int
$sel:vocabularyFilters:ListVocabularyFiltersResponse' :: ListVocabularyFiltersResponse -> Maybe [VocabularyFilterInfo]
$sel:nextToken:ListVocabularyFiltersResponse' :: ListVocabularyFiltersResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [VocabularyFilterInfo]
vocabularyFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus