{-# 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.Translate.ListParallelData
-- 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 your parallel data resources in Amazon Translate.
module Amazonka.Translate.ListParallelData
  ( -- * Creating a Request
    ListParallelData (..),
    newListParallelData,

    -- * Request Lenses
    listParallelData_maxResults,
    listParallelData_nextToken,

    -- * Destructuring the Response
    ListParallelDataResponse (..),
    newListParallelDataResponse,

    -- * Response Lenses
    listParallelDataResponse_nextToken,
    listParallelDataResponse_parallelDataPropertiesList,
    listParallelDataResponse_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.Translate.Types

-- | /See:/ 'newListParallelData' smart constructor.
data ListParallelData = ListParallelData'
  { -- | The maximum number of parallel data resources returned for each request.
    ListParallelData -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A string that specifies the next page of results to return in a
    -- paginated response.
    ListParallelData -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListParallelData -> ListParallelData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListParallelData -> ListParallelData -> Bool
$c/= :: ListParallelData -> ListParallelData -> Bool
== :: ListParallelData -> ListParallelData -> Bool
$c== :: ListParallelData -> ListParallelData -> Bool
Prelude.Eq, ReadPrec [ListParallelData]
ReadPrec ListParallelData
Int -> ReadS ListParallelData
ReadS [ListParallelData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListParallelData]
$creadListPrec :: ReadPrec [ListParallelData]
readPrec :: ReadPrec ListParallelData
$creadPrec :: ReadPrec ListParallelData
readList :: ReadS [ListParallelData]
$creadList :: ReadS [ListParallelData]
readsPrec :: Int -> ReadS ListParallelData
$creadsPrec :: Int -> ReadS ListParallelData
Prelude.Read, Int -> ListParallelData -> ShowS
[ListParallelData] -> ShowS
ListParallelData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListParallelData] -> ShowS
$cshowList :: [ListParallelData] -> ShowS
show :: ListParallelData -> String
$cshow :: ListParallelData -> String
showsPrec :: Int -> ListParallelData -> ShowS
$cshowsPrec :: Int -> ListParallelData -> ShowS
Prelude.Show, forall x. Rep ListParallelData x -> ListParallelData
forall x. ListParallelData -> Rep ListParallelData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListParallelData x -> ListParallelData
$cfrom :: forall x. ListParallelData -> Rep ListParallelData x
Prelude.Generic)

-- |
-- Create a value of 'ListParallelData' 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', 'listParallelData_maxResults' - The maximum number of parallel data resources returned for each request.
--
-- 'nextToken', 'listParallelData_nextToken' - A string that specifies the next page of results to return in a
-- paginated response.
newListParallelData ::
  ListParallelData
newListParallelData :: ListParallelData
newListParallelData =
  ListParallelData'
    { $sel:maxResults:ListParallelData' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListParallelData' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of parallel data resources returned for each request.
listParallelData_maxResults :: Lens.Lens' ListParallelData (Prelude.Maybe Prelude.Natural)
listParallelData_maxResults :: Lens' ListParallelData (Maybe Natural)
listParallelData_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParallelData' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListParallelData' :: ListParallelData -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListParallelData
s@ListParallelData' {} Maybe Natural
a -> ListParallelData
s {$sel:maxResults:ListParallelData' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListParallelData)

-- | A string that specifies the next page of results to return in a
-- paginated response.
listParallelData_nextToken :: Lens.Lens' ListParallelData (Prelude.Maybe Prelude.Text)
listParallelData_nextToken :: Lens' ListParallelData (Maybe Text)
listParallelData_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParallelData' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListParallelData' :: ListParallelData -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListParallelData
s@ListParallelData' {} Maybe Text
a -> ListParallelData
s {$sel:nextToken:ListParallelData' :: Maybe Text
nextToken = Maybe Text
a} :: ListParallelData)

instance Core.AWSRequest ListParallelData where
  type
    AWSResponse ListParallelData =
      ListParallelDataResponse
  request :: (Service -> Service)
-> ListParallelData -> Request ListParallelData
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 ListParallelData
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListParallelData)))
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 [ParallelDataProperties]
-> Int
-> ListParallelDataResponse
ListParallelDataResponse'
            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
"ParallelDataPropertiesList"
                            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 ListParallelData where
  hashWithSalt :: Int -> ListParallelData -> Int
hashWithSalt Int
_salt ListParallelData' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListParallelData' :: ListParallelData -> Maybe Text
$sel:maxResults:ListParallelData' :: ListParallelData -> 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
nextToken

instance Prelude.NFData ListParallelData where
  rnf :: ListParallelData -> ()
rnf ListParallelData' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListParallelData' :: ListParallelData -> Maybe Text
$sel:maxResults:ListParallelData' :: ListParallelData -> 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
nextToken

instance Data.ToHeaders ListParallelData where
  toHeaders :: ListParallelData -> 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
"AWSShineFrontendService_20170701.ListParallelData" ::
                          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 ListParallelData where
  toJSON :: ListParallelData -> Value
toJSON ListParallelData' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListParallelData' :: ListParallelData -> Maybe Text
$sel:maxResults:ListParallelData' :: ListParallelData -> 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
"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 ListParallelData where
  toPath :: ListParallelData -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newListParallelDataResponse' smart constructor.
data ListParallelDataResponse = ListParallelDataResponse'
  { -- | The string to use in a subsequent request to get the next page of
    -- results in a paginated response. This value is null if there are no
    -- additional pages.
    ListParallelDataResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The properties of the parallel data resources returned by this request.
    ListParallelDataResponse -> Maybe [ParallelDataProperties]
parallelDataPropertiesList :: Prelude.Maybe [ParallelDataProperties],
    -- | The response's http status code.
    ListParallelDataResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListParallelDataResponse -> ListParallelDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListParallelDataResponse -> ListParallelDataResponse -> Bool
$c/= :: ListParallelDataResponse -> ListParallelDataResponse -> Bool
== :: ListParallelDataResponse -> ListParallelDataResponse -> Bool
$c== :: ListParallelDataResponse -> ListParallelDataResponse -> Bool
Prelude.Eq, ReadPrec [ListParallelDataResponse]
ReadPrec ListParallelDataResponse
Int -> ReadS ListParallelDataResponse
ReadS [ListParallelDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListParallelDataResponse]
$creadListPrec :: ReadPrec [ListParallelDataResponse]
readPrec :: ReadPrec ListParallelDataResponse
$creadPrec :: ReadPrec ListParallelDataResponse
readList :: ReadS [ListParallelDataResponse]
$creadList :: ReadS [ListParallelDataResponse]
readsPrec :: Int -> ReadS ListParallelDataResponse
$creadsPrec :: Int -> ReadS ListParallelDataResponse
Prelude.Read, Int -> ListParallelDataResponse -> ShowS
[ListParallelDataResponse] -> ShowS
ListParallelDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListParallelDataResponse] -> ShowS
$cshowList :: [ListParallelDataResponse] -> ShowS
show :: ListParallelDataResponse -> String
$cshow :: ListParallelDataResponse -> String
showsPrec :: Int -> ListParallelDataResponse -> ShowS
$cshowsPrec :: Int -> ListParallelDataResponse -> ShowS
Prelude.Show, forall x.
Rep ListParallelDataResponse x -> ListParallelDataResponse
forall x.
ListParallelDataResponse -> Rep ListParallelDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListParallelDataResponse x -> ListParallelDataResponse
$cfrom :: forall x.
ListParallelDataResponse -> Rep ListParallelDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListParallelDataResponse' 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', 'listParallelDataResponse_nextToken' - The string to use in a subsequent request to get the next page of
-- results in a paginated response. This value is null if there are no
-- additional pages.
--
-- 'parallelDataPropertiesList', 'listParallelDataResponse_parallelDataPropertiesList' - The properties of the parallel data resources returned by this request.
--
-- 'httpStatus', 'listParallelDataResponse_httpStatus' - The response's http status code.
newListParallelDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListParallelDataResponse
newListParallelDataResponse :: Int -> ListParallelDataResponse
newListParallelDataResponse Int
pHttpStatus_ =
  ListParallelDataResponse'
    { $sel:nextToken:ListParallelDataResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:parallelDataPropertiesList:ListParallelDataResponse' :: Maybe [ParallelDataProperties]
parallelDataPropertiesList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListParallelDataResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The string to use in a subsequent request to get the next page of
-- results in a paginated response. This value is null if there are no
-- additional pages.
listParallelDataResponse_nextToken :: Lens.Lens' ListParallelDataResponse (Prelude.Maybe Prelude.Text)
listParallelDataResponse_nextToken :: Lens' ListParallelDataResponse (Maybe Text)
listParallelDataResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParallelDataResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListParallelDataResponse' :: ListParallelDataResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListParallelDataResponse
s@ListParallelDataResponse' {} Maybe Text
a -> ListParallelDataResponse
s {$sel:nextToken:ListParallelDataResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListParallelDataResponse)

-- | The properties of the parallel data resources returned by this request.
listParallelDataResponse_parallelDataPropertiesList :: Lens.Lens' ListParallelDataResponse (Prelude.Maybe [ParallelDataProperties])
listParallelDataResponse_parallelDataPropertiesList :: Lens' ListParallelDataResponse (Maybe [ParallelDataProperties])
listParallelDataResponse_parallelDataPropertiesList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParallelDataResponse' {Maybe [ParallelDataProperties]
parallelDataPropertiesList :: Maybe [ParallelDataProperties]
$sel:parallelDataPropertiesList:ListParallelDataResponse' :: ListParallelDataResponse -> Maybe [ParallelDataProperties]
parallelDataPropertiesList} -> Maybe [ParallelDataProperties]
parallelDataPropertiesList) (\s :: ListParallelDataResponse
s@ListParallelDataResponse' {} Maybe [ParallelDataProperties]
a -> ListParallelDataResponse
s {$sel:parallelDataPropertiesList:ListParallelDataResponse' :: Maybe [ParallelDataProperties]
parallelDataPropertiesList = Maybe [ParallelDataProperties]
a} :: ListParallelDataResponse) 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.
listParallelDataResponse_httpStatus :: Lens.Lens' ListParallelDataResponse Prelude.Int
listParallelDataResponse_httpStatus :: Lens' ListParallelDataResponse Int
listParallelDataResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParallelDataResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListParallelDataResponse' :: ListParallelDataResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListParallelDataResponse
s@ListParallelDataResponse' {} Int
a -> ListParallelDataResponse
s {$sel:httpStatus:ListParallelDataResponse' :: Int
httpStatus = Int
a} :: ListParallelDataResponse)

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