{-# 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.IoTFleetWise.Types.Node
-- 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.IoTFleetWise.Types.Node where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTFleetWise.Types.Actuator
import Amazonka.IoTFleetWise.Types.Attribute
import Amazonka.IoTFleetWise.Types.Branch
import Amazonka.IoTFleetWise.Types.Sensor
import qualified Amazonka.Prelude as Prelude

-- | A general abstraction of a signal. A node can be specified as an
-- actuator, attribute, branch, or sensor.
--
-- /See:/ 'newNode' smart constructor.
data Node = Node'
  { -- | Information about a node specified as an actuator.
    --
    -- An actuator is a digital representation of a vehicle device.
    Node -> Maybe Actuator
actuator :: Prelude.Maybe Actuator,
    -- | Information about a node specified as an attribute.
    --
    -- An attribute represents static information about a vehicle.
    Node -> Maybe Attribute
attribute :: Prelude.Maybe Attribute,
    -- | Information about a node specified as a branch.
    --
    -- A group of signals that are defined in a hierarchical structure.
    Node -> Maybe Branch
branch :: Prelude.Maybe Branch,
    Node -> Maybe Sensor
sensor :: Prelude.Maybe Sensor
  }
  deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Prelude.Eq, ReadPrec [Node]
ReadPrec Node
Int -> ReadS Node
ReadS [Node]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Node]
$creadListPrec :: ReadPrec [Node]
readPrec :: ReadPrec Node
$creadPrec :: ReadPrec Node
readList :: ReadS [Node]
$creadList :: ReadS [Node]
readsPrec :: Int -> ReadS Node
$creadsPrec :: Int -> ReadS Node
Prelude.Read, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Prelude.Show, forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Prelude.Generic)

-- |
-- Create a value of 'Node' 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:
--
-- 'actuator', 'node_actuator' - Information about a node specified as an actuator.
--
-- An actuator is a digital representation of a vehicle device.
--
-- 'attribute', 'node_attribute' - Information about a node specified as an attribute.
--
-- An attribute represents static information about a vehicle.
--
-- 'branch', 'node_branch' - Information about a node specified as a branch.
--
-- A group of signals that are defined in a hierarchical structure.
--
-- 'sensor', 'node_sensor' - Undocumented member.
newNode ::
  Node
newNode :: Node
newNode =
  Node'
    { $sel:actuator:Node' :: Maybe Actuator
actuator = forall a. Maybe a
Prelude.Nothing,
      $sel:attribute:Node' :: Maybe Attribute
attribute = forall a. Maybe a
Prelude.Nothing,
      $sel:branch:Node' :: Maybe Branch
branch = forall a. Maybe a
Prelude.Nothing,
      $sel:sensor:Node' :: Maybe Sensor
sensor = forall a. Maybe a
Prelude.Nothing
    }

-- | Information about a node specified as an actuator.
--
-- An actuator is a digital representation of a vehicle device.
node_actuator :: Lens.Lens' Node (Prelude.Maybe Actuator)
node_actuator :: Lens' Node (Maybe Actuator)
node_actuator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Node' {Maybe Actuator
actuator :: Maybe Actuator
$sel:actuator:Node' :: Node -> Maybe Actuator
actuator} -> Maybe Actuator
actuator) (\s :: Node
s@Node' {} Maybe Actuator
a -> Node
s {$sel:actuator:Node' :: Maybe Actuator
actuator = Maybe Actuator
a} :: Node)

-- | Information about a node specified as an attribute.
--
-- An attribute represents static information about a vehicle.
node_attribute :: Lens.Lens' Node (Prelude.Maybe Attribute)
node_attribute :: Lens' Node (Maybe Attribute)
node_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Node' {Maybe Attribute
attribute :: Maybe Attribute
$sel:attribute:Node' :: Node -> Maybe Attribute
attribute} -> Maybe Attribute
attribute) (\s :: Node
s@Node' {} Maybe Attribute
a -> Node
s {$sel:attribute:Node' :: Maybe Attribute
attribute = Maybe Attribute
a} :: Node)

-- | Information about a node specified as a branch.
--
-- A group of signals that are defined in a hierarchical structure.
node_branch :: Lens.Lens' Node (Prelude.Maybe Branch)
node_branch :: Lens' Node (Maybe Branch)
node_branch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Node' {Maybe Branch
branch :: Maybe Branch
$sel:branch:Node' :: Node -> Maybe Branch
branch} -> Maybe Branch
branch) (\s :: Node
s@Node' {} Maybe Branch
a -> Node
s {$sel:branch:Node' :: Maybe Branch
branch = Maybe Branch
a} :: Node)

-- | Undocumented member.
node_sensor :: Lens.Lens' Node (Prelude.Maybe Sensor)
node_sensor :: Lens' Node (Maybe Sensor)
node_sensor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Node' {Maybe Sensor
sensor :: Maybe Sensor
$sel:sensor:Node' :: Node -> Maybe Sensor
sensor} -> Maybe Sensor
sensor) (\s :: Node
s@Node' {} Maybe Sensor
a -> Node
s {$sel:sensor:Node' :: Maybe Sensor
sensor = Maybe Sensor
a} :: Node)

instance Data.FromJSON Node where
  parseJSON :: Value -> Parser Node
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Node"
      ( \Object
x ->
          Maybe Actuator
-> Maybe Attribute -> Maybe Branch -> Maybe Sensor -> Node
Node'
            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
"actuator")
            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
"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
"branch")
            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
"sensor")
      )

instance Prelude.Hashable Node where
  hashWithSalt :: Int -> Node -> Int
hashWithSalt Int
_salt Node' {Maybe Branch
Maybe Attribute
Maybe Actuator
Maybe Sensor
sensor :: Maybe Sensor
branch :: Maybe Branch
attribute :: Maybe Attribute
actuator :: Maybe Actuator
$sel:sensor:Node' :: Node -> Maybe Sensor
$sel:branch:Node' :: Node -> Maybe Branch
$sel:attribute:Node' :: Node -> Maybe Attribute
$sel:actuator:Node' :: Node -> Maybe Actuator
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Actuator
actuator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Attribute
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Branch
branch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Sensor
sensor

instance Prelude.NFData Node where
  rnf :: Node -> ()
rnf Node' {Maybe Branch
Maybe Attribute
Maybe Actuator
Maybe Sensor
sensor :: Maybe Sensor
branch :: Maybe Branch
attribute :: Maybe Attribute
actuator :: Maybe Actuator
$sel:sensor:Node' :: Node -> Maybe Sensor
$sel:branch:Node' :: Node -> Maybe Branch
$sel:attribute:Node' :: Node -> Maybe Attribute
$sel:actuator:Node' :: Node -> Maybe Actuator
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Actuator
actuator
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Branch
branch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Sensor
sensor

instance Data.ToJSON Node where
  toJSON :: Node -> Value
toJSON Node' {Maybe Branch
Maybe Attribute
Maybe Actuator
Maybe Sensor
sensor :: Maybe Sensor
branch :: Maybe Branch
attribute :: Maybe Attribute
actuator :: Maybe Actuator
$sel:sensor:Node' :: Node -> Maybe Sensor
$sel:branch:Node' :: Node -> Maybe Branch
$sel:attribute:Node' :: Node -> Maybe Attribute
$sel:actuator:Node' :: Node -> Maybe Actuator
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"actuator" 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 Actuator
actuator,
            (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
"branch" 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 Branch
branch,
            (Key
"sensor" 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 Sensor
sensor
          ]
      )