{-# 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.KeySpaces.Types.SchemaDefinition
-- 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.KeySpaces.Types.SchemaDefinition where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KeySpaces.Types.ClusteringKey
import Amazonka.KeySpaces.Types.ColumnDefinition
import Amazonka.KeySpaces.Types.PartitionKey
import Amazonka.KeySpaces.Types.StaticColumn
import qualified Amazonka.Prelude as Prelude

-- | Describes the schema of the table.
--
-- /See:/ 'newSchemaDefinition' smart constructor.
data SchemaDefinition = SchemaDefinition'
  { -- | The columns that are part of the clustering key of the table.
    SchemaDefinition -> Maybe [ClusteringKey]
clusteringKeys :: Prelude.Maybe [ClusteringKey],
    -- | The columns that have been defined as @STATIC@. Static columns store
    -- values that are shared by all rows in the same partition.
    SchemaDefinition -> Maybe [StaticColumn]
staticColumns :: Prelude.Maybe [StaticColumn],
    -- | The regular columns of the table.
    SchemaDefinition -> NonEmpty ColumnDefinition
allColumns :: Prelude.NonEmpty ColumnDefinition,
    -- | The columns that are part of the partition key of the table .
    SchemaDefinition -> NonEmpty PartitionKey
partitionKeys :: Prelude.NonEmpty PartitionKey
  }
  deriving (SchemaDefinition -> SchemaDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaDefinition -> SchemaDefinition -> Bool
$c/= :: SchemaDefinition -> SchemaDefinition -> Bool
== :: SchemaDefinition -> SchemaDefinition -> Bool
$c== :: SchemaDefinition -> SchemaDefinition -> Bool
Prelude.Eq, ReadPrec [SchemaDefinition]
ReadPrec SchemaDefinition
Int -> ReadS SchemaDefinition
ReadS [SchemaDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SchemaDefinition]
$creadListPrec :: ReadPrec [SchemaDefinition]
readPrec :: ReadPrec SchemaDefinition
$creadPrec :: ReadPrec SchemaDefinition
readList :: ReadS [SchemaDefinition]
$creadList :: ReadS [SchemaDefinition]
readsPrec :: Int -> ReadS SchemaDefinition
$creadsPrec :: Int -> ReadS SchemaDefinition
Prelude.Read, Int -> SchemaDefinition -> ShowS
[SchemaDefinition] -> ShowS
SchemaDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDefinition] -> ShowS
$cshowList :: [SchemaDefinition] -> ShowS
show :: SchemaDefinition -> String
$cshow :: SchemaDefinition -> String
showsPrec :: Int -> SchemaDefinition -> ShowS
$cshowsPrec :: Int -> SchemaDefinition -> ShowS
Prelude.Show, forall x. Rep SchemaDefinition x -> SchemaDefinition
forall x. SchemaDefinition -> Rep SchemaDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SchemaDefinition x -> SchemaDefinition
$cfrom :: forall x. SchemaDefinition -> Rep SchemaDefinition x
Prelude.Generic)

-- |
-- Create a value of 'SchemaDefinition' 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:
--
-- 'clusteringKeys', 'schemaDefinition_clusteringKeys' - The columns that are part of the clustering key of the table.
--
-- 'staticColumns', 'schemaDefinition_staticColumns' - The columns that have been defined as @STATIC@. Static columns store
-- values that are shared by all rows in the same partition.
--
-- 'allColumns', 'schemaDefinition_allColumns' - The regular columns of the table.
--
-- 'partitionKeys', 'schemaDefinition_partitionKeys' - The columns that are part of the partition key of the table .
newSchemaDefinition ::
  -- | 'allColumns'
  Prelude.NonEmpty ColumnDefinition ->
  -- | 'partitionKeys'
  Prelude.NonEmpty PartitionKey ->
  SchemaDefinition
newSchemaDefinition :: NonEmpty ColumnDefinition
-> NonEmpty PartitionKey -> SchemaDefinition
newSchemaDefinition NonEmpty ColumnDefinition
pAllColumns_ NonEmpty PartitionKey
pPartitionKeys_ =
  SchemaDefinition'
    { $sel:clusteringKeys:SchemaDefinition' :: Maybe [ClusteringKey]
clusteringKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:staticColumns:SchemaDefinition' :: Maybe [StaticColumn]
staticColumns = forall a. Maybe a
Prelude.Nothing,
      $sel:allColumns:SchemaDefinition' :: NonEmpty ColumnDefinition
allColumns = 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 ColumnDefinition
pAllColumns_,
      $sel:partitionKeys:SchemaDefinition' :: NonEmpty PartitionKey
partitionKeys = 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 PartitionKey
pPartitionKeys_
    }

-- | The columns that are part of the clustering key of the table.
schemaDefinition_clusteringKeys :: Lens.Lens' SchemaDefinition (Prelude.Maybe [ClusteringKey])
schemaDefinition_clusteringKeys :: Lens' SchemaDefinition (Maybe [ClusteringKey])
schemaDefinition_clusteringKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SchemaDefinition' {Maybe [ClusteringKey]
clusteringKeys :: Maybe [ClusteringKey]
$sel:clusteringKeys:SchemaDefinition' :: SchemaDefinition -> Maybe [ClusteringKey]
clusteringKeys} -> Maybe [ClusteringKey]
clusteringKeys) (\s :: SchemaDefinition
s@SchemaDefinition' {} Maybe [ClusteringKey]
a -> SchemaDefinition
s {$sel:clusteringKeys:SchemaDefinition' :: Maybe [ClusteringKey]
clusteringKeys = Maybe [ClusteringKey]
a} :: SchemaDefinition) 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 columns that have been defined as @STATIC@. Static columns store
-- values that are shared by all rows in the same partition.
schemaDefinition_staticColumns :: Lens.Lens' SchemaDefinition (Prelude.Maybe [StaticColumn])
schemaDefinition_staticColumns :: Lens' SchemaDefinition (Maybe [StaticColumn])
schemaDefinition_staticColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SchemaDefinition' {Maybe [StaticColumn]
staticColumns :: Maybe [StaticColumn]
$sel:staticColumns:SchemaDefinition' :: SchemaDefinition -> Maybe [StaticColumn]
staticColumns} -> Maybe [StaticColumn]
staticColumns) (\s :: SchemaDefinition
s@SchemaDefinition' {} Maybe [StaticColumn]
a -> SchemaDefinition
s {$sel:staticColumns:SchemaDefinition' :: Maybe [StaticColumn]
staticColumns = Maybe [StaticColumn]
a} :: SchemaDefinition) 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 regular columns of the table.
schemaDefinition_allColumns :: Lens.Lens' SchemaDefinition (Prelude.NonEmpty ColumnDefinition)
schemaDefinition_allColumns :: Lens' SchemaDefinition (NonEmpty ColumnDefinition)
schemaDefinition_allColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SchemaDefinition' {NonEmpty ColumnDefinition
allColumns :: NonEmpty ColumnDefinition
$sel:allColumns:SchemaDefinition' :: SchemaDefinition -> NonEmpty ColumnDefinition
allColumns} -> NonEmpty ColumnDefinition
allColumns) (\s :: SchemaDefinition
s@SchemaDefinition' {} NonEmpty ColumnDefinition
a -> SchemaDefinition
s {$sel:allColumns:SchemaDefinition' :: NonEmpty ColumnDefinition
allColumns = NonEmpty ColumnDefinition
a} :: SchemaDefinition) 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 columns that are part of the partition key of the table .
schemaDefinition_partitionKeys :: Lens.Lens' SchemaDefinition (Prelude.NonEmpty PartitionKey)
schemaDefinition_partitionKeys :: Lens' SchemaDefinition (NonEmpty PartitionKey)
schemaDefinition_partitionKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SchemaDefinition' {NonEmpty PartitionKey
partitionKeys :: NonEmpty PartitionKey
$sel:partitionKeys:SchemaDefinition' :: SchemaDefinition -> NonEmpty PartitionKey
partitionKeys} -> NonEmpty PartitionKey
partitionKeys) (\s :: SchemaDefinition
s@SchemaDefinition' {} NonEmpty PartitionKey
a -> SchemaDefinition
s {$sel:partitionKeys:SchemaDefinition' :: NonEmpty PartitionKey
partitionKeys = NonEmpty PartitionKey
a} :: SchemaDefinition) 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 Data.FromJSON SchemaDefinition where
  parseJSON :: Value -> Parser SchemaDefinition
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SchemaDefinition"
      ( \Object
x ->
          Maybe [ClusteringKey]
-> Maybe [StaticColumn]
-> NonEmpty ColumnDefinition
-> NonEmpty PartitionKey
-> SchemaDefinition
SchemaDefinition'
            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
"clusteringKeys" 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
"staticColumns" 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 a
Data..: Key
"allColumns")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"partitionKeys")
      )

instance Prelude.Hashable SchemaDefinition where
  hashWithSalt :: Int -> SchemaDefinition -> Int
hashWithSalt Int
_salt SchemaDefinition' {Maybe [ClusteringKey]
Maybe [StaticColumn]
NonEmpty ColumnDefinition
NonEmpty PartitionKey
partitionKeys :: NonEmpty PartitionKey
allColumns :: NonEmpty ColumnDefinition
staticColumns :: Maybe [StaticColumn]
clusteringKeys :: Maybe [ClusteringKey]
$sel:partitionKeys:SchemaDefinition' :: SchemaDefinition -> NonEmpty PartitionKey
$sel:allColumns:SchemaDefinition' :: SchemaDefinition -> NonEmpty ColumnDefinition
$sel:staticColumns:SchemaDefinition' :: SchemaDefinition -> Maybe [StaticColumn]
$sel:clusteringKeys:SchemaDefinition' :: SchemaDefinition -> Maybe [ClusteringKey]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ClusteringKey]
clusteringKeys
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [StaticColumn]
staticColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ColumnDefinition
allColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty PartitionKey
partitionKeys

instance Prelude.NFData SchemaDefinition where
  rnf :: SchemaDefinition -> ()
rnf SchemaDefinition' {Maybe [ClusteringKey]
Maybe [StaticColumn]
NonEmpty ColumnDefinition
NonEmpty PartitionKey
partitionKeys :: NonEmpty PartitionKey
allColumns :: NonEmpty ColumnDefinition
staticColumns :: Maybe [StaticColumn]
clusteringKeys :: Maybe [ClusteringKey]
$sel:partitionKeys:SchemaDefinition' :: SchemaDefinition -> NonEmpty PartitionKey
$sel:allColumns:SchemaDefinition' :: SchemaDefinition -> NonEmpty ColumnDefinition
$sel:staticColumns:SchemaDefinition' :: SchemaDefinition -> Maybe [StaticColumn]
$sel:clusteringKeys:SchemaDefinition' :: SchemaDefinition -> Maybe [ClusteringKey]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ClusteringKey]
clusteringKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StaticColumn]
staticColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ColumnDefinition
allColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PartitionKey
partitionKeys

instance Data.ToJSON SchemaDefinition where
  toJSON :: SchemaDefinition -> Value
toJSON SchemaDefinition' {Maybe [ClusteringKey]
Maybe [StaticColumn]
NonEmpty ColumnDefinition
NonEmpty PartitionKey
partitionKeys :: NonEmpty PartitionKey
allColumns :: NonEmpty ColumnDefinition
staticColumns :: Maybe [StaticColumn]
clusteringKeys :: Maybe [ClusteringKey]
$sel:partitionKeys:SchemaDefinition' :: SchemaDefinition -> NonEmpty PartitionKey
$sel:allColumns:SchemaDefinition' :: SchemaDefinition -> NonEmpty ColumnDefinition
$sel:staticColumns:SchemaDefinition' :: SchemaDefinition -> Maybe [StaticColumn]
$sel:clusteringKeys:SchemaDefinition' :: SchemaDefinition -> Maybe [ClusteringKey]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clusteringKeys" 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 [ClusteringKey]
clusteringKeys,
            (Key
"staticColumns" 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 [StaticColumn]
staticColumns,
            forall a. a -> Maybe a
Prelude.Just (Key
"allColumns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ColumnDefinition
allColumns),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"partitionKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty PartitionKey
partitionKeys)
          ]
      )