{-# 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.Glue.Types.TableInput
-- 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.Glue.Types.TableInput 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.Column
import Amazonka.Glue.Types.StorageDescriptor
import Amazonka.Glue.Types.TableIdentifier
import qualified Amazonka.Prelude as Prelude

-- | A structure used to define a table.
--
-- /See:/ 'newTableInput' smart constructor.
data TableInput = TableInput'
  { -- | A description of the table.
    TableInput -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The last time that the table was accessed.
    TableInput -> Maybe POSIX
lastAccessTime :: Prelude.Maybe Data.POSIX,
    -- | The last time that column statistics were computed for this table.
    TableInput -> Maybe POSIX
lastAnalyzedTime :: Prelude.Maybe Data.POSIX,
    -- | The table owner.
    TableInput -> Maybe Text
owner :: Prelude.Maybe Prelude.Text,
    -- | These key-value pairs define properties associated with the table.
    TableInput -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of columns by which the table is partitioned. Only primitive
    -- types are supported as partition keys.
    --
    -- When you create a table used by Amazon Athena, and you do not specify
    -- any @partitionKeys@, you must at least set the value of @partitionKeys@
    -- to an empty list. For example:
    --
    -- @\"PartitionKeys\": []@
    TableInput -> Maybe [Column]
partitionKeys :: Prelude.Maybe [Column],
    -- | The retention time for this table.
    TableInput -> Maybe Natural
retention :: Prelude.Maybe Prelude.Natural,
    -- | A storage descriptor containing information about the physical storage
    -- of this table.
    TableInput -> Maybe StorageDescriptor
storageDescriptor :: Prelude.Maybe StorageDescriptor,
    -- | The type of this table (@EXTERNAL_TABLE@, @VIRTUAL_VIEW@, etc.).
    TableInput -> Maybe Text
tableType :: Prelude.Maybe Prelude.Text,
    -- | A @TableIdentifier@ structure that describes a target table for resource
    -- linking.
    TableInput -> Maybe TableIdentifier
targetTable :: Prelude.Maybe TableIdentifier,
    -- | If the table is a view, the expanded text of the view; otherwise @null@.
    TableInput -> Maybe Text
viewExpandedText :: Prelude.Maybe Prelude.Text,
    -- | If the table is a view, the original text of the view; otherwise @null@.
    TableInput -> Maybe Text
viewOriginalText :: Prelude.Maybe Prelude.Text,
    -- | The table name. For Hive compatibility, this is folded to lowercase when
    -- it is stored.
    TableInput -> Text
name :: Prelude.Text
  }
  deriving (TableInput -> TableInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableInput -> TableInput -> Bool
$c/= :: TableInput -> TableInput -> Bool
== :: TableInput -> TableInput -> Bool
$c== :: TableInput -> TableInput -> Bool
Prelude.Eq, ReadPrec [TableInput]
ReadPrec TableInput
Int -> ReadS TableInput
ReadS [TableInput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableInput]
$creadListPrec :: ReadPrec [TableInput]
readPrec :: ReadPrec TableInput
$creadPrec :: ReadPrec TableInput
readList :: ReadS [TableInput]
$creadList :: ReadS [TableInput]
readsPrec :: Int -> ReadS TableInput
$creadsPrec :: Int -> ReadS TableInput
Prelude.Read, Int -> TableInput -> ShowS
[TableInput] -> ShowS
TableInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableInput] -> ShowS
$cshowList :: [TableInput] -> ShowS
show :: TableInput -> String
$cshow :: TableInput -> String
showsPrec :: Int -> TableInput -> ShowS
$cshowsPrec :: Int -> TableInput -> ShowS
Prelude.Show, forall x. Rep TableInput x -> TableInput
forall x. TableInput -> Rep TableInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableInput x -> TableInput
$cfrom :: forall x. TableInput -> Rep TableInput x
Prelude.Generic)

-- |
-- Create a value of 'TableInput' 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:
--
-- 'description', 'tableInput_description' - A description of the table.
--
-- 'lastAccessTime', 'tableInput_lastAccessTime' - The last time that the table was accessed.
--
-- 'lastAnalyzedTime', 'tableInput_lastAnalyzedTime' - The last time that column statistics were computed for this table.
--
-- 'owner', 'tableInput_owner' - The table owner.
--
-- 'parameters', 'tableInput_parameters' - These key-value pairs define properties associated with the table.
--
-- 'partitionKeys', 'tableInput_partitionKeys' - A list of columns by which the table is partitioned. Only primitive
-- types are supported as partition keys.
--
-- When you create a table used by Amazon Athena, and you do not specify
-- any @partitionKeys@, you must at least set the value of @partitionKeys@
-- to an empty list. For example:
--
-- @\"PartitionKeys\": []@
--
-- 'retention', 'tableInput_retention' - The retention time for this table.
--
-- 'storageDescriptor', 'tableInput_storageDescriptor' - A storage descriptor containing information about the physical storage
-- of this table.
--
-- 'tableType', 'tableInput_tableType' - The type of this table (@EXTERNAL_TABLE@, @VIRTUAL_VIEW@, etc.).
--
-- 'targetTable', 'tableInput_targetTable' - A @TableIdentifier@ structure that describes a target table for resource
-- linking.
--
-- 'viewExpandedText', 'tableInput_viewExpandedText' - If the table is a view, the expanded text of the view; otherwise @null@.
--
-- 'viewOriginalText', 'tableInput_viewOriginalText' - If the table is a view, the original text of the view; otherwise @null@.
--
-- 'name', 'tableInput_name' - The table name. For Hive compatibility, this is folded to lowercase when
-- it is stored.
newTableInput ::
  -- | 'name'
  Prelude.Text ->
  TableInput
newTableInput :: Text -> TableInput
newTableInput Text
pName_ =
  TableInput'
    { $sel:description:TableInput' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:lastAccessTime:TableInput' :: Maybe POSIX
lastAccessTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastAnalyzedTime:TableInput' :: Maybe POSIX
lastAnalyzedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:TableInput' :: Maybe Text
owner = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:TableInput' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:partitionKeys:TableInput' :: Maybe [Column]
partitionKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:retention:TableInput' :: Maybe Natural
retention = forall a. Maybe a
Prelude.Nothing,
      $sel:storageDescriptor:TableInput' :: Maybe StorageDescriptor
storageDescriptor = forall a. Maybe a
Prelude.Nothing,
      $sel:tableType:TableInput' :: Maybe Text
tableType = forall a. Maybe a
Prelude.Nothing,
      $sel:targetTable:TableInput' :: Maybe TableIdentifier
targetTable = forall a. Maybe a
Prelude.Nothing,
      $sel:viewExpandedText:TableInput' :: Maybe Text
viewExpandedText = forall a. Maybe a
Prelude.Nothing,
      $sel:viewOriginalText:TableInput' :: Maybe Text
viewOriginalText = forall a. Maybe a
Prelude.Nothing,
      $sel:name:TableInput' :: Text
name = Text
pName_
    }

-- | A description of the table.
tableInput_description :: Lens.Lens' TableInput (Prelude.Maybe Prelude.Text)
tableInput_description :: Lens' TableInput (Maybe Text)
tableInput_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe Text
description :: Maybe Text
$sel:description:TableInput' :: TableInput -> Maybe Text
description} -> Maybe Text
description) (\s :: TableInput
s@TableInput' {} Maybe Text
a -> TableInput
s {$sel:description:TableInput' :: Maybe Text
description = Maybe Text
a} :: TableInput)

-- | The last time that the table was accessed.
tableInput_lastAccessTime :: Lens.Lens' TableInput (Prelude.Maybe Prelude.UTCTime)
tableInput_lastAccessTime :: Lens' TableInput (Maybe UTCTime)
tableInput_lastAccessTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe POSIX
lastAccessTime :: Maybe POSIX
$sel:lastAccessTime:TableInput' :: TableInput -> Maybe POSIX
lastAccessTime} -> Maybe POSIX
lastAccessTime) (\s :: TableInput
s@TableInput' {} Maybe POSIX
a -> TableInput
s {$sel:lastAccessTime:TableInput' :: Maybe POSIX
lastAccessTime = Maybe POSIX
a} :: TableInput) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The last time that column statistics were computed for this table.
tableInput_lastAnalyzedTime :: Lens.Lens' TableInput (Prelude.Maybe Prelude.UTCTime)
tableInput_lastAnalyzedTime :: Lens' TableInput (Maybe UTCTime)
tableInput_lastAnalyzedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe POSIX
lastAnalyzedTime :: Maybe POSIX
$sel:lastAnalyzedTime:TableInput' :: TableInput -> Maybe POSIX
lastAnalyzedTime} -> Maybe POSIX
lastAnalyzedTime) (\s :: TableInput
s@TableInput' {} Maybe POSIX
a -> TableInput
s {$sel:lastAnalyzedTime:TableInput' :: Maybe POSIX
lastAnalyzedTime = Maybe POSIX
a} :: TableInput) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The table owner.
tableInput_owner :: Lens.Lens' TableInput (Prelude.Maybe Prelude.Text)
tableInput_owner :: Lens' TableInput (Maybe Text)
tableInput_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe Text
owner :: Maybe Text
$sel:owner:TableInput' :: TableInput -> Maybe Text
owner} -> Maybe Text
owner) (\s :: TableInput
s@TableInput' {} Maybe Text
a -> TableInput
s {$sel:owner:TableInput' :: Maybe Text
owner = Maybe Text
a} :: TableInput)

-- | These key-value pairs define properties associated with the table.
tableInput_parameters :: Lens.Lens' TableInput (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
tableInput_parameters :: Lens' TableInput (Maybe (HashMap Text Text))
tableInput_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:TableInput' :: TableInput -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: TableInput
s@TableInput' {} Maybe (HashMap Text Text)
a -> TableInput
s {$sel:parameters:TableInput' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: TableInput) 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

-- | A list of columns by which the table is partitioned. Only primitive
-- types are supported as partition keys.
--
-- When you create a table used by Amazon Athena, and you do not specify
-- any @partitionKeys@, you must at least set the value of @partitionKeys@
-- to an empty list. For example:
--
-- @\"PartitionKeys\": []@
tableInput_partitionKeys :: Lens.Lens' TableInput (Prelude.Maybe [Column])
tableInput_partitionKeys :: Lens' TableInput (Maybe [Column])
tableInput_partitionKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe [Column]
partitionKeys :: Maybe [Column]
$sel:partitionKeys:TableInput' :: TableInput -> Maybe [Column]
partitionKeys} -> Maybe [Column]
partitionKeys) (\s :: TableInput
s@TableInput' {} Maybe [Column]
a -> TableInput
s {$sel:partitionKeys:TableInput' :: Maybe [Column]
partitionKeys = Maybe [Column]
a} :: TableInput) 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 retention time for this table.
tableInput_retention :: Lens.Lens' TableInput (Prelude.Maybe Prelude.Natural)
tableInput_retention :: Lens' TableInput (Maybe Natural)
tableInput_retention = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe Natural
retention :: Maybe Natural
$sel:retention:TableInput' :: TableInput -> Maybe Natural
retention} -> Maybe Natural
retention) (\s :: TableInput
s@TableInput' {} Maybe Natural
a -> TableInput
s {$sel:retention:TableInput' :: Maybe Natural
retention = Maybe Natural
a} :: TableInput)

-- | A storage descriptor containing information about the physical storage
-- of this table.
tableInput_storageDescriptor :: Lens.Lens' TableInput (Prelude.Maybe StorageDescriptor)
tableInput_storageDescriptor :: Lens' TableInput (Maybe StorageDescriptor)
tableInput_storageDescriptor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe StorageDescriptor
storageDescriptor :: Maybe StorageDescriptor
$sel:storageDescriptor:TableInput' :: TableInput -> Maybe StorageDescriptor
storageDescriptor} -> Maybe StorageDescriptor
storageDescriptor) (\s :: TableInput
s@TableInput' {} Maybe StorageDescriptor
a -> TableInput
s {$sel:storageDescriptor:TableInput' :: Maybe StorageDescriptor
storageDescriptor = Maybe StorageDescriptor
a} :: TableInput)

-- | The type of this table (@EXTERNAL_TABLE@, @VIRTUAL_VIEW@, etc.).
tableInput_tableType :: Lens.Lens' TableInput (Prelude.Maybe Prelude.Text)
tableInput_tableType :: Lens' TableInput (Maybe Text)
tableInput_tableType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe Text
tableType :: Maybe Text
$sel:tableType:TableInput' :: TableInput -> Maybe Text
tableType} -> Maybe Text
tableType) (\s :: TableInput
s@TableInput' {} Maybe Text
a -> TableInput
s {$sel:tableType:TableInput' :: Maybe Text
tableType = Maybe Text
a} :: TableInput)

-- | A @TableIdentifier@ structure that describes a target table for resource
-- linking.
tableInput_targetTable :: Lens.Lens' TableInput (Prelude.Maybe TableIdentifier)
tableInput_targetTable :: Lens' TableInput (Maybe TableIdentifier)
tableInput_targetTable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe TableIdentifier
targetTable :: Maybe TableIdentifier
$sel:targetTable:TableInput' :: TableInput -> Maybe TableIdentifier
targetTable} -> Maybe TableIdentifier
targetTable) (\s :: TableInput
s@TableInput' {} Maybe TableIdentifier
a -> TableInput
s {$sel:targetTable:TableInput' :: Maybe TableIdentifier
targetTable = Maybe TableIdentifier
a} :: TableInput)

-- | If the table is a view, the expanded text of the view; otherwise @null@.
tableInput_viewExpandedText :: Lens.Lens' TableInput (Prelude.Maybe Prelude.Text)
tableInput_viewExpandedText :: Lens' TableInput (Maybe Text)
tableInput_viewExpandedText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe Text
viewExpandedText :: Maybe Text
$sel:viewExpandedText:TableInput' :: TableInput -> Maybe Text
viewExpandedText} -> Maybe Text
viewExpandedText) (\s :: TableInput
s@TableInput' {} Maybe Text
a -> TableInput
s {$sel:viewExpandedText:TableInput' :: Maybe Text
viewExpandedText = Maybe Text
a} :: TableInput)

-- | If the table is a view, the original text of the view; otherwise @null@.
tableInput_viewOriginalText :: Lens.Lens' TableInput (Prelude.Maybe Prelude.Text)
tableInput_viewOriginalText :: Lens' TableInput (Maybe Text)
tableInput_viewOriginalText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Maybe Text
viewOriginalText :: Maybe Text
$sel:viewOriginalText:TableInput' :: TableInput -> Maybe Text
viewOriginalText} -> Maybe Text
viewOriginalText) (\s :: TableInput
s@TableInput' {} Maybe Text
a -> TableInput
s {$sel:viewOriginalText:TableInput' :: Maybe Text
viewOriginalText = Maybe Text
a} :: TableInput)

-- | The table name. For Hive compatibility, this is folded to lowercase when
-- it is stored.
tableInput_name :: Lens.Lens' TableInput Prelude.Text
tableInput_name :: Lens' TableInput Text
tableInput_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableInput' {Text
name :: Text
$sel:name:TableInput' :: TableInput -> Text
name} -> Text
name) (\s :: TableInput
s@TableInput' {} Text
a -> TableInput
s {$sel:name:TableInput' :: Text
name = Text
a} :: TableInput)

instance Prelude.Hashable TableInput where
  hashWithSalt :: Int -> TableInput -> Int
hashWithSalt Int
_salt TableInput' {Maybe Natural
Maybe [Column]
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe StorageDescriptor
Maybe TableIdentifier
Text
name :: Text
viewOriginalText :: Maybe Text
viewExpandedText :: Maybe Text
targetTable :: Maybe TableIdentifier
tableType :: Maybe Text
storageDescriptor :: Maybe StorageDescriptor
retention :: Maybe Natural
partitionKeys :: Maybe [Column]
parameters :: Maybe (HashMap Text Text)
owner :: Maybe Text
lastAnalyzedTime :: Maybe POSIX
lastAccessTime :: Maybe POSIX
description :: Maybe Text
$sel:name:TableInput' :: TableInput -> Text
$sel:viewOriginalText:TableInput' :: TableInput -> Maybe Text
$sel:viewExpandedText:TableInput' :: TableInput -> Maybe Text
$sel:targetTable:TableInput' :: TableInput -> Maybe TableIdentifier
$sel:tableType:TableInput' :: TableInput -> Maybe Text
$sel:storageDescriptor:TableInput' :: TableInput -> Maybe StorageDescriptor
$sel:retention:TableInput' :: TableInput -> Maybe Natural
$sel:partitionKeys:TableInput' :: TableInput -> Maybe [Column]
$sel:parameters:TableInput' :: TableInput -> Maybe (HashMap Text Text)
$sel:owner:TableInput' :: TableInput -> Maybe Text
$sel:lastAnalyzedTime:TableInput' :: TableInput -> Maybe POSIX
$sel:lastAccessTime:TableInput' :: TableInput -> Maybe POSIX
$sel:description:TableInput' :: TableInput -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastAccessTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastAnalyzedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
owner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Column]
partitionKeys
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
retention
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageDescriptor
storageDescriptor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tableType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableIdentifier
targetTable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
viewExpandedText
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
viewOriginalText
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData TableInput where
  rnf :: TableInput -> ()
rnf TableInput' {Maybe Natural
Maybe [Column]
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe StorageDescriptor
Maybe TableIdentifier
Text
name :: Text
viewOriginalText :: Maybe Text
viewExpandedText :: Maybe Text
targetTable :: Maybe TableIdentifier
tableType :: Maybe Text
storageDescriptor :: Maybe StorageDescriptor
retention :: Maybe Natural
partitionKeys :: Maybe [Column]
parameters :: Maybe (HashMap Text Text)
owner :: Maybe Text
lastAnalyzedTime :: Maybe POSIX
lastAccessTime :: Maybe POSIX
description :: Maybe Text
$sel:name:TableInput' :: TableInput -> Text
$sel:viewOriginalText:TableInput' :: TableInput -> Maybe Text
$sel:viewExpandedText:TableInput' :: TableInput -> Maybe Text
$sel:targetTable:TableInput' :: TableInput -> Maybe TableIdentifier
$sel:tableType:TableInput' :: TableInput -> Maybe Text
$sel:storageDescriptor:TableInput' :: TableInput -> Maybe StorageDescriptor
$sel:retention:TableInput' :: TableInput -> Maybe Natural
$sel:partitionKeys:TableInput' :: TableInput -> Maybe [Column]
$sel:parameters:TableInput' :: TableInput -> Maybe (HashMap Text Text)
$sel:owner:TableInput' :: TableInput -> Maybe Text
$sel:lastAnalyzedTime:TableInput' :: TableInput -> Maybe POSIX
$sel:lastAccessTime:TableInput' :: TableInput -> Maybe POSIX
$sel:description:TableInput' :: TableInput -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastAccessTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastAnalyzedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
owner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Column]
partitionKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
retention
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageDescriptor
storageDescriptor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableIdentifier
targetTable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
viewExpandedText
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
viewOriginalText
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToJSON TableInput where
  toJSON :: TableInput -> Value
toJSON TableInput' {Maybe Natural
Maybe [Column]
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe StorageDescriptor
Maybe TableIdentifier
Text
name :: Text
viewOriginalText :: Maybe Text
viewExpandedText :: Maybe Text
targetTable :: Maybe TableIdentifier
tableType :: Maybe Text
storageDescriptor :: Maybe StorageDescriptor
retention :: Maybe Natural
partitionKeys :: Maybe [Column]
parameters :: Maybe (HashMap Text Text)
owner :: Maybe Text
lastAnalyzedTime :: Maybe POSIX
lastAccessTime :: Maybe POSIX
description :: Maybe Text
$sel:name:TableInput' :: TableInput -> Text
$sel:viewOriginalText:TableInput' :: TableInput -> Maybe Text
$sel:viewExpandedText:TableInput' :: TableInput -> Maybe Text
$sel:targetTable:TableInput' :: TableInput -> Maybe TableIdentifier
$sel:tableType:TableInput' :: TableInput -> Maybe Text
$sel:storageDescriptor:TableInput' :: TableInput -> Maybe StorageDescriptor
$sel:retention:TableInput' :: TableInput -> Maybe Natural
$sel:partitionKeys:TableInput' :: TableInput -> Maybe [Column]
$sel:parameters:TableInput' :: TableInput -> Maybe (HashMap Text Text)
$sel:owner:TableInput' :: TableInput -> Maybe Text
$sel:lastAnalyzedTime:TableInput' :: TableInput -> Maybe POSIX
$sel:lastAccessTime:TableInput' :: TableInput -> Maybe POSIX
$sel:description:TableInput' :: TableInput -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"LastAccessTime" 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 POSIX
lastAccessTime,
            (Key
"LastAnalyzedTime" 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 POSIX
lastAnalyzedTime,
            (Key
"Owner" 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
owner,
            (Key
"Parameters" 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 (HashMap Text Text)
parameters,
            (Key
"PartitionKeys" 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 [Column]
partitionKeys,
            (Key
"Retention" 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
retention,
            (Key
"StorageDescriptor" 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 StorageDescriptor
storageDescriptor,
            (Key
"TableType" 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
tableType,
            (Key
"TargetTable" 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 TableIdentifier
targetTable,
            (Key
"ViewExpandedText" 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
viewExpandedText,
            (Key
"ViewOriginalText" 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
viewOriginalText,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )