{-# 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.BatchDeleteTableRows
-- 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 BatchDeleteTableRows API allows you to delete one or more rows from
-- a table in a workbook. You need to specify the ids of the rows that you
-- want to delete from the table.
module Amazonka.HoneyCode.BatchDeleteTableRows
  ( -- * Creating a Request
    BatchDeleteTableRows (..),
    newBatchDeleteTableRows,

    -- * Request Lenses
    batchDeleteTableRows_clientRequestToken,
    batchDeleteTableRows_workbookId,
    batchDeleteTableRows_tableId,
    batchDeleteTableRows_rowIds,

    -- * Destructuring the Response
    BatchDeleteTableRowsResponse (..),
    newBatchDeleteTableRowsResponse,

    -- * Response Lenses
    batchDeleteTableRowsResponse_failedBatchItems,
    batchDeleteTableRowsResponse_httpStatus,
    batchDeleteTableRowsResponse_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:/ 'newBatchDeleteTableRows' smart constructor.
data BatchDeleteTableRows = BatchDeleteTableRows'
  { -- | The request token for performing the delete action. Request tokens help
    -- to identify duplicate requests. If a call times out or fails due to a
    -- transient error like a failed network connection, you can retry the call
    -- with the same request token. The service ensures that if the first call
    -- using that request token is successfully performed, the second call will
    -- not perform the action again.
    --
    -- Note that request tokens are valid only for a few minutes. You cannot
    -- use request tokens to dedupe requests spanning hours or days.
    BatchDeleteTableRows -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the workbook where the rows are being deleted.
    --
    -- If a workbook with the specified id could not be found, this API throws
    -- ResourceNotFoundException.
    BatchDeleteTableRows -> Text
workbookId :: Prelude.Text,
    -- | The ID of the table where the rows are being deleted.
    --
    -- If a table with the specified id could not be found, this API throws
    -- ResourceNotFoundException.
    BatchDeleteTableRows -> Text
tableId :: Prelude.Text,
    -- | The list of row ids to delete from the table. You need to specify at
    -- least one row id in this list.
    --
    -- Note that if one of the row ids provided in the request does not exist
    -- in the table, then the request fails and no rows are deleted from the
    -- table.
    BatchDeleteTableRows -> NonEmpty Text
rowIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchDeleteTableRows -> BatchDeleteTableRows -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDeleteTableRows -> BatchDeleteTableRows -> Bool
$c/= :: BatchDeleteTableRows -> BatchDeleteTableRows -> Bool
== :: BatchDeleteTableRows -> BatchDeleteTableRows -> Bool
$c== :: BatchDeleteTableRows -> BatchDeleteTableRows -> Bool
Prelude.Eq, ReadPrec [BatchDeleteTableRows]
ReadPrec BatchDeleteTableRows
Int -> ReadS BatchDeleteTableRows
ReadS [BatchDeleteTableRows]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDeleteTableRows]
$creadListPrec :: ReadPrec [BatchDeleteTableRows]
readPrec :: ReadPrec BatchDeleteTableRows
$creadPrec :: ReadPrec BatchDeleteTableRows
readList :: ReadS [BatchDeleteTableRows]
$creadList :: ReadS [BatchDeleteTableRows]
readsPrec :: Int -> ReadS BatchDeleteTableRows
$creadsPrec :: Int -> ReadS BatchDeleteTableRows
Prelude.Read, Int -> BatchDeleteTableRows -> ShowS
[BatchDeleteTableRows] -> ShowS
BatchDeleteTableRows -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDeleteTableRows] -> ShowS
$cshowList :: [BatchDeleteTableRows] -> ShowS
show :: BatchDeleteTableRows -> String
$cshow :: BatchDeleteTableRows -> String
showsPrec :: Int -> BatchDeleteTableRows -> ShowS
$cshowsPrec :: Int -> BatchDeleteTableRows -> ShowS
Prelude.Show, forall x. Rep BatchDeleteTableRows x -> BatchDeleteTableRows
forall x. BatchDeleteTableRows -> Rep BatchDeleteTableRows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchDeleteTableRows x -> BatchDeleteTableRows
$cfrom :: forall x. BatchDeleteTableRows -> Rep BatchDeleteTableRows x
Prelude.Generic)

-- |
-- Create a value of 'BatchDeleteTableRows' 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:
--
-- 'clientRequestToken', 'batchDeleteTableRows_clientRequestToken' - The request token for performing the delete action. Request tokens help
-- to identify duplicate requests. If a call times out or fails due to a
-- transient error like a failed network connection, you can retry the call
-- with the same request token. The service ensures that if the first call
-- using that request token is successfully performed, the second call will
-- not perform the action again.
--
-- Note that request tokens are valid only for a few minutes. You cannot
-- use request tokens to dedupe requests spanning hours or days.
--
-- 'workbookId', 'batchDeleteTableRows_workbookId' - The ID of the workbook where the rows are being deleted.
--
-- If a workbook with the specified id could not be found, this API throws
-- ResourceNotFoundException.
--
-- 'tableId', 'batchDeleteTableRows_tableId' - The ID of the table where the rows are being deleted.
--
-- If a table with the specified id could not be found, this API throws
-- ResourceNotFoundException.
--
-- 'rowIds', 'batchDeleteTableRows_rowIds' - The list of row ids to delete from the table. You need to specify at
-- least one row id in this list.
--
-- Note that if one of the row ids provided in the request does not exist
-- in the table, then the request fails and no rows are deleted from the
-- table.
newBatchDeleteTableRows ::
  -- | 'workbookId'
  Prelude.Text ->
  -- | 'tableId'
  Prelude.Text ->
  -- | 'rowIds'
  Prelude.NonEmpty Prelude.Text ->
  BatchDeleteTableRows
newBatchDeleteTableRows :: Text -> Text -> NonEmpty Text -> BatchDeleteTableRows
newBatchDeleteTableRows
  Text
pWorkbookId_
  Text
pTableId_
  NonEmpty Text
pRowIds_ =
    BatchDeleteTableRows'
      { $sel:clientRequestToken:BatchDeleteTableRows' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:workbookId:BatchDeleteTableRows' :: Text
workbookId = Text
pWorkbookId_,
        $sel:tableId:BatchDeleteTableRows' :: Text
tableId = Text
pTableId_,
        $sel:rowIds:BatchDeleteTableRows' :: NonEmpty Text
rowIds = 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
pRowIds_
      }

-- | The request token for performing the delete action. Request tokens help
-- to identify duplicate requests. If a call times out or fails due to a
-- transient error like a failed network connection, you can retry the call
-- with the same request token. The service ensures that if the first call
-- using that request token is successfully performed, the second call will
-- not perform the action again.
--
-- Note that request tokens are valid only for a few minutes. You cannot
-- use request tokens to dedupe requests spanning hours or days.
batchDeleteTableRows_clientRequestToken :: Lens.Lens' BatchDeleteTableRows (Prelude.Maybe Prelude.Text)
batchDeleteTableRows_clientRequestToken :: Lens' BatchDeleteTableRows (Maybe Text)
batchDeleteTableRows_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteTableRows' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:BatchDeleteTableRows' :: BatchDeleteTableRows -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: BatchDeleteTableRows
s@BatchDeleteTableRows' {} Maybe Text
a -> BatchDeleteTableRows
s {$sel:clientRequestToken:BatchDeleteTableRows' :: Maybe Text
clientRequestToken = Maybe Text
a} :: BatchDeleteTableRows)

-- | The ID of the workbook where the rows are being deleted.
--
-- If a workbook with the specified id could not be found, this API throws
-- ResourceNotFoundException.
batchDeleteTableRows_workbookId :: Lens.Lens' BatchDeleteTableRows Prelude.Text
batchDeleteTableRows_workbookId :: Lens' BatchDeleteTableRows Text
batchDeleteTableRows_workbookId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteTableRows' {Text
workbookId :: Text
$sel:workbookId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
workbookId} -> Text
workbookId) (\s :: BatchDeleteTableRows
s@BatchDeleteTableRows' {} Text
a -> BatchDeleteTableRows
s {$sel:workbookId:BatchDeleteTableRows' :: Text
workbookId = Text
a} :: BatchDeleteTableRows)

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

-- | The list of row ids to delete from the table. You need to specify at
-- least one row id in this list.
--
-- Note that if one of the row ids provided in the request does not exist
-- in the table, then the request fails and no rows are deleted from the
-- table.
batchDeleteTableRows_rowIds :: Lens.Lens' BatchDeleteTableRows (Prelude.NonEmpty Prelude.Text)
batchDeleteTableRows_rowIds :: Lens' BatchDeleteTableRows (NonEmpty Text)
batchDeleteTableRows_rowIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteTableRows' {NonEmpty Text
rowIds :: NonEmpty Text
$sel:rowIds:BatchDeleteTableRows' :: BatchDeleteTableRows -> NonEmpty Text
rowIds} -> NonEmpty Text
rowIds) (\s :: BatchDeleteTableRows
s@BatchDeleteTableRows' {} NonEmpty Text
a -> BatchDeleteTableRows
s {$sel:rowIds:BatchDeleteTableRows' :: NonEmpty Text
rowIds = NonEmpty Text
a} :: BatchDeleteTableRows) 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

instance Core.AWSRequest BatchDeleteTableRows where
  type
    AWSResponse BatchDeleteTableRows =
      BatchDeleteTableRowsResponse
  request :: (Service -> Service)
-> BatchDeleteTableRows -> Request BatchDeleteTableRows
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 BatchDeleteTableRows
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchDeleteTableRows)))
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 [FailedBatchItem]
-> Int -> Integer -> BatchDeleteTableRowsResponse
BatchDeleteTableRowsResponse'
            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
"failedBatchItems"
                            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))
            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 BatchDeleteTableRows where
  hashWithSalt :: Int -> BatchDeleteTableRows -> Int
hashWithSalt Int
_salt BatchDeleteTableRows' {Maybe Text
NonEmpty Text
Text
rowIds :: NonEmpty Text
tableId :: Text
workbookId :: Text
clientRequestToken :: Maybe Text
$sel:rowIds:BatchDeleteTableRows' :: BatchDeleteTableRows -> NonEmpty Text
$sel:tableId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
$sel:workbookId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
$sel:clientRequestToken:BatchDeleteTableRows' :: BatchDeleteTableRows -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workbookId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
rowIds

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

instance Data.ToHeaders BatchDeleteTableRows where
  toHeaders :: BatchDeleteTableRows -> 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 BatchDeleteTableRows where
  toJSON :: BatchDeleteTableRows -> Value
toJSON BatchDeleteTableRows' {Maybe Text
NonEmpty Text
Text
rowIds :: NonEmpty Text
tableId :: Text
workbookId :: Text
clientRequestToken :: Maybe Text
$sel:rowIds:BatchDeleteTableRows' :: BatchDeleteTableRows -> NonEmpty Text
$sel:tableId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
$sel:workbookId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
$sel:clientRequestToken:BatchDeleteTableRows' :: BatchDeleteTableRows -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientRequestToken" 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
clientRequestToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"rowIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
rowIds)
          ]
      )

instance Data.ToPath BatchDeleteTableRows where
  toPath :: BatchDeleteTableRows -> ByteString
toPath BatchDeleteTableRows' {Maybe Text
NonEmpty Text
Text
rowIds :: NonEmpty Text
tableId :: Text
workbookId :: Text
clientRequestToken :: Maybe Text
$sel:rowIds:BatchDeleteTableRows' :: BatchDeleteTableRows -> NonEmpty Text
$sel:tableId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
$sel:workbookId:BatchDeleteTableRows' :: BatchDeleteTableRows -> Text
$sel:clientRequestToken:BatchDeleteTableRows' :: BatchDeleteTableRows -> Maybe Text
..} =
    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/batchdelete"
      ]

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

-- | /See:/ 'newBatchDeleteTableRowsResponse' smart constructor.
data BatchDeleteTableRowsResponse = BatchDeleteTableRowsResponse'
  { -- | The list of row ids in the request that could not be deleted from the
    -- table. Each element in this list contains one row id from the request
    -- that could not be deleted along with the reason why that item could not
    -- be deleted.
    BatchDeleteTableRowsResponse -> Maybe [FailedBatchItem]
failedBatchItems :: Prelude.Maybe [FailedBatchItem],
    -- | The response's http status code.
    BatchDeleteTableRowsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The updated workbook cursor after deleting the rows from the table.
    BatchDeleteTableRowsResponse -> Integer
workbookCursor :: Prelude.Integer
  }
  deriving (BatchDeleteTableRowsResponse
-> BatchDeleteTableRowsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDeleteTableRowsResponse
-> BatchDeleteTableRowsResponse -> Bool
$c/= :: BatchDeleteTableRowsResponse
-> BatchDeleteTableRowsResponse -> Bool
== :: BatchDeleteTableRowsResponse
-> BatchDeleteTableRowsResponse -> Bool
$c== :: BatchDeleteTableRowsResponse
-> BatchDeleteTableRowsResponse -> Bool
Prelude.Eq, ReadPrec [BatchDeleteTableRowsResponse]
ReadPrec BatchDeleteTableRowsResponse
Int -> ReadS BatchDeleteTableRowsResponse
ReadS [BatchDeleteTableRowsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDeleteTableRowsResponse]
$creadListPrec :: ReadPrec [BatchDeleteTableRowsResponse]
readPrec :: ReadPrec BatchDeleteTableRowsResponse
$creadPrec :: ReadPrec BatchDeleteTableRowsResponse
readList :: ReadS [BatchDeleteTableRowsResponse]
$creadList :: ReadS [BatchDeleteTableRowsResponse]
readsPrec :: Int -> ReadS BatchDeleteTableRowsResponse
$creadsPrec :: Int -> ReadS BatchDeleteTableRowsResponse
Prelude.Read, Int -> BatchDeleteTableRowsResponse -> ShowS
[BatchDeleteTableRowsResponse] -> ShowS
BatchDeleteTableRowsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDeleteTableRowsResponse] -> ShowS
$cshowList :: [BatchDeleteTableRowsResponse] -> ShowS
show :: BatchDeleteTableRowsResponse -> String
$cshow :: BatchDeleteTableRowsResponse -> String
showsPrec :: Int -> BatchDeleteTableRowsResponse -> ShowS
$cshowsPrec :: Int -> BatchDeleteTableRowsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchDeleteTableRowsResponse x -> BatchDeleteTableRowsResponse
forall x.
BatchDeleteTableRowsResponse -> Rep BatchDeleteTableRowsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchDeleteTableRowsResponse x -> BatchDeleteTableRowsResponse
$cfrom :: forall x.
BatchDeleteTableRowsResponse -> Rep BatchDeleteTableRowsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchDeleteTableRowsResponse' 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:
--
-- 'failedBatchItems', 'batchDeleteTableRowsResponse_failedBatchItems' - The list of row ids in the request that could not be deleted from the
-- table. Each element in this list contains one row id from the request
-- that could not be deleted along with the reason why that item could not
-- be deleted.
--
-- 'httpStatus', 'batchDeleteTableRowsResponse_httpStatus' - The response's http status code.
--
-- 'workbookCursor', 'batchDeleteTableRowsResponse_workbookCursor' - The updated workbook cursor after deleting the rows from the table.
newBatchDeleteTableRowsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workbookCursor'
  Prelude.Integer ->
  BatchDeleteTableRowsResponse
newBatchDeleteTableRowsResponse :: Int -> Integer -> BatchDeleteTableRowsResponse
newBatchDeleteTableRowsResponse
  Int
pHttpStatus_
  Integer
pWorkbookCursor_ =
    BatchDeleteTableRowsResponse'
      { $sel:failedBatchItems:BatchDeleteTableRowsResponse' :: Maybe [FailedBatchItem]
failedBatchItems =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:BatchDeleteTableRowsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:workbookCursor:BatchDeleteTableRowsResponse' :: Integer
workbookCursor = Integer
pWorkbookCursor_
      }

-- | The list of row ids in the request that could not be deleted from the
-- table. Each element in this list contains one row id from the request
-- that could not be deleted along with the reason why that item could not
-- be deleted.
batchDeleteTableRowsResponse_failedBatchItems :: Lens.Lens' BatchDeleteTableRowsResponse (Prelude.Maybe [FailedBatchItem])
batchDeleteTableRowsResponse_failedBatchItems :: Lens' BatchDeleteTableRowsResponse (Maybe [FailedBatchItem])
batchDeleteTableRowsResponse_failedBatchItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteTableRowsResponse' {Maybe [FailedBatchItem]
failedBatchItems :: Maybe [FailedBatchItem]
$sel:failedBatchItems:BatchDeleteTableRowsResponse' :: BatchDeleteTableRowsResponse -> Maybe [FailedBatchItem]
failedBatchItems} -> Maybe [FailedBatchItem]
failedBatchItems) (\s :: BatchDeleteTableRowsResponse
s@BatchDeleteTableRowsResponse' {} Maybe [FailedBatchItem]
a -> BatchDeleteTableRowsResponse
s {$sel:failedBatchItems:BatchDeleteTableRowsResponse' :: Maybe [FailedBatchItem]
failedBatchItems = Maybe [FailedBatchItem]
a} :: BatchDeleteTableRowsResponse) 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.
batchDeleteTableRowsResponse_httpStatus :: Lens.Lens' BatchDeleteTableRowsResponse Prelude.Int
batchDeleteTableRowsResponse_httpStatus :: Lens' BatchDeleteTableRowsResponse Int
batchDeleteTableRowsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteTableRowsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchDeleteTableRowsResponse' :: BatchDeleteTableRowsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchDeleteTableRowsResponse
s@BatchDeleteTableRowsResponse' {} Int
a -> BatchDeleteTableRowsResponse
s {$sel:httpStatus:BatchDeleteTableRowsResponse' :: Int
httpStatus = Int
a} :: BatchDeleteTableRowsResponse)

-- | The updated workbook cursor after deleting the rows from the table.
batchDeleteTableRowsResponse_workbookCursor :: Lens.Lens' BatchDeleteTableRowsResponse Prelude.Integer
batchDeleteTableRowsResponse_workbookCursor :: Lens' BatchDeleteTableRowsResponse Integer
batchDeleteTableRowsResponse_workbookCursor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteTableRowsResponse' {Integer
workbookCursor :: Integer
$sel:workbookCursor:BatchDeleteTableRowsResponse' :: BatchDeleteTableRowsResponse -> Integer
workbookCursor} -> Integer
workbookCursor) (\s :: BatchDeleteTableRowsResponse
s@BatchDeleteTableRowsResponse' {} Integer
a -> BatchDeleteTableRowsResponse
s {$sel:workbookCursor:BatchDeleteTableRowsResponse' :: Integer
workbookCursor = Integer
a} :: BatchDeleteTableRowsResponse)

instance Prelude.NFData BatchDeleteTableRowsResponse where
  rnf :: BatchDeleteTableRowsResponse -> ()
rnf BatchDeleteTableRowsResponse' {Int
Integer
Maybe [FailedBatchItem]
workbookCursor :: Integer
httpStatus :: Int
failedBatchItems :: Maybe [FailedBatchItem]
$sel:workbookCursor:BatchDeleteTableRowsResponse' :: BatchDeleteTableRowsResponse -> Integer
$sel:httpStatus:BatchDeleteTableRowsResponse' :: BatchDeleteTableRowsResponse -> Int
$sel:failedBatchItems:BatchDeleteTableRowsResponse' :: BatchDeleteTableRowsResponse -> Maybe [FailedBatchItem]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedBatchItem]
failedBatchItems
      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 Integer
workbookCursor