{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DynamoDB.Types.BatchStatementResponse
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DynamoDB.Types.BatchStatementResponse where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DynamoDB.Types.AttributeValue
import Amazonka.DynamoDB.Types.BatchStatementError
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | A PartiQL batch statement response..
--
-- /See:/ 'newBatchStatementResponse' smart constructor.
data BatchStatementResponse = BatchStatementResponse'
  { -- | The error associated with a failed PartiQL batch statement.
    BatchStatementResponse -> Maybe BatchStatementError
error :: Prelude.Maybe BatchStatementError,
    -- | A DynamoDB item associated with a BatchStatementResponse
    BatchStatementResponse -> Maybe (HashMap Text AttributeValue)
item :: Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeValue),
    -- | The table name associated with a failed PartiQL batch statement.
    BatchStatementResponse -> Maybe Text
tableName :: Prelude.Maybe Prelude.Text
  }
  deriving (BatchStatementResponse -> BatchStatementResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchStatementResponse -> BatchStatementResponse -> Bool
$c/= :: BatchStatementResponse -> BatchStatementResponse -> Bool
== :: BatchStatementResponse -> BatchStatementResponse -> Bool
$c== :: BatchStatementResponse -> BatchStatementResponse -> Bool
Prelude.Eq, ReadPrec [BatchStatementResponse]
ReadPrec BatchStatementResponse
Int -> ReadS BatchStatementResponse
ReadS [BatchStatementResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchStatementResponse]
$creadListPrec :: ReadPrec [BatchStatementResponse]
readPrec :: ReadPrec BatchStatementResponse
$creadPrec :: ReadPrec BatchStatementResponse
readList :: ReadS [BatchStatementResponse]
$creadList :: ReadS [BatchStatementResponse]
readsPrec :: Int -> ReadS BatchStatementResponse
$creadsPrec :: Int -> ReadS BatchStatementResponse
Prelude.Read, Int -> BatchStatementResponse -> ShowS
[BatchStatementResponse] -> ShowS
BatchStatementResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchStatementResponse] -> ShowS
$cshowList :: [BatchStatementResponse] -> ShowS
show :: BatchStatementResponse -> String
$cshow :: BatchStatementResponse -> String
showsPrec :: Int -> BatchStatementResponse -> ShowS
$cshowsPrec :: Int -> BatchStatementResponse -> ShowS
Prelude.Show, forall x. Rep BatchStatementResponse x -> BatchStatementResponse
forall x. BatchStatementResponse -> Rep BatchStatementResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchStatementResponse x -> BatchStatementResponse
$cfrom :: forall x. BatchStatementResponse -> Rep BatchStatementResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchStatementResponse' 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:
--
-- 'error', 'batchStatementResponse_error' - The error associated with a failed PartiQL batch statement.
--
-- 'item', 'batchStatementResponse_item' - A DynamoDB item associated with a BatchStatementResponse
--
-- 'tableName', 'batchStatementResponse_tableName' - The table name associated with a failed PartiQL batch statement.
newBatchStatementResponse ::
  BatchStatementResponse
newBatchStatementResponse :: BatchStatementResponse
newBatchStatementResponse =
  BatchStatementResponse'
    { $sel:error:BatchStatementResponse' :: Maybe BatchStatementError
error = forall a. Maybe a
Prelude.Nothing,
      $sel:item:BatchStatementResponse' :: Maybe (HashMap Text AttributeValue)
item = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:BatchStatementResponse' :: Maybe Text
tableName = forall a. Maybe a
Prelude.Nothing
    }

-- | The error associated with a failed PartiQL batch statement.
batchStatementResponse_error :: Lens.Lens' BatchStatementResponse (Prelude.Maybe BatchStatementError)
batchStatementResponse_error :: Lens' BatchStatementResponse (Maybe BatchStatementError)
batchStatementResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchStatementResponse' {Maybe BatchStatementError
error :: Maybe BatchStatementError
$sel:error:BatchStatementResponse' :: BatchStatementResponse -> Maybe BatchStatementError
error} -> Maybe BatchStatementError
error) (\s :: BatchStatementResponse
s@BatchStatementResponse' {} Maybe BatchStatementError
a -> BatchStatementResponse
s {$sel:error:BatchStatementResponse' :: Maybe BatchStatementError
error = Maybe BatchStatementError
a} :: BatchStatementResponse)

-- | A DynamoDB item associated with a BatchStatementResponse
batchStatementResponse_item :: Lens.Lens' BatchStatementResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeValue))
batchStatementResponse_item :: Lens' BatchStatementResponse (Maybe (HashMap Text AttributeValue))
batchStatementResponse_item = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchStatementResponse' {Maybe (HashMap Text AttributeValue)
item :: Maybe (HashMap Text AttributeValue)
$sel:item:BatchStatementResponse' :: BatchStatementResponse -> Maybe (HashMap Text AttributeValue)
item} -> Maybe (HashMap Text AttributeValue)
item) (\s :: BatchStatementResponse
s@BatchStatementResponse' {} Maybe (HashMap Text AttributeValue)
a -> BatchStatementResponse
s {$sel:item:BatchStatementResponse' :: Maybe (HashMap Text AttributeValue)
item = Maybe (HashMap Text AttributeValue)
a} :: BatchStatementResponse) 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 table name associated with a failed PartiQL batch statement.
batchStatementResponse_tableName :: Lens.Lens' BatchStatementResponse (Prelude.Maybe Prelude.Text)
batchStatementResponse_tableName :: Lens' BatchStatementResponse (Maybe Text)
batchStatementResponse_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchStatementResponse' {Maybe Text
tableName :: Maybe Text
$sel:tableName:BatchStatementResponse' :: BatchStatementResponse -> Maybe Text
tableName} -> Maybe Text
tableName) (\s :: BatchStatementResponse
s@BatchStatementResponse' {} Maybe Text
a -> BatchStatementResponse
s {$sel:tableName:BatchStatementResponse' :: Maybe Text
tableName = Maybe Text
a} :: BatchStatementResponse)

instance Data.FromJSON BatchStatementResponse where
  parseJSON :: Value -> Parser BatchStatementResponse
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BatchStatementResponse"
      ( \Object
x ->
          Maybe BatchStatementError
-> Maybe (HashMap Text AttributeValue)
-> Maybe Text
-> BatchStatementResponse
BatchStatementResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Error")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Item" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"TableName")
      )

instance Prelude.Hashable BatchStatementResponse where
  hashWithSalt :: Int -> BatchStatementResponse -> Int
hashWithSalt Int
_salt BatchStatementResponse' {Maybe Text
Maybe (HashMap Text AttributeValue)
Maybe BatchStatementError
tableName :: Maybe Text
item :: Maybe (HashMap Text AttributeValue)
error :: Maybe BatchStatementError
$sel:tableName:BatchStatementResponse' :: BatchStatementResponse -> Maybe Text
$sel:item:BatchStatementResponse' :: BatchStatementResponse -> Maybe (HashMap Text AttributeValue)
$sel:error:BatchStatementResponse' :: BatchStatementResponse -> Maybe BatchStatementError
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BatchStatementError
error
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text AttributeValue)
item
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tableName

instance Prelude.NFData BatchStatementResponse where
  rnf :: BatchStatementResponse -> ()
rnf BatchStatementResponse' {Maybe Text
Maybe (HashMap Text AttributeValue)
Maybe BatchStatementError
tableName :: Maybe Text
item :: Maybe (HashMap Text AttributeValue)
error :: Maybe BatchStatementError
$sel:tableName:BatchStatementResponse' :: BatchStatementResponse -> Maybe Text
$sel:item:BatchStatementResponse' :: BatchStatementResponse -> Maybe (HashMap Text AttributeValue)
$sel:error:BatchStatementResponse' :: BatchStatementResponse -> Maybe BatchStatementError
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchStatementError
error
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AttributeValue)
item
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableName