{-# 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.IoTSiteWise.Types.PropertyType
-- 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.IoTSiteWise.Types.PropertyType where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTSiteWise.Types.Attribute
import Amazonka.IoTSiteWise.Types.Measurement
import Amazonka.IoTSiteWise.Types.Metric
import Amazonka.IoTSiteWise.Types.Transform
import qualified Amazonka.Prelude as Prelude

-- | Contains a property type, which can be one of @attribute@,
-- @measurement@, @metric@, or @transform@.
--
-- /See:/ 'newPropertyType' smart constructor.
data PropertyType = PropertyType'
  { -- | Specifies an asset attribute property. An attribute generally contains
    -- static information, such as the serial number of an
    -- <https://en.wikipedia.org/wiki/Internet_of_things#Industrial_applications IIoT>
    -- wind turbine.
    PropertyType -> Maybe Attribute
attribute :: Prelude.Maybe Attribute,
    -- | Specifies an asset measurement property. A measurement represents a
    -- device\'s raw sensor data stream, such as timestamped temperature values
    -- or timestamped power values.
    PropertyType -> Maybe Measurement
measurement :: Prelude.Maybe Measurement,
    -- | Specifies an asset metric property. A metric contains a mathematical
    -- expression that uses aggregate functions to process all input data
    -- points over a time interval and output a single data point, such as to
    -- calculate the average hourly temperature.
    PropertyType -> Maybe Metric
metric :: Prelude.Maybe Metric,
    -- | Specifies an asset transform property. A transform contains a
    -- mathematical expression that maps a property\'s data points from one
    -- form to another, such as a unit conversion from Celsius to Fahrenheit.
    PropertyType -> Maybe Transform
transform :: Prelude.Maybe Transform
  }
  deriving (PropertyType -> PropertyType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyType -> PropertyType -> Bool
$c/= :: PropertyType -> PropertyType -> Bool
== :: PropertyType -> PropertyType -> Bool
$c== :: PropertyType -> PropertyType -> Bool
Prelude.Eq, ReadPrec [PropertyType]
ReadPrec PropertyType
Int -> ReadS PropertyType
ReadS [PropertyType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PropertyType]
$creadListPrec :: ReadPrec [PropertyType]
readPrec :: ReadPrec PropertyType
$creadPrec :: ReadPrec PropertyType
readList :: ReadS [PropertyType]
$creadList :: ReadS [PropertyType]
readsPrec :: Int -> ReadS PropertyType
$creadsPrec :: Int -> ReadS PropertyType
Prelude.Read, Int -> PropertyType -> ShowS
[PropertyType] -> ShowS
PropertyType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyType] -> ShowS
$cshowList :: [PropertyType] -> ShowS
show :: PropertyType -> String
$cshow :: PropertyType -> String
showsPrec :: Int -> PropertyType -> ShowS
$cshowsPrec :: Int -> PropertyType -> ShowS
Prelude.Show, forall x. Rep PropertyType x -> PropertyType
forall x. PropertyType -> Rep PropertyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PropertyType x -> PropertyType
$cfrom :: forall x. PropertyType -> Rep PropertyType x
Prelude.Generic)

-- |
-- Create a value of 'PropertyType' 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:
--
-- 'attribute', 'propertyType_attribute' - Specifies an asset attribute property. An attribute generally contains
-- static information, such as the serial number of an
-- <https://en.wikipedia.org/wiki/Internet_of_things#Industrial_applications IIoT>
-- wind turbine.
--
-- 'measurement', 'propertyType_measurement' - Specifies an asset measurement property. A measurement represents a
-- device\'s raw sensor data stream, such as timestamped temperature values
-- or timestamped power values.
--
-- 'metric', 'propertyType_metric' - Specifies an asset metric property. A metric contains a mathematical
-- expression that uses aggregate functions to process all input data
-- points over a time interval and output a single data point, such as to
-- calculate the average hourly temperature.
--
-- 'transform', 'propertyType_transform' - Specifies an asset transform property. A transform contains a
-- mathematical expression that maps a property\'s data points from one
-- form to another, such as a unit conversion from Celsius to Fahrenheit.
newPropertyType ::
  PropertyType
newPropertyType :: PropertyType
newPropertyType =
  PropertyType'
    { $sel:attribute:PropertyType' :: Maybe Attribute
attribute = forall a. Maybe a
Prelude.Nothing,
      $sel:measurement:PropertyType' :: Maybe Measurement
measurement = forall a. Maybe a
Prelude.Nothing,
      $sel:metric:PropertyType' :: Maybe Metric
metric = forall a. Maybe a
Prelude.Nothing,
      $sel:transform:PropertyType' :: Maybe Transform
transform = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies an asset attribute property. An attribute generally contains
-- static information, such as the serial number of an
-- <https://en.wikipedia.org/wiki/Internet_of_things#Industrial_applications IIoT>
-- wind turbine.
propertyType_attribute :: Lens.Lens' PropertyType (Prelude.Maybe Attribute)
propertyType_attribute :: Lens' PropertyType (Maybe Attribute)
propertyType_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PropertyType' {Maybe Attribute
attribute :: Maybe Attribute
$sel:attribute:PropertyType' :: PropertyType -> Maybe Attribute
attribute} -> Maybe Attribute
attribute) (\s :: PropertyType
s@PropertyType' {} Maybe Attribute
a -> PropertyType
s {$sel:attribute:PropertyType' :: Maybe Attribute
attribute = Maybe Attribute
a} :: PropertyType)

-- | Specifies an asset measurement property. A measurement represents a
-- device\'s raw sensor data stream, such as timestamped temperature values
-- or timestamped power values.
propertyType_measurement :: Lens.Lens' PropertyType (Prelude.Maybe Measurement)
propertyType_measurement :: Lens' PropertyType (Maybe Measurement)
propertyType_measurement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PropertyType' {Maybe Measurement
measurement :: Maybe Measurement
$sel:measurement:PropertyType' :: PropertyType -> Maybe Measurement
measurement} -> Maybe Measurement
measurement) (\s :: PropertyType
s@PropertyType' {} Maybe Measurement
a -> PropertyType
s {$sel:measurement:PropertyType' :: Maybe Measurement
measurement = Maybe Measurement
a} :: PropertyType)

-- | Specifies an asset metric property. A metric contains a mathematical
-- expression that uses aggregate functions to process all input data
-- points over a time interval and output a single data point, such as to
-- calculate the average hourly temperature.
propertyType_metric :: Lens.Lens' PropertyType (Prelude.Maybe Metric)
propertyType_metric :: Lens' PropertyType (Maybe Metric)
propertyType_metric = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PropertyType' {Maybe Metric
metric :: Maybe Metric
$sel:metric:PropertyType' :: PropertyType -> Maybe Metric
metric} -> Maybe Metric
metric) (\s :: PropertyType
s@PropertyType' {} Maybe Metric
a -> PropertyType
s {$sel:metric:PropertyType' :: Maybe Metric
metric = Maybe Metric
a} :: PropertyType)

-- | Specifies an asset transform property. A transform contains a
-- mathematical expression that maps a property\'s data points from one
-- form to another, such as a unit conversion from Celsius to Fahrenheit.
propertyType_transform :: Lens.Lens' PropertyType (Prelude.Maybe Transform)
propertyType_transform :: Lens' PropertyType (Maybe Transform)
propertyType_transform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PropertyType' {Maybe Transform
transform :: Maybe Transform
$sel:transform:PropertyType' :: PropertyType -> Maybe Transform
transform} -> Maybe Transform
transform) (\s :: PropertyType
s@PropertyType' {} Maybe Transform
a -> PropertyType
s {$sel:transform:PropertyType' :: Maybe Transform
transform = Maybe Transform
a} :: PropertyType)

instance Data.FromJSON PropertyType where
  parseJSON :: Value -> Parser PropertyType
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PropertyType"
      ( \Object
x ->
          Maybe Attribute
-> Maybe Measurement
-> Maybe Metric
-> Maybe Transform
-> PropertyType
PropertyType'
            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
"attribute")
            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
"measurement")
            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
"metric")
            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
"transform")
      )

instance Prelude.Hashable PropertyType where
  hashWithSalt :: Int -> PropertyType -> Int
hashWithSalt Int
_salt PropertyType' {Maybe Attribute
Maybe Measurement
Maybe Transform
Maybe Metric
transform :: Maybe Transform
metric :: Maybe Metric
measurement :: Maybe Measurement
attribute :: Maybe Attribute
$sel:transform:PropertyType' :: PropertyType -> Maybe Transform
$sel:metric:PropertyType' :: PropertyType -> Maybe Metric
$sel:measurement:PropertyType' :: PropertyType -> Maybe Measurement
$sel:attribute:PropertyType' :: PropertyType -> Maybe Attribute
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Attribute
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Measurement
measurement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Metric
metric
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Transform
transform

instance Prelude.NFData PropertyType where
  rnf :: PropertyType -> ()
rnf PropertyType' {Maybe Attribute
Maybe Measurement
Maybe Transform
Maybe Metric
transform :: Maybe Transform
metric :: Maybe Metric
measurement :: Maybe Measurement
attribute :: Maybe Attribute
$sel:transform:PropertyType' :: PropertyType -> Maybe Transform
$sel:metric:PropertyType' :: PropertyType -> Maybe Metric
$sel:measurement:PropertyType' :: PropertyType -> Maybe Measurement
$sel:attribute:PropertyType' :: PropertyType -> Maybe Attribute
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Attribute
attribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Measurement
measurement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Metric
metric
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Transform
transform

instance Data.ToJSON PropertyType where
  toJSON :: PropertyType -> Value
toJSON PropertyType' {Maybe Attribute
Maybe Measurement
Maybe Transform
Maybe Metric
transform :: Maybe Transform
metric :: Maybe Metric
measurement :: Maybe Measurement
attribute :: Maybe Attribute
$sel:transform:PropertyType' :: PropertyType -> Maybe Transform
$sel:metric:PropertyType' :: PropertyType -> Maybe Metric
$sel:measurement:PropertyType' :: PropertyType -> Maybe Measurement
$sel:attribute:PropertyType' :: PropertyType -> Maybe Attribute
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"attribute" 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 Attribute
attribute,
            (Key
"measurement" 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 Measurement
measurement,
            (Key
"metric" 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 Metric
metric,
            (Key
"transform" 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 Transform
transform
          ]
      )