module Stratosphere.CleanRooms.ConfiguredTable.AggregateColumnProperty (
        AggregateColumnProperty(..), mkAggregateColumnProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AggregateColumnProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cleanrooms-configuredtable-aggregatecolumn.html>
    AggregateColumnProperty {AggregateColumnProperty -> ()
haddock_workaround_ :: (),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cleanrooms-configuredtable-aggregatecolumn.html#cfn-cleanrooms-configuredtable-aggregatecolumn-columnnames>
                             AggregateColumnProperty -> ValueList Text
columnNames :: (ValueList Prelude.Text),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cleanrooms-configuredtable-aggregatecolumn.html#cfn-cleanrooms-configuredtable-aggregatecolumn-function>
                             AggregateColumnProperty -> Value Text
function :: (Value Prelude.Text)}
  deriving stock (AggregateColumnProperty -> AggregateColumnProperty -> Bool
(AggregateColumnProperty -> AggregateColumnProperty -> Bool)
-> (AggregateColumnProperty -> AggregateColumnProperty -> Bool)
-> Eq AggregateColumnProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AggregateColumnProperty -> AggregateColumnProperty -> Bool
== :: AggregateColumnProperty -> AggregateColumnProperty -> Bool
$c/= :: AggregateColumnProperty -> AggregateColumnProperty -> Bool
/= :: AggregateColumnProperty -> AggregateColumnProperty -> Bool
Prelude.Eq, Int -> AggregateColumnProperty -> ShowS
[AggregateColumnProperty] -> ShowS
AggregateColumnProperty -> String
(Int -> AggregateColumnProperty -> ShowS)
-> (AggregateColumnProperty -> String)
-> ([AggregateColumnProperty] -> ShowS)
-> Show AggregateColumnProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AggregateColumnProperty -> ShowS
showsPrec :: Int -> AggregateColumnProperty -> ShowS
$cshow :: AggregateColumnProperty -> String
show :: AggregateColumnProperty -> String
$cshowList :: [AggregateColumnProperty] -> ShowS
showList :: [AggregateColumnProperty] -> ShowS
Prelude.Show)
mkAggregateColumnProperty ::
  ValueList Prelude.Text
  -> Value Prelude.Text -> AggregateColumnProperty
mkAggregateColumnProperty :: ValueList Text -> Value Text -> AggregateColumnProperty
mkAggregateColumnProperty ValueList Text
columnNames Value Text
function
  = AggregateColumnProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), columnNames :: ValueList Text
columnNames = ValueList Text
columnNames,
       function :: Value Text
function = Value Text
function}
instance ToResourceProperties AggregateColumnProperty where
  toResourceProperties :: AggregateColumnProperty -> ResourceProperties
toResourceProperties AggregateColumnProperty {()
ValueList Text
Value Text
haddock_workaround_ :: AggregateColumnProperty -> ()
columnNames :: AggregateColumnProperty -> ValueList Text
function :: AggregateColumnProperty -> Value Text
haddock_workaround_ :: ()
columnNames :: ValueList Text
function :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::CleanRooms::ConfiguredTable.AggregateColumn",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"ColumnNames" Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Text
columnNames,
                       Key
"Function" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
function]}
instance JSON.ToJSON AggregateColumnProperty where
  toJSON :: AggregateColumnProperty -> Value
toJSON AggregateColumnProperty {()
ValueList Text
Value Text
haddock_workaround_ :: AggregateColumnProperty -> ()
columnNames :: AggregateColumnProperty -> ValueList Text
function :: AggregateColumnProperty -> Value Text
haddock_workaround_ :: ()
columnNames :: ValueList Text
function :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"ColumnNames" Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Text
columnNames, Key
"Function" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
function]
instance Property "ColumnNames" AggregateColumnProperty where
  type PropertyType "ColumnNames" AggregateColumnProperty = ValueList Prelude.Text
  set :: PropertyType "ColumnNames" AggregateColumnProperty
-> AggregateColumnProperty -> AggregateColumnProperty
set PropertyType "ColumnNames" AggregateColumnProperty
newValue AggregateColumnProperty {()
ValueList Text
Value Text
haddock_workaround_ :: AggregateColumnProperty -> ()
columnNames :: AggregateColumnProperty -> ValueList Text
function :: AggregateColumnProperty -> Value Text
haddock_workaround_ :: ()
columnNames :: ValueList Text
function :: Value Text
..}
    = AggregateColumnProperty {columnNames :: ValueList Text
columnNames = PropertyType "ColumnNames" AggregateColumnProperty
ValueList Text
newValue, ()
Value Text
haddock_workaround_ :: ()
function :: Value Text
haddock_workaround_ :: ()
function :: Value Text
..}
instance Property "Function" AggregateColumnProperty where
  type PropertyType "Function" AggregateColumnProperty = Value Prelude.Text
  set :: PropertyType "Function" AggregateColumnProperty
-> AggregateColumnProperty -> AggregateColumnProperty
set PropertyType "Function" AggregateColumnProperty
newValue AggregateColumnProperty {()
ValueList Text
Value Text
haddock_workaround_ :: AggregateColumnProperty -> ()
columnNames :: AggregateColumnProperty -> ValueList Text
function :: AggregateColumnProperty -> Value Text
haddock_workaround_ :: ()
columnNames :: ValueList Text
function :: Value Text
..}
    = AggregateColumnProperty {function :: Value Text
function = PropertyType "Function" AggregateColumnProperty
Value Text
newValue, ()
ValueList Text
haddock_workaround_ :: ()
columnNames :: ValueList Text
haddock_workaround_ :: ()
columnNames :: ValueList Text
..}