{-# 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.Glue.GetColumnStatisticsForTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves table statistics of columns.
--
-- The Identity and Access Management (IAM) permission required for this
-- operation is @GetTable@.
module Amazonka.Glue.GetColumnStatisticsForTable
  ( -- * Creating a Request
    GetColumnStatisticsForTable (..),
    newGetColumnStatisticsForTable,

    -- * Request Lenses
    getColumnStatisticsForTable_catalogId,
    getColumnStatisticsForTable_databaseName,
    getColumnStatisticsForTable_tableName,
    getColumnStatisticsForTable_columnNames,

    -- * Destructuring the Response
    GetColumnStatisticsForTableResponse (..),
    newGetColumnStatisticsForTableResponse,

    -- * Response Lenses
    getColumnStatisticsForTableResponse_columnStatisticsList,
    getColumnStatisticsForTableResponse_errors,
    getColumnStatisticsForTableResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetColumnStatisticsForTable' smart constructor.
data GetColumnStatisticsForTable = GetColumnStatisticsForTable'
  { -- | The ID of the Data Catalog where the partitions in question reside. If
    -- none is supplied, the Amazon Web Services account ID is used by default.
    GetColumnStatisticsForTable -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | The name of the catalog database where the partitions reside.
    GetColumnStatisticsForTable -> Text
databaseName :: Prelude.Text,
    -- | The name of the partitions\' table.
    GetColumnStatisticsForTable -> Text
tableName :: Prelude.Text,
    -- | A list of the column names.
    GetColumnStatisticsForTable -> [Text]
columnNames :: [Prelude.Text]
  }
  deriving (GetColumnStatisticsForTable -> GetColumnStatisticsForTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetColumnStatisticsForTable -> GetColumnStatisticsForTable -> Bool
$c/= :: GetColumnStatisticsForTable -> GetColumnStatisticsForTable -> Bool
== :: GetColumnStatisticsForTable -> GetColumnStatisticsForTable -> Bool
$c== :: GetColumnStatisticsForTable -> GetColumnStatisticsForTable -> Bool
Prelude.Eq, ReadPrec [GetColumnStatisticsForTable]
ReadPrec GetColumnStatisticsForTable
Int -> ReadS GetColumnStatisticsForTable
ReadS [GetColumnStatisticsForTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetColumnStatisticsForTable]
$creadListPrec :: ReadPrec [GetColumnStatisticsForTable]
readPrec :: ReadPrec GetColumnStatisticsForTable
$creadPrec :: ReadPrec GetColumnStatisticsForTable
readList :: ReadS [GetColumnStatisticsForTable]
$creadList :: ReadS [GetColumnStatisticsForTable]
readsPrec :: Int -> ReadS GetColumnStatisticsForTable
$creadsPrec :: Int -> ReadS GetColumnStatisticsForTable
Prelude.Read, Int -> GetColumnStatisticsForTable -> ShowS
[GetColumnStatisticsForTable] -> ShowS
GetColumnStatisticsForTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetColumnStatisticsForTable] -> ShowS
$cshowList :: [GetColumnStatisticsForTable] -> ShowS
show :: GetColumnStatisticsForTable -> String
$cshow :: GetColumnStatisticsForTable -> String
showsPrec :: Int -> GetColumnStatisticsForTable -> ShowS
$cshowsPrec :: Int -> GetColumnStatisticsForTable -> ShowS
Prelude.Show, forall x.
Rep GetColumnStatisticsForTable x -> GetColumnStatisticsForTable
forall x.
GetColumnStatisticsForTable -> Rep GetColumnStatisticsForTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetColumnStatisticsForTable x -> GetColumnStatisticsForTable
$cfrom :: forall x.
GetColumnStatisticsForTable -> Rep GetColumnStatisticsForTable x
Prelude.Generic)

-- |
-- Create a value of 'GetColumnStatisticsForTable' 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:
--
-- 'catalogId', 'getColumnStatisticsForTable_catalogId' - The ID of the Data Catalog where the partitions in question reside. If
-- none is supplied, the Amazon Web Services account ID is used by default.
--
-- 'databaseName', 'getColumnStatisticsForTable_databaseName' - The name of the catalog database where the partitions reside.
--
-- 'tableName', 'getColumnStatisticsForTable_tableName' - The name of the partitions\' table.
--
-- 'columnNames', 'getColumnStatisticsForTable_columnNames' - A list of the column names.
newGetColumnStatisticsForTable ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  GetColumnStatisticsForTable
newGetColumnStatisticsForTable :: Text -> Text -> GetColumnStatisticsForTable
newGetColumnStatisticsForTable
  Text
pDatabaseName_
  Text
pTableName_ =
    GetColumnStatisticsForTable'
      { $sel:catalogId:GetColumnStatisticsForTable' :: Maybe Text
catalogId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:databaseName:GetColumnStatisticsForTable' :: Text
databaseName = Text
pDatabaseName_,
        $sel:tableName:GetColumnStatisticsForTable' :: Text
tableName = Text
pTableName_,
        $sel:columnNames:GetColumnStatisticsForTable' :: [Text]
columnNames = forall a. Monoid a => a
Prelude.mempty
      }

-- | The ID of the Data Catalog where the partitions in question reside. If
-- none is supplied, the Amazon Web Services account ID is used by default.
getColumnStatisticsForTable_catalogId :: Lens.Lens' GetColumnStatisticsForTable (Prelude.Maybe Prelude.Text)
getColumnStatisticsForTable_catalogId :: Lens' GetColumnStatisticsForTable (Maybe Text)
getColumnStatisticsForTable_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTable' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: GetColumnStatisticsForTable
s@GetColumnStatisticsForTable' {} Maybe Text
a -> GetColumnStatisticsForTable
s {$sel:catalogId:GetColumnStatisticsForTable' :: Maybe Text
catalogId = Maybe Text
a} :: GetColumnStatisticsForTable)

-- | The name of the catalog database where the partitions reside.
getColumnStatisticsForTable_databaseName :: Lens.Lens' GetColumnStatisticsForTable Prelude.Text
getColumnStatisticsForTable_databaseName :: Lens' GetColumnStatisticsForTable Text
getColumnStatisticsForTable_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTable' {Text
databaseName :: Text
$sel:databaseName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
databaseName} -> Text
databaseName) (\s :: GetColumnStatisticsForTable
s@GetColumnStatisticsForTable' {} Text
a -> GetColumnStatisticsForTable
s {$sel:databaseName:GetColumnStatisticsForTable' :: Text
databaseName = Text
a} :: GetColumnStatisticsForTable)

-- | The name of the partitions\' table.
getColumnStatisticsForTable_tableName :: Lens.Lens' GetColumnStatisticsForTable Prelude.Text
getColumnStatisticsForTable_tableName :: Lens' GetColumnStatisticsForTable Text
getColumnStatisticsForTable_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTable' {Text
tableName :: Text
$sel:tableName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
tableName} -> Text
tableName) (\s :: GetColumnStatisticsForTable
s@GetColumnStatisticsForTable' {} Text
a -> GetColumnStatisticsForTable
s {$sel:tableName:GetColumnStatisticsForTable' :: Text
tableName = Text
a} :: GetColumnStatisticsForTable)

-- | A list of the column names.
getColumnStatisticsForTable_columnNames :: Lens.Lens' GetColumnStatisticsForTable [Prelude.Text]
getColumnStatisticsForTable_columnNames :: Lens' GetColumnStatisticsForTable [Text]
getColumnStatisticsForTable_columnNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTable' {[Text]
columnNames :: [Text]
$sel:columnNames:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> [Text]
columnNames} -> [Text]
columnNames) (\s :: GetColumnStatisticsForTable
s@GetColumnStatisticsForTable' {} [Text]
a -> GetColumnStatisticsForTable
s {$sel:columnNames:GetColumnStatisticsForTable' :: [Text]
columnNames = [Text]
a} :: GetColumnStatisticsForTable) 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 GetColumnStatisticsForTable where
  type
    AWSResponse GetColumnStatisticsForTable =
      GetColumnStatisticsForTableResponse
  request :: (Service -> Service)
-> GetColumnStatisticsForTable
-> Request GetColumnStatisticsForTable
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 GetColumnStatisticsForTable
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetColumnStatisticsForTable)))
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 [ColumnStatistics]
-> Maybe [ColumnError]
-> Int
-> GetColumnStatisticsForTableResponse
GetColumnStatisticsForTableResponse'
            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
"ColumnStatisticsList"
                            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
"Errors" 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 GetColumnStatisticsForTable where
  hashWithSalt :: Int -> GetColumnStatisticsForTable -> Int
hashWithSalt Int
_salt GetColumnStatisticsForTable' {[Text]
Maybe Text
Text
columnNames :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:columnNames:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> [Text]
$sel:tableName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
$sel:databaseName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
$sel:catalogId:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
catalogId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
databaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
columnNames

instance Prelude.NFData GetColumnStatisticsForTable where
  rnf :: GetColumnStatisticsForTable -> ()
rnf GetColumnStatisticsForTable' {[Text]
Maybe Text
Text
columnNames :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:columnNames:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> [Text]
$sel:tableName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
$sel:databaseName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
$sel:catalogId:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
catalogId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
databaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
columnNames

instance Data.ToHeaders GetColumnStatisticsForTable where
  toHeaders :: GetColumnStatisticsForTable -> 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
"AWSGlue.GetColumnStatisticsForTable" ::
                          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 GetColumnStatisticsForTable where
  toJSON :: GetColumnStatisticsForTable -> Value
toJSON GetColumnStatisticsForTable' {[Text]
Maybe Text
Text
columnNames :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:columnNames:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> [Text]
$sel:tableName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
$sel:databaseName:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Text
$sel:catalogId:GetColumnStatisticsForTable' :: GetColumnStatisticsForTable -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CatalogId" 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
catalogId,
            forall a. a -> Maybe a
Prelude.Just (Key
"DatabaseName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
databaseName),
            forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ColumnNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
columnNames)
          ]
      )

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

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

-- | /See:/ 'newGetColumnStatisticsForTableResponse' smart constructor.
data GetColumnStatisticsForTableResponse = GetColumnStatisticsForTableResponse'
  { -- | List of ColumnStatistics that failed to be retrieved.
    GetColumnStatisticsForTableResponse -> Maybe [ColumnStatistics]
columnStatisticsList :: Prelude.Maybe [ColumnStatistics],
    -- | List of ColumnStatistics that failed to be retrieved.
    GetColumnStatisticsForTableResponse -> Maybe [ColumnError]
errors :: Prelude.Maybe [ColumnError],
    -- | The response's http status code.
    GetColumnStatisticsForTableResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetColumnStatisticsForTableResponse
-> GetColumnStatisticsForTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetColumnStatisticsForTableResponse
-> GetColumnStatisticsForTableResponse -> Bool
$c/= :: GetColumnStatisticsForTableResponse
-> GetColumnStatisticsForTableResponse -> Bool
== :: GetColumnStatisticsForTableResponse
-> GetColumnStatisticsForTableResponse -> Bool
$c== :: GetColumnStatisticsForTableResponse
-> GetColumnStatisticsForTableResponse -> Bool
Prelude.Eq, ReadPrec [GetColumnStatisticsForTableResponse]
ReadPrec GetColumnStatisticsForTableResponse
Int -> ReadS GetColumnStatisticsForTableResponse
ReadS [GetColumnStatisticsForTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetColumnStatisticsForTableResponse]
$creadListPrec :: ReadPrec [GetColumnStatisticsForTableResponse]
readPrec :: ReadPrec GetColumnStatisticsForTableResponse
$creadPrec :: ReadPrec GetColumnStatisticsForTableResponse
readList :: ReadS [GetColumnStatisticsForTableResponse]
$creadList :: ReadS [GetColumnStatisticsForTableResponse]
readsPrec :: Int -> ReadS GetColumnStatisticsForTableResponse
$creadsPrec :: Int -> ReadS GetColumnStatisticsForTableResponse
Prelude.Read, Int -> GetColumnStatisticsForTableResponse -> ShowS
[GetColumnStatisticsForTableResponse] -> ShowS
GetColumnStatisticsForTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetColumnStatisticsForTableResponse] -> ShowS
$cshowList :: [GetColumnStatisticsForTableResponse] -> ShowS
show :: GetColumnStatisticsForTableResponse -> String
$cshow :: GetColumnStatisticsForTableResponse -> String
showsPrec :: Int -> GetColumnStatisticsForTableResponse -> ShowS
$cshowsPrec :: Int -> GetColumnStatisticsForTableResponse -> ShowS
Prelude.Show, forall x.
Rep GetColumnStatisticsForTableResponse x
-> GetColumnStatisticsForTableResponse
forall x.
GetColumnStatisticsForTableResponse
-> Rep GetColumnStatisticsForTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetColumnStatisticsForTableResponse x
-> GetColumnStatisticsForTableResponse
$cfrom :: forall x.
GetColumnStatisticsForTableResponse
-> Rep GetColumnStatisticsForTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetColumnStatisticsForTableResponse' 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:
--
-- 'columnStatisticsList', 'getColumnStatisticsForTableResponse_columnStatisticsList' - List of ColumnStatistics that failed to be retrieved.
--
-- 'errors', 'getColumnStatisticsForTableResponse_errors' - List of ColumnStatistics that failed to be retrieved.
--
-- 'httpStatus', 'getColumnStatisticsForTableResponse_httpStatus' - The response's http status code.
newGetColumnStatisticsForTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetColumnStatisticsForTableResponse
newGetColumnStatisticsForTableResponse :: Int -> GetColumnStatisticsForTableResponse
newGetColumnStatisticsForTableResponse Int
pHttpStatus_ =
  GetColumnStatisticsForTableResponse'
    { $sel:columnStatisticsList:GetColumnStatisticsForTableResponse' :: Maybe [ColumnStatistics]
columnStatisticsList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errors:GetColumnStatisticsForTableResponse' :: Maybe [ColumnError]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetColumnStatisticsForTableResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of ColumnStatistics that failed to be retrieved.
getColumnStatisticsForTableResponse_columnStatisticsList :: Lens.Lens' GetColumnStatisticsForTableResponse (Prelude.Maybe [ColumnStatistics])
getColumnStatisticsForTableResponse_columnStatisticsList :: Lens'
  GetColumnStatisticsForTableResponse (Maybe [ColumnStatistics])
getColumnStatisticsForTableResponse_columnStatisticsList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTableResponse' {Maybe [ColumnStatistics]
columnStatisticsList :: Maybe [ColumnStatistics]
$sel:columnStatisticsList:GetColumnStatisticsForTableResponse' :: GetColumnStatisticsForTableResponse -> Maybe [ColumnStatistics]
columnStatisticsList} -> Maybe [ColumnStatistics]
columnStatisticsList) (\s :: GetColumnStatisticsForTableResponse
s@GetColumnStatisticsForTableResponse' {} Maybe [ColumnStatistics]
a -> GetColumnStatisticsForTableResponse
s {$sel:columnStatisticsList:GetColumnStatisticsForTableResponse' :: Maybe [ColumnStatistics]
columnStatisticsList = Maybe [ColumnStatistics]
a} :: GetColumnStatisticsForTableResponse) 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

-- | List of ColumnStatistics that failed to be retrieved.
getColumnStatisticsForTableResponse_errors :: Lens.Lens' GetColumnStatisticsForTableResponse (Prelude.Maybe [ColumnError])
getColumnStatisticsForTableResponse_errors :: Lens' GetColumnStatisticsForTableResponse (Maybe [ColumnError])
getColumnStatisticsForTableResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTableResponse' {Maybe [ColumnError]
errors :: Maybe [ColumnError]
$sel:errors:GetColumnStatisticsForTableResponse' :: GetColumnStatisticsForTableResponse -> Maybe [ColumnError]
errors} -> Maybe [ColumnError]
errors) (\s :: GetColumnStatisticsForTableResponse
s@GetColumnStatisticsForTableResponse' {} Maybe [ColumnError]
a -> GetColumnStatisticsForTableResponse
s {$sel:errors:GetColumnStatisticsForTableResponse' :: Maybe [ColumnError]
errors = Maybe [ColumnError]
a} :: GetColumnStatisticsForTableResponse) 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.
getColumnStatisticsForTableResponse_httpStatus :: Lens.Lens' GetColumnStatisticsForTableResponse Prelude.Int
getColumnStatisticsForTableResponse_httpStatus :: Lens' GetColumnStatisticsForTableResponse Int
getColumnStatisticsForTableResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetColumnStatisticsForTableResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetColumnStatisticsForTableResponse' :: GetColumnStatisticsForTableResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetColumnStatisticsForTableResponse
s@GetColumnStatisticsForTableResponse' {} Int
a -> GetColumnStatisticsForTableResponse
s {$sel:httpStatus:GetColumnStatisticsForTableResponse' :: Int
httpStatus = Int
a} :: GetColumnStatisticsForTableResponse)

instance
  Prelude.NFData
    GetColumnStatisticsForTableResponse
  where
  rnf :: GetColumnStatisticsForTableResponse -> ()
rnf GetColumnStatisticsForTableResponse' {Int
Maybe [ColumnError]
Maybe [ColumnStatistics]
httpStatus :: Int
errors :: Maybe [ColumnError]
columnStatisticsList :: Maybe [ColumnStatistics]
$sel:httpStatus:GetColumnStatisticsForTableResponse' :: GetColumnStatisticsForTableResponse -> Int
$sel:errors:GetColumnStatisticsForTableResponse' :: GetColumnStatisticsForTableResponse -> Maybe [ColumnError]
$sel:columnStatisticsList:GetColumnStatisticsForTableResponse' :: GetColumnStatisticsForTableResponse -> Maybe [ColumnStatistics]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ColumnStatistics]
columnStatisticsList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ColumnError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus