{-# 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.IotTwinMaker.Types.DataType
-- 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.IotTwinMaker.Types.DataType where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IotTwinMaker.Types.DataValue
import Amazonka.IotTwinMaker.Types.Relationship
import Amazonka.IotTwinMaker.Types.Type
import qualified Amazonka.Prelude as Prelude

-- | An object that specifies the data type of a property.
--
-- /See:/ 'newDataType' smart constructor.
data DataType = DataType'
  { -- | The allowed values for this data type.
    DataType -> Maybe [DataValue]
allowedValues :: Prelude.Maybe [DataValue],
    -- | The nested type in the data type.
    DataType -> Maybe DataType
nestedType :: Prelude.Maybe DataType,
    -- | A relationship that associates a component with another component.
    DataType -> Maybe Relationship
relationship :: Prelude.Maybe Relationship,
    -- | The unit of measure used in this data type.
    DataType -> Maybe Text
unitOfMeasure :: Prelude.Maybe Prelude.Text,
    -- | The underlying type of the data type.
    DataType -> Type
type' :: Type
  }
  deriving (DataType -> DataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataType -> DataType -> Bool
$c/= :: DataType -> DataType -> Bool
== :: DataType -> DataType -> Bool
$c== :: DataType -> DataType -> Bool
Prelude.Eq, ReadPrec [DataType]
ReadPrec DataType
Int -> ReadS DataType
ReadS [DataType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataType]
$creadListPrec :: ReadPrec [DataType]
readPrec :: ReadPrec DataType
$creadPrec :: ReadPrec DataType
readList :: ReadS [DataType]
$creadList :: ReadS [DataType]
readsPrec :: Int -> ReadS DataType
$creadsPrec :: Int -> ReadS DataType
Prelude.Read, Int -> DataType -> ShowS
[DataType] -> ShowS
DataType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataType] -> ShowS
$cshowList :: [DataType] -> ShowS
show :: DataType -> String
$cshow :: DataType -> String
showsPrec :: Int -> DataType -> ShowS
$cshowsPrec :: Int -> DataType -> ShowS
Prelude.Show, forall x. Rep DataType x -> DataType
forall x. DataType -> Rep DataType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataType x -> DataType
$cfrom :: forall x. DataType -> Rep DataType x
Prelude.Generic)

-- |
-- Create a value of 'DataType' 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:
--
-- 'allowedValues', 'dataType_allowedValues' - The allowed values for this data type.
--
-- 'nestedType', 'dataType_nestedType' - The nested type in the data type.
--
-- 'relationship', 'dataType_relationship' - A relationship that associates a component with another component.
--
-- 'unitOfMeasure', 'dataType_unitOfMeasure' - The unit of measure used in this data type.
--
-- 'type'', 'dataType_type' - The underlying type of the data type.
newDataType ::
  -- | 'type''
  Type ->
  DataType
newDataType :: Type -> DataType
newDataType Type
pType_ =
  DataType'
    { $sel:allowedValues:DataType' :: Maybe [DataValue]
allowedValues = forall a. Maybe a
Prelude.Nothing,
      $sel:nestedType:DataType' :: Maybe DataType
nestedType = forall a. Maybe a
Prelude.Nothing,
      $sel:relationship:DataType' :: Maybe Relationship
relationship = forall a. Maybe a
Prelude.Nothing,
      $sel:unitOfMeasure:DataType' :: Maybe Text
unitOfMeasure = forall a. Maybe a
Prelude.Nothing,
      $sel:type':DataType' :: Type
type' = Type
pType_
    }

-- | The allowed values for this data type.
dataType_allowedValues :: Lens.Lens' DataType (Prelude.Maybe [DataValue])
dataType_allowedValues :: Lens' DataType (Maybe [DataValue])
dataType_allowedValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataType' {Maybe [DataValue]
allowedValues :: Maybe [DataValue]
$sel:allowedValues:DataType' :: DataType -> Maybe [DataValue]
allowedValues} -> Maybe [DataValue]
allowedValues) (\s :: DataType
s@DataType' {} Maybe [DataValue]
a -> DataType
s {$sel:allowedValues:DataType' :: Maybe [DataValue]
allowedValues = Maybe [DataValue]
a} :: DataType) 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 nested type in the data type.
dataType_nestedType :: Lens.Lens' DataType (Prelude.Maybe DataType)
dataType_nestedType :: Lens' DataType (Maybe DataType)
dataType_nestedType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataType' {Maybe DataType
nestedType :: Maybe DataType
$sel:nestedType:DataType' :: DataType -> Maybe DataType
nestedType} -> Maybe DataType
nestedType) (\s :: DataType
s@DataType' {} Maybe DataType
a -> DataType
s {$sel:nestedType:DataType' :: Maybe DataType
nestedType = Maybe DataType
a} :: DataType)

-- | A relationship that associates a component with another component.
dataType_relationship :: Lens.Lens' DataType (Prelude.Maybe Relationship)
dataType_relationship :: Lens' DataType (Maybe Relationship)
dataType_relationship = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataType' {Maybe Relationship
relationship :: Maybe Relationship
$sel:relationship:DataType' :: DataType -> Maybe Relationship
relationship} -> Maybe Relationship
relationship) (\s :: DataType
s@DataType' {} Maybe Relationship
a -> DataType
s {$sel:relationship:DataType' :: Maybe Relationship
relationship = Maybe Relationship
a} :: DataType)

-- | The unit of measure used in this data type.
dataType_unitOfMeasure :: Lens.Lens' DataType (Prelude.Maybe Prelude.Text)
dataType_unitOfMeasure :: Lens' DataType (Maybe Text)
dataType_unitOfMeasure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataType' {Maybe Text
unitOfMeasure :: Maybe Text
$sel:unitOfMeasure:DataType' :: DataType -> Maybe Text
unitOfMeasure} -> Maybe Text
unitOfMeasure) (\s :: DataType
s@DataType' {} Maybe Text
a -> DataType
s {$sel:unitOfMeasure:DataType' :: Maybe Text
unitOfMeasure = Maybe Text
a} :: DataType)

-- | The underlying type of the data type.
dataType_type :: Lens.Lens' DataType Type
dataType_type :: Lens' DataType Type
dataType_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataType' {Type
type' :: Type
$sel:type':DataType' :: DataType -> Type
type'} -> Type
type') (\s :: DataType
s@DataType' {} Type
a -> DataType
s {$sel:type':DataType' :: Type
type' = Type
a} :: DataType)

instance Data.FromJSON DataType where
  parseJSON :: Value -> Parser DataType
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DataType"
      ( \Object
x ->
          Maybe [DataValue]
-> Maybe DataType
-> Maybe Relationship
-> Maybe Text
-> Type
-> DataType
DataType'
            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
"allowedValues" 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
"nestedType")
            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
"relationship")
            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
"unitOfMeasure")
            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
"type")
      )

instance Prelude.Hashable DataType where
  hashWithSalt :: Int -> DataType -> Int
hashWithSalt Int
_salt DataType' {Maybe [DataValue]
Maybe Text
Maybe Relationship
Maybe DataType
Type
type' :: Type
unitOfMeasure :: Maybe Text
relationship :: Maybe Relationship
nestedType :: Maybe DataType
allowedValues :: Maybe [DataValue]
$sel:type':DataType' :: DataType -> Type
$sel:unitOfMeasure:DataType' :: DataType -> Maybe Text
$sel:relationship:DataType' :: DataType -> Maybe Relationship
$sel:nestedType:DataType' :: DataType -> Maybe DataType
$sel:allowedValues:DataType' :: DataType -> Maybe [DataValue]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DataValue]
allowedValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataType
nestedType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Relationship
relationship
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
unitOfMeasure
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Type
type'

instance Prelude.NFData DataType where
  rnf :: DataType -> ()
rnf DataType' {Maybe [DataValue]
Maybe Text
Maybe Relationship
Maybe DataType
Type
type' :: Type
unitOfMeasure :: Maybe Text
relationship :: Maybe Relationship
nestedType :: Maybe DataType
allowedValues :: Maybe [DataValue]
$sel:type':DataType' :: DataType -> Type
$sel:unitOfMeasure:DataType' :: DataType -> Maybe Text
$sel:relationship:DataType' :: DataType -> Maybe Relationship
$sel:nestedType:DataType' :: DataType -> Maybe DataType
$sel:allowedValues:DataType' :: DataType -> Maybe [DataValue]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataValue]
allowedValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataType
nestedType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Relationship
relationship
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
unitOfMeasure
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Type
type'

instance Data.ToJSON DataType where
  toJSON :: DataType -> Value
toJSON DataType' {Maybe [DataValue]
Maybe Text
Maybe Relationship
Maybe DataType
Type
type' :: Type
unitOfMeasure :: Maybe Text
relationship :: Maybe Relationship
nestedType :: Maybe DataType
allowedValues :: Maybe [DataValue]
$sel:type':DataType' :: DataType -> Type
$sel:unitOfMeasure:DataType' :: DataType -> Maybe Text
$sel:relationship:DataType' :: DataType -> Maybe Relationship
$sel:nestedType:DataType' :: DataType -> Maybe DataType
$sel:allowedValues:DataType' :: DataType -> Maybe [DataValue]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"allowedValues" 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 [DataValue]
allowedValues,
            (Key
"nestedType" 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 DataType
nestedType,
            (Key
"relationship" 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 Relationship
relationship,
            (Key
"unitOfMeasure" 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
unitOfMeasure,
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Type
type')
          ]
      )