{-# 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.HoneyCode.ListTableRows
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The ListTableRows API allows you to retrieve a list of all the rows in a
-- table in a workbook.
--
-- This operation returns paginated results.
module Amazonka.HoneyCode.ListTableRows
  ( -- * Creating a Request
    ListTableRows (..),
    newListTableRows,

    -- * Request Lenses
    listTableRows_maxResults,
    listTableRows_nextToken,
    listTableRows_rowIds,
    listTableRows_workbookId,
    listTableRows_tableId,

    -- * Destructuring the Response
    ListTableRowsResponse (..),
    newListTableRowsResponse,

    -- * Response Lenses
    listTableRowsResponse_nextToken,
    listTableRowsResponse_rowIdsNotFound,
    listTableRowsResponse_httpStatus,
    listTableRowsResponse_columnIds,
    listTableRowsResponse_rows,
    listTableRowsResponse_workbookCursor,
  )
where

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

-- | /See:/ 'newListTableRows' smart constructor.
data ListTableRows = ListTableRows'
  { -- | The maximum number of rows to return in each page of the results.
    ListTableRows -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | This parameter is optional. If a nextToken is not specified, the API
    -- returns the first page of data.
    --
    -- Pagination tokens expire after 1 hour. If you use a token that was
    -- returned more than an hour back, the API will throw ValidationException.
    ListTableRows -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | This parameter is optional. If one or more row ids are specified in this
    -- list, then only the specified row ids are returned in the result. If no
    -- row ids are specified here, then all the rows in the table are returned.
    ListTableRows -> Maybe (NonEmpty Text)
rowIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The ID of the workbook that contains the table whose rows are being
    -- retrieved.
    --
    -- If a workbook with the specified id could not be found, this API throws
    -- ResourceNotFoundException.
    ListTableRows -> Text
workbookId :: Prelude.Text,
    -- | The ID of the table whose rows are being retrieved.
    --
    -- If a table with the specified id could not be found, this API throws
    -- ResourceNotFoundException.
    ListTableRows -> Text
tableId :: Prelude.Text
  }
  deriving (ListTableRows -> ListTableRows -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTableRows -> ListTableRows -> Bool
$c/= :: ListTableRows -> ListTableRows -> Bool
== :: ListTableRows -> ListTableRows -> Bool
$c== :: ListTableRows -> ListTableRows -> Bool
Prelude.Eq, ReadPrec [ListTableRows]
ReadPrec ListTableRows
Int -> ReadS ListTableRows
ReadS [ListTableRows]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTableRows]
$creadListPrec :: ReadPrec [ListTableRows]
readPrec :: ReadPrec ListTableRows
$creadPrec :: ReadPrec ListTableRows
readList :: ReadS [ListTableRows]
$creadList :: ReadS [ListTableRows]
readsPrec :: Int -> ReadS ListTableRows
$creadsPrec :: Int -> ReadS ListTableRows
Prelude.Read, Int -> ListTableRows -> ShowS
[ListTableRows] -> ShowS
ListTableRows -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTableRows] -> ShowS
$cshowList :: [ListTableRows] -> ShowS
show :: ListTableRows -> String
$cshow :: ListTableRows -> String
showsPrec :: Int -> ListTableRows -> ShowS
$cshowsPrec :: Int -> ListTableRows -> ShowS
Prelude.Show, forall x. Rep ListTableRows x -> ListTableRows
forall x. ListTableRows -> Rep ListTableRows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTableRows x -> ListTableRows
$cfrom :: forall x. ListTableRows -> Rep ListTableRows x
Prelude.Generic)

-- |
-- Create a value of 'ListTableRows' 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', 'listTableRows_maxResults' - The maximum number of rows to return in each page of the results.
--
-- 'nextToken', 'listTableRows_nextToken' - This parameter is optional. If a nextToken is not specified, the API
-- returns the first page of data.
--
-- Pagination tokens expire after 1 hour. If you use a token that was
-- returned more than an hour back, the API will throw ValidationException.
--
-- 'rowIds', 'listTableRows_rowIds' - This parameter is optional. If one or more row ids are specified in this
-- list, then only the specified row ids are returned in the result. If no
-- row ids are specified here, then all the rows in the table are returned.
--
-- 'workbookId', 'listTableRows_workbookId' - The ID of the workbook that contains the table whose rows are being
-- retrieved.
--
-- If a workbook with the specified id could not be found, this API throws
-- ResourceNotFoundException.
--
-- 'tableId', 'listTableRows_tableId' - The ID of the table whose rows are being retrieved.
--
-- If a table with the specified id could not be found, this API throws
-- ResourceNotFoundException.
newListTableRows ::
  -- | 'workbookId'
  Prelude.Text ->
  -- | 'tableId'
  Prelude.Text ->
  ListTableRows
newListTableRows :: Text -> Text -> ListTableRows
newListTableRows Text
pWorkbookId_ Text
pTableId_ =
  ListTableRows'
    { $sel:maxResults:ListTableRows' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTableRows' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:rowIds:ListTableRows' :: Maybe (NonEmpty Text)
rowIds = forall a. Maybe a
Prelude.Nothing,
      $sel:workbookId:ListTableRows' :: Text
workbookId = Text
pWorkbookId_,
      $sel:tableId:ListTableRows' :: Text
tableId = Text
pTableId_
    }

-- | The maximum number of rows to return in each page of the results.
listTableRows_maxResults :: Lens.Lens' ListTableRows (Prelude.Maybe Prelude.Natural)
listTableRows_maxResults :: Lens' ListTableRows (Maybe Natural)
listTableRows_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRows' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListTableRows' :: ListTableRows -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListTableRows
s@ListTableRows' {} Maybe Natural
a -> ListTableRows
s {$sel:maxResults:ListTableRows' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListTableRows)

-- | This parameter is optional. If a nextToken is not specified, the API
-- returns the first page of data.
--
-- Pagination tokens expire after 1 hour. If you use a token that was
-- returned more than an hour back, the API will throw ValidationException.
listTableRows_nextToken :: Lens.Lens' ListTableRows (Prelude.Maybe Prelude.Text)
listTableRows_nextToken :: Lens' ListTableRows (Maybe Text)
listTableRows_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRows' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTableRows' :: ListTableRows -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTableRows
s@ListTableRows' {} Maybe Text
a -> ListTableRows
s {$sel:nextToken:ListTableRows' :: Maybe Text
nextToken = Maybe Text
a} :: ListTableRows)

-- | This parameter is optional. If one or more row ids are specified in this
-- list, then only the specified row ids are returned in the result. If no
-- row ids are specified here, then all the rows in the table are returned.
listTableRows_rowIds :: Lens.Lens' ListTableRows (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
listTableRows_rowIds :: Lens' ListTableRows (Maybe (NonEmpty Text))
listTableRows_rowIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRows' {Maybe (NonEmpty Text)
rowIds :: Maybe (NonEmpty Text)
$sel:rowIds:ListTableRows' :: ListTableRows -> Maybe (NonEmpty Text)
rowIds} -> Maybe (NonEmpty Text)
rowIds) (\s :: ListTableRows
s@ListTableRows' {} Maybe (NonEmpty Text)
a -> ListTableRows
s {$sel:rowIds:ListTableRows' :: Maybe (NonEmpty Text)
rowIds = Maybe (NonEmpty Text)
a} :: ListTableRows) 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 ID of the workbook that contains the table whose rows are being
-- retrieved.
--
-- If a workbook with the specified id could not be found, this API throws
-- ResourceNotFoundException.
listTableRows_workbookId :: Lens.Lens' ListTableRows Prelude.Text
listTableRows_workbookId :: Lens' ListTableRows Text
listTableRows_workbookId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRows' {Text
workbookId :: Text
$sel:workbookId:ListTableRows' :: ListTableRows -> Text
workbookId} -> Text
workbookId) (\s :: ListTableRows
s@ListTableRows' {} Text
a -> ListTableRows
s {$sel:workbookId:ListTableRows' :: Text
workbookId = Text
a} :: ListTableRows)

-- | The ID of the table whose rows are being retrieved.
--
-- If a table with the specified id could not be found, this API throws
-- ResourceNotFoundException.
listTableRows_tableId :: Lens.Lens' ListTableRows Prelude.Text
listTableRows_tableId :: Lens' ListTableRows Text
listTableRows_tableId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRows' {Text
tableId :: Text
$sel:tableId:ListTableRows' :: ListTableRows -> Text
tableId} -> Text
tableId) (\s :: ListTableRows
s@ListTableRows' {} Text
a -> ListTableRows
s {$sel:tableId:ListTableRows' :: Text
tableId = Text
a} :: ListTableRows)

instance Core.AWSPager ListTableRows where
  page :: ListTableRows -> AWSResponse ListTableRows -> Maybe ListTableRows
page ListTableRows
rq AWSResponse ListTableRows
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTableRows
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTableRowsResponse (Maybe Text)
listTableRowsResponse_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 ListTableRows
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListTableRowsResponse [TableRow]
listTableRowsResponse_rows) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListTableRows
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTableRows (Maybe Text)
listTableRows_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTableRows
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTableRowsResponse (Maybe Text)
listTableRowsResponse_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 ListTableRows where
  type
    AWSResponse ListTableRows =
      ListTableRowsResponse
  request :: (Service -> Service) -> ListTableRows -> Request ListTableRows
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 ListTableRows
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListTableRows)))
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 (NonEmpty Text)
-> Int
-> NonEmpty Text
-> [TableRow]
-> Integer
-> ListTableRowsResponse
ListTableRowsResponse'
            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
"rowIdsNotFound")
            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))
            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
"columnIds")
            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
"rows" 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
"workbookCursor")
      )

instance Prelude.Hashable ListTableRows where
  hashWithSalt :: Int -> ListTableRows -> Int
hashWithSalt Int
_salt ListTableRows' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
tableId :: Text
workbookId :: Text
rowIds :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:tableId:ListTableRows' :: ListTableRows -> Text
$sel:workbookId:ListTableRows' :: ListTableRows -> Text
$sel:rowIds:ListTableRows' :: ListTableRows -> Maybe (NonEmpty Text)
$sel:nextToken:ListTableRows' :: ListTableRows -> Maybe Text
$sel:maxResults:ListTableRows' :: ListTableRows -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
rowIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workbookId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableId

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

instance Data.ToHeaders ListTableRows where
  toHeaders :: ListTableRows -> 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 ListTableRows where
  toJSON :: ListTableRows -> Value
toJSON ListTableRows' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
tableId :: Text
workbookId :: Text
rowIds :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:tableId:ListTableRows' :: ListTableRows -> Text
$sel:workbookId:ListTableRows' :: ListTableRows -> Text
$sel:rowIds:ListTableRows' :: ListTableRows -> Maybe (NonEmpty Text)
$sel:nextToken:ListTableRows' :: ListTableRows -> Maybe Text
$sel:maxResults:ListTableRows' :: ListTableRows -> 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,
            (Key
"rowIds" 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)
rowIds
          ]
      )

instance Data.ToPath ListTableRows where
  toPath :: ListTableRows -> ByteString
toPath ListTableRows' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
tableId :: Text
workbookId :: Text
rowIds :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:tableId:ListTableRows' :: ListTableRows -> Text
$sel:workbookId:ListTableRows' :: ListTableRows -> Text
$sel:rowIds:ListTableRows' :: ListTableRows -> Maybe (NonEmpty Text)
$sel:nextToken:ListTableRows' :: ListTableRows -> Maybe Text
$sel:maxResults:ListTableRows' :: ListTableRows -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workbooks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workbookId,
        ByteString
"/tables/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
tableId,
        ByteString
"/rows/list"
      ]

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

-- | /See:/ 'newListTableRowsResponse' smart constructor.
data ListTableRowsResponse = ListTableRowsResponse'
  { -- | Provides the pagination token to load the next page if there are more
    -- results matching the request. If a pagination token is not present in
    -- the response, it means that all data matching the request has been
    -- loaded.
    ListTableRowsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of row ids included in the request that were not found in the
    -- table.
    ListTableRowsResponse -> Maybe (NonEmpty Text)
rowIdsNotFound :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    ListTableRowsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The list of columns in the table whose row data is returned in the
    -- result.
    ListTableRowsResponse -> NonEmpty Text
columnIds :: Prelude.NonEmpty Prelude.Text,
    -- | The list of rows in the table. Note that this result is paginated, so
    -- this list contains a maximum of 100 rows.
    ListTableRowsResponse -> [TableRow]
rows :: [TableRow],
    -- | Indicates the cursor of the workbook at which the data returned by this
    -- request is read. Workbook cursor keeps increasing with every update and
    -- the increments are not sequential.
    ListTableRowsResponse -> Integer
workbookCursor :: Prelude.Integer
  }
  deriving (ListTableRowsResponse -> ListTableRowsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTableRowsResponse -> ListTableRowsResponse -> Bool
$c/= :: ListTableRowsResponse -> ListTableRowsResponse -> Bool
== :: ListTableRowsResponse -> ListTableRowsResponse -> Bool
$c== :: ListTableRowsResponse -> ListTableRowsResponse -> Bool
Prelude.Eq, Int -> ListTableRowsResponse -> ShowS
[ListTableRowsResponse] -> ShowS
ListTableRowsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTableRowsResponse] -> ShowS
$cshowList :: [ListTableRowsResponse] -> ShowS
show :: ListTableRowsResponse -> String
$cshow :: ListTableRowsResponse -> String
showsPrec :: Int -> ListTableRowsResponse -> ShowS
$cshowsPrec :: Int -> ListTableRowsResponse -> ShowS
Prelude.Show, forall x. Rep ListTableRowsResponse x -> ListTableRowsResponse
forall x. ListTableRowsResponse -> Rep ListTableRowsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTableRowsResponse x -> ListTableRowsResponse
$cfrom :: forall x. ListTableRowsResponse -> Rep ListTableRowsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTableRowsResponse' 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', 'listTableRowsResponse_nextToken' - Provides the pagination token to load the next page if there are more
-- results matching the request. If a pagination token is not present in
-- the response, it means that all data matching the request has been
-- loaded.
--
-- 'rowIdsNotFound', 'listTableRowsResponse_rowIdsNotFound' - The list of row ids included in the request that were not found in the
-- table.
--
-- 'httpStatus', 'listTableRowsResponse_httpStatus' - The response's http status code.
--
-- 'columnIds', 'listTableRowsResponse_columnIds' - The list of columns in the table whose row data is returned in the
-- result.
--
-- 'rows', 'listTableRowsResponse_rows' - The list of rows in the table. Note that this result is paginated, so
-- this list contains a maximum of 100 rows.
--
-- 'workbookCursor', 'listTableRowsResponse_workbookCursor' - Indicates the cursor of the workbook at which the data returned by this
-- request is read. Workbook cursor keeps increasing with every update and
-- the increments are not sequential.
newListTableRowsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'columnIds'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'workbookCursor'
  Prelude.Integer ->
  ListTableRowsResponse
newListTableRowsResponse :: Int -> NonEmpty Text -> Integer -> ListTableRowsResponse
newListTableRowsResponse
  Int
pHttpStatus_
  NonEmpty Text
pColumnIds_
  Integer
pWorkbookCursor_ =
    ListTableRowsResponse'
      { $sel:nextToken:ListTableRowsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:rowIdsNotFound:ListTableRowsResponse' :: Maybe (NonEmpty Text)
rowIdsNotFound = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListTableRowsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:columnIds:ListTableRowsResponse' :: NonEmpty Text
columnIds = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pColumnIds_,
        $sel:rows:ListTableRowsResponse' :: [TableRow]
rows = forall a. Monoid a => a
Prelude.mempty,
        $sel:workbookCursor:ListTableRowsResponse' :: Integer
workbookCursor = Integer
pWorkbookCursor_
      }

-- | Provides the pagination token to load the next page if there are more
-- results matching the request. If a pagination token is not present in
-- the response, it means that all data matching the request has been
-- loaded.
listTableRowsResponse_nextToken :: Lens.Lens' ListTableRowsResponse (Prelude.Maybe Prelude.Text)
listTableRowsResponse_nextToken :: Lens' ListTableRowsResponse (Maybe Text)
listTableRowsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRowsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTableRowsResponse' :: ListTableRowsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTableRowsResponse
s@ListTableRowsResponse' {} Maybe Text
a -> ListTableRowsResponse
s {$sel:nextToken:ListTableRowsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTableRowsResponse)

-- | The list of row ids included in the request that were not found in the
-- table.
listTableRowsResponse_rowIdsNotFound :: Lens.Lens' ListTableRowsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
listTableRowsResponse_rowIdsNotFound :: Lens' ListTableRowsResponse (Maybe (NonEmpty Text))
listTableRowsResponse_rowIdsNotFound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRowsResponse' {Maybe (NonEmpty Text)
rowIdsNotFound :: Maybe (NonEmpty Text)
$sel:rowIdsNotFound:ListTableRowsResponse' :: ListTableRowsResponse -> Maybe (NonEmpty Text)
rowIdsNotFound} -> Maybe (NonEmpty Text)
rowIdsNotFound) (\s :: ListTableRowsResponse
s@ListTableRowsResponse' {} Maybe (NonEmpty Text)
a -> ListTableRowsResponse
s {$sel:rowIdsNotFound:ListTableRowsResponse' :: Maybe (NonEmpty Text)
rowIdsNotFound = Maybe (NonEmpty Text)
a} :: ListTableRowsResponse) 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.
listTableRowsResponse_httpStatus :: Lens.Lens' ListTableRowsResponse Prelude.Int
listTableRowsResponse_httpStatus :: Lens' ListTableRowsResponse Int
listTableRowsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRowsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTableRowsResponse' :: ListTableRowsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTableRowsResponse
s@ListTableRowsResponse' {} Int
a -> ListTableRowsResponse
s {$sel:httpStatus:ListTableRowsResponse' :: Int
httpStatus = Int
a} :: ListTableRowsResponse)

-- | The list of columns in the table whose row data is returned in the
-- result.
listTableRowsResponse_columnIds :: Lens.Lens' ListTableRowsResponse (Prelude.NonEmpty Prelude.Text)
listTableRowsResponse_columnIds :: Lens' ListTableRowsResponse (NonEmpty Text)
listTableRowsResponse_columnIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRowsResponse' {NonEmpty Text
columnIds :: NonEmpty Text
$sel:columnIds:ListTableRowsResponse' :: ListTableRowsResponse -> NonEmpty Text
columnIds} -> NonEmpty Text
columnIds) (\s :: ListTableRowsResponse
s@ListTableRowsResponse' {} NonEmpty Text
a -> ListTableRowsResponse
s {$sel:columnIds:ListTableRowsResponse' :: NonEmpty Text
columnIds = NonEmpty Text
a} :: ListTableRowsResponse) 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

-- | The list of rows in the table. Note that this result is paginated, so
-- this list contains a maximum of 100 rows.
listTableRowsResponse_rows :: Lens.Lens' ListTableRowsResponse [TableRow]
listTableRowsResponse_rows :: Lens' ListTableRowsResponse [TableRow]
listTableRowsResponse_rows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRowsResponse' {[TableRow]
rows :: [TableRow]
$sel:rows:ListTableRowsResponse' :: ListTableRowsResponse -> [TableRow]
rows} -> [TableRow]
rows) (\s :: ListTableRowsResponse
s@ListTableRowsResponse' {} [TableRow]
a -> ListTableRowsResponse
s {$sel:rows:ListTableRowsResponse' :: [TableRow]
rows = [TableRow]
a} :: ListTableRowsResponse) 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

-- | Indicates the cursor of the workbook at which the data returned by this
-- request is read. Workbook cursor keeps increasing with every update and
-- the increments are not sequential.
listTableRowsResponse_workbookCursor :: Lens.Lens' ListTableRowsResponse Prelude.Integer
listTableRowsResponse_workbookCursor :: Lens' ListTableRowsResponse Integer
listTableRowsResponse_workbookCursor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTableRowsResponse' {Integer
workbookCursor :: Integer
$sel:workbookCursor:ListTableRowsResponse' :: ListTableRowsResponse -> Integer
workbookCursor} -> Integer
workbookCursor) (\s :: ListTableRowsResponse
s@ListTableRowsResponse' {} Integer
a -> ListTableRowsResponse
s {$sel:workbookCursor:ListTableRowsResponse' :: Integer
workbookCursor = Integer
a} :: ListTableRowsResponse)

instance Prelude.NFData ListTableRowsResponse where
  rnf :: ListTableRowsResponse -> ()
rnf ListTableRowsResponse' {Int
Integer
[TableRow]
Maybe (NonEmpty Text)
Maybe Text
NonEmpty Text
workbookCursor :: Integer
rows :: [TableRow]
columnIds :: NonEmpty Text
httpStatus :: Int
rowIdsNotFound :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
$sel:workbookCursor:ListTableRowsResponse' :: ListTableRowsResponse -> Integer
$sel:rows:ListTableRowsResponse' :: ListTableRowsResponse -> [TableRow]
$sel:columnIds:ListTableRowsResponse' :: ListTableRowsResponse -> NonEmpty Text
$sel:httpStatus:ListTableRowsResponse' :: ListTableRowsResponse -> Int
$sel:rowIdsNotFound:ListTableRowsResponse' :: ListTableRowsResponse -> Maybe (NonEmpty Text)
$sel:nextToken:ListTableRowsResponse' :: ListTableRowsResponse -> 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 (NonEmpty Text)
rowIdsNotFound
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 NonEmpty Text
columnIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [TableRow]
rows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
workbookCursor