{-# 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.Polly.ListLexicons
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of pronunciation lexicons stored in an Amazon Web
-- Services Region. For more information, see
-- <https://docs.aws.amazon.com/polly/latest/dg/managing-lexicons.html Managing Lexicons>.
--
-- This operation returns paginated results.
module Amazonka.Polly.ListLexicons
  ( -- * Creating a Request
    ListLexicons (..),
    newListLexicons,

    -- * Request Lenses
    listLexicons_nextToken,

    -- * Destructuring the Response
    ListLexiconsResponse (..),
    newListLexiconsResponse,

    -- * Response Lenses
    listLexiconsResponse_lexicons,
    listLexiconsResponse_nextToken,
    listLexiconsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListLexicons' smart constructor.
data ListLexicons = ListLexicons'
  { -- | An opaque pagination token returned from previous @ListLexicons@
    -- operation. If present, indicates where to continue the list of lexicons.
    ListLexicons -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListLexicons -> ListLexicons -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListLexicons -> ListLexicons -> Bool
$c/= :: ListLexicons -> ListLexicons -> Bool
== :: ListLexicons -> ListLexicons -> Bool
$c== :: ListLexicons -> ListLexicons -> Bool
Prelude.Eq, ReadPrec [ListLexicons]
ReadPrec ListLexicons
Int -> ReadS ListLexicons
ReadS [ListLexicons]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListLexicons]
$creadListPrec :: ReadPrec [ListLexicons]
readPrec :: ReadPrec ListLexicons
$creadPrec :: ReadPrec ListLexicons
readList :: ReadS [ListLexicons]
$creadList :: ReadS [ListLexicons]
readsPrec :: Int -> ReadS ListLexicons
$creadsPrec :: Int -> ReadS ListLexicons
Prelude.Read, Int -> ListLexicons -> ShowS
[ListLexicons] -> ShowS
ListLexicons -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListLexicons] -> ShowS
$cshowList :: [ListLexicons] -> ShowS
show :: ListLexicons -> String
$cshow :: ListLexicons -> String
showsPrec :: Int -> ListLexicons -> ShowS
$cshowsPrec :: Int -> ListLexicons -> ShowS
Prelude.Show, forall x. Rep ListLexicons x -> ListLexicons
forall x. ListLexicons -> Rep ListLexicons x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListLexicons x -> ListLexicons
$cfrom :: forall x. ListLexicons -> Rep ListLexicons x
Prelude.Generic)

-- |
-- Create a value of 'ListLexicons' 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', 'listLexicons_nextToken' - An opaque pagination token returned from previous @ListLexicons@
-- operation. If present, indicates where to continue the list of lexicons.
newListLexicons ::
  ListLexicons
newListLexicons :: ListLexicons
newListLexicons =
  ListLexicons' {$sel:nextToken:ListLexicons' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing}

-- | An opaque pagination token returned from previous @ListLexicons@
-- operation. If present, indicates where to continue the list of lexicons.
listLexicons_nextToken :: Lens.Lens' ListLexicons (Prelude.Maybe Prelude.Text)
listLexicons_nextToken :: Lens' ListLexicons (Maybe Text)
listLexicons_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLexicons' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLexicons' :: ListLexicons -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListLexicons
s@ListLexicons' {} Maybe Text
a -> ListLexicons
s {$sel:nextToken:ListLexicons' :: Maybe Text
nextToken = Maybe Text
a} :: ListLexicons)

instance Core.AWSPager ListLexicons where
  page :: ListLexicons -> AWSResponse ListLexicons -> Maybe ListLexicons
page ListLexicons
rq AWSResponse ListLexicons
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListLexicons
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLexiconsResponse (Maybe Text)
listLexiconsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListLexicons
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLexiconsResponse (Maybe [LexiconDescription])
listLexiconsResponse_lexicons
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListLexicons
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListLexicons (Maybe Text)
listLexicons_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListLexicons
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLexiconsResponse (Maybe Text)
listLexiconsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListLexicons where
  type AWSResponse ListLexicons = ListLexiconsResponse
  request :: (Service -> Service) -> ListLexicons -> Request ListLexicons
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListLexicons
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListLexicons)))
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 [LexiconDescription]
-> Maybe Text -> Int -> ListLexiconsResponse
ListLexiconsResponse'
            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
"Lexicons" 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 (Maybe a)
Data..?> Key
"NextToken")
            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 ListLexicons where
  hashWithSalt :: Int -> ListLexicons -> Int
hashWithSalt Int
_salt ListLexicons' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLexicons' :: ListLexicons -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListLexicons where
  rnf :: ListLexicons -> ()
rnf ListLexicons' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLexicons' :: ListLexicons -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListLexicons where
  toHeaders :: ListLexicons -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ListLexicons where
  toQuery :: ListLexicons -> QueryString
toQuery ListLexicons' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLexicons' :: ListLexicons -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken]

-- | /See:/ 'newListLexiconsResponse' smart constructor.
data ListLexiconsResponse = ListLexiconsResponse'
  { -- | A list of lexicon names and attributes.
    ListLexiconsResponse -> Maybe [LexiconDescription]
lexicons :: Prelude.Maybe [LexiconDescription],
    -- | The pagination token to use in the next request to continue the listing
    -- of lexicons. @NextToken@ is returned only if the response is truncated.
    ListLexiconsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListLexiconsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListLexiconsResponse -> ListLexiconsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListLexiconsResponse -> ListLexiconsResponse -> Bool
$c/= :: ListLexiconsResponse -> ListLexiconsResponse -> Bool
== :: ListLexiconsResponse -> ListLexiconsResponse -> Bool
$c== :: ListLexiconsResponse -> ListLexiconsResponse -> Bool
Prelude.Eq, ReadPrec [ListLexiconsResponse]
ReadPrec ListLexiconsResponse
Int -> ReadS ListLexiconsResponse
ReadS [ListLexiconsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListLexiconsResponse]
$creadListPrec :: ReadPrec [ListLexiconsResponse]
readPrec :: ReadPrec ListLexiconsResponse
$creadPrec :: ReadPrec ListLexiconsResponse
readList :: ReadS [ListLexiconsResponse]
$creadList :: ReadS [ListLexiconsResponse]
readsPrec :: Int -> ReadS ListLexiconsResponse
$creadsPrec :: Int -> ReadS ListLexiconsResponse
Prelude.Read, Int -> ListLexiconsResponse -> ShowS
[ListLexiconsResponse] -> ShowS
ListLexiconsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListLexiconsResponse] -> ShowS
$cshowList :: [ListLexiconsResponse] -> ShowS
show :: ListLexiconsResponse -> String
$cshow :: ListLexiconsResponse -> String
showsPrec :: Int -> ListLexiconsResponse -> ShowS
$cshowsPrec :: Int -> ListLexiconsResponse -> ShowS
Prelude.Show, forall x. Rep ListLexiconsResponse x -> ListLexiconsResponse
forall x. ListLexiconsResponse -> Rep ListLexiconsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListLexiconsResponse x -> ListLexiconsResponse
$cfrom :: forall x. ListLexiconsResponse -> Rep ListLexiconsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListLexiconsResponse' 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:
--
-- 'lexicons', 'listLexiconsResponse_lexicons' - A list of lexicon names and attributes.
--
-- 'nextToken', 'listLexiconsResponse_nextToken' - The pagination token to use in the next request to continue the listing
-- of lexicons. @NextToken@ is returned only if the response is truncated.
--
-- 'httpStatus', 'listLexiconsResponse_httpStatus' - The response's http status code.
newListLexiconsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListLexiconsResponse
newListLexiconsResponse :: Int -> ListLexiconsResponse
newListLexiconsResponse Int
pHttpStatus_ =
  ListLexiconsResponse'
    { $sel:lexicons:ListLexiconsResponse' :: Maybe [LexiconDescription]
lexicons = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListLexiconsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListLexiconsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of lexicon names and attributes.
listLexiconsResponse_lexicons :: Lens.Lens' ListLexiconsResponse (Prelude.Maybe [LexiconDescription])
listLexiconsResponse_lexicons :: Lens' ListLexiconsResponse (Maybe [LexiconDescription])
listLexiconsResponse_lexicons = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLexiconsResponse' {Maybe [LexiconDescription]
lexicons :: Maybe [LexiconDescription]
$sel:lexicons:ListLexiconsResponse' :: ListLexiconsResponse -> Maybe [LexiconDescription]
lexicons} -> Maybe [LexiconDescription]
lexicons) (\s :: ListLexiconsResponse
s@ListLexiconsResponse' {} Maybe [LexiconDescription]
a -> ListLexiconsResponse
s {$sel:lexicons:ListLexiconsResponse' :: Maybe [LexiconDescription]
lexicons = Maybe [LexiconDescription]
a} :: ListLexiconsResponse) 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 pagination token to use in the next request to continue the listing
-- of lexicons. @NextToken@ is returned only if the response is truncated.
listLexiconsResponse_nextToken :: Lens.Lens' ListLexiconsResponse (Prelude.Maybe Prelude.Text)
listLexiconsResponse_nextToken :: Lens' ListLexiconsResponse (Maybe Text)
listLexiconsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLexiconsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLexiconsResponse' :: ListLexiconsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListLexiconsResponse
s@ListLexiconsResponse' {} Maybe Text
a -> ListLexiconsResponse
s {$sel:nextToken:ListLexiconsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListLexiconsResponse)

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

instance Prelude.NFData ListLexiconsResponse where
  rnf :: ListLexiconsResponse -> ()
rnf ListLexiconsResponse' {Int
Maybe [LexiconDescription]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
lexicons :: Maybe [LexiconDescription]
$sel:httpStatus:ListLexiconsResponse' :: ListLexiconsResponse -> Int
$sel:nextToken:ListLexiconsResponse' :: ListLexiconsResponse -> Maybe Text
$sel:lexicons:ListLexiconsResponse' :: ListLexiconsResponse -> Maybe [LexiconDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [LexiconDescription]
lexicons
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Int
httpStatus