{-# 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.IoTWireless.Types.CellTowers
-- 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.IoTWireless.Types.CellTowers where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTWireless.Types.CdmaObj
import Amazonka.IoTWireless.Types.GsmObj
import Amazonka.IoTWireless.Types.LteObj
import Amazonka.IoTWireless.Types.TdscdmaObj
import Amazonka.IoTWireless.Types.WcdmaObj
import qualified Amazonka.Prelude as Prelude

-- | The cell towers that were used to perform the measurements.
--
-- /See:/ 'newCellTowers' smart constructor.
data CellTowers = CellTowers'
  { -- | CDMA object information.
    CellTowers -> Maybe (NonEmpty CdmaObj)
cdma :: Prelude.Maybe (Prelude.NonEmpty CdmaObj),
    -- | GSM object information.
    CellTowers -> Maybe (NonEmpty GsmObj)
gsm :: Prelude.Maybe (Prelude.NonEmpty GsmObj),
    -- | LTE object information.
    CellTowers -> Maybe (NonEmpty LteObj)
lte :: Prelude.Maybe (Prelude.NonEmpty LteObj),
    -- | TD-SCDMA object information.
    CellTowers -> Maybe (NonEmpty TdscdmaObj)
tdscdma :: Prelude.Maybe (Prelude.NonEmpty TdscdmaObj),
    -- | WCDMA object information.
    CellTowers -> Maybe (NonEmpty WcdmaObj)
wcdma :: Prelude.Maybe (Prelude.NonEmpty WcdmaObj)
  }
  deriving (CellTowers -> CellTowers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellTowers -> CellTowers -> Bool
$c/= :: CellTowers -> CellTowers -> Bool
== :: CellTowers -> CellTowers -> Bool
$c== :: CellTowers -> CellTowers -> Bool
Prelude.Eq, ReadPrec [CellTowers]
ReadPrec CellTowers
Int -> ReadS CellTowers
ReadS [CellTowers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CellTowers]
$creadListPrec :: ReadPrec [CellTowers]
readPrec :: ReadPrec CellTowers
$creadPrec :: ReadPrec CellTowers
readList :: ReadS [CellTowers]
$creadList :: ReadS [CellTowers]
readsPrec :: Int -> ReadS CellTowers
$creadsPrec :: Int -> ReadS CellTowers
Prelude.Read, Int -> CellTowers -> ShowS
[CellTowers] -> ShowS
CellTowers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellTowers] -> ShowS
$cshowList :: [CellTowers] -> ShowS
show :: CellTowers -> String
$cshow :: CellTowers -> String
showsPrec :: Int -> CellTowers -> ShowS
$cshowsPrec :: Int -> CellTowers -> ShowS
Prelude.Show, forall x. Rep CellTowers x -> CellTowers
forall x. CellTowers -> Rep CellTowers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellTowers x -> CellTowers
$cfrom :: forall x. CellTowers -> Rep CellTowers x
Prelude.Generic)

-- |
-- Create a value of 'CellTowers' 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:
--
-- 'cdma', 'cellTowers_cdma' - CDMA object information.
--
-- 'gsm', 'cellTowers_gsm' - GSM object information.
--
-- 'lte', 'cellTowers_lte' - LTE object information.
--
-- 'tdscdma', 'cellTowers_tdscdma' - TD-SCDMA object information.
--
-- 'wcdma', 'cellTowers_wcdma' - WCDMA object information.
newCellTowers ::
  CellTowers
newCellTowers :: CellTowers
newCellTowers =
  CellTowers'
    { $sel:cdma:CellTowers' :: Maybe (NonEmpty CdmaObj)
cdma = forall a. Maybe a
Prelude.Nothing,
      $sel:gsm:CellTowers' :: Maybe (NonEmpty GsmObj)
gsm = forall a. Maybe a
Prelude.Nothing,
      $sel:lte:CellTowers' :: Maybe (NonEmpty LteObj)
lte = forall a. Maybe a
Prelude.Nothing,
      $sel:tdscdma:CellTowers' :: Maybe (NonEmpty TdscdmaObj)
tdscdma = forall a. Maybe a
Prelude.Nothing,
      $sel:wcdma:CellTowers' :: Maybe (NonEmpty WcdmaObj)
wcdma = forall a. Maybe a
Prelude.Nothing
    }

-- | CDMA object information.
cellTowers_cdma :: Lens.Lens' CellTowers (Prelude.Maybe (Prelude.NonEmpty CdmaObj))
cellTowers_cdma :: Lens' CellTowers (Maybe (NonEmpty CdmaObj))
cellTowers_cdma = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CellTowers' {Maybe (NonEmpty CdmaObj)
cdma :: Maybe (NonEmpty CdmaObj)
$sel:cdma:CellTowers' :: CellTowers -> Maybe (NonEmpty CdmaObj)
cdma} -> Maybe (NonEmpty CdmaObj)
cdma) (\s :: CellTowers
s@CellTowers' {} Maybe (NonEmpty CdmaObj)
a -> CellTowers
s {$sel:cdma:CellTowers' :: Maybe (NonEmpty CdmaObj)
cdma = Maybe (NonEmpty CdmaObj)
a} :: CellTowers) 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

-- | GSM object information.
cellTowers_gsm :: Lens.Lens' CellTowers (Prelude.Maybe (Prelude.NonEmpty GsmObj))
cellTowers_gsm :: Lens' CellTowers (Maybe (NonEmpty GsmObj))
cellTowers_gsm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CellTowers' {Maybe (NonEmpty GsmObj)
gsm :: Maybe (NonEmpty GsmObj)
$sel:gsm:CellTowers' :: CellTowers -> Maybe (NonEmpty GsmObj)
gsm} -> Maybe (NonEmpty GsmObj)
gsm) (\s :: CellTowers
s@CellTowers' {} Maybe (NonEmpty GsmObj)
a -> CellTowers
s {$sel:gsm:CellTowers' :: Maybe (NonEmpty GsmObj)
gsm = Maybe (NonEmpty GsmObj)
a} :: CellTowers) 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

-- | LTE object information.
cellTowers_lte :: Lens.Lens' CellTowers (Prelude.Maybe (Prelude.NonEmpty LteObj))
cellTowers_lte :: Lens' CellTowers (Maybe (NonEmpty LteObj))
cellTowers_lte = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CellTowers' {Maybe (NonEmpty LteObj)
lte :: Maybe (NonEmpty LteObj)
$sel:lte:CellTowers' :: CellTowers -> Maybe (NonEmpty LteObj)
lte} -> Maybe (NonEmpty LteObj)
lte) (\s :: CellTowers
s@CellTowers' {} Maybe (NonEmpty LteObj)
a -> CellTowers
s {$sel:lte:CellTowers' :: Maybe (NonEmpty LteObj)
lte = Maybe (NonEmpty LteObj)
a} :: CellTowers) 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

-- | TD-SCDMA object information.
cellTowers_tdscdma :: Lens.Lens' CellTowers (Prelude.Maybe (Prelude.NonEmpty TdscdmaObj))
cellTowers_tdscdma :: Lens' CellTowers (Maybe (NonEmpty TdscdmaObj))
cellTowers_tdscdma = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CellTowers' {Maybe (NonEmpty TdscdmaObj)
tdscdma :: Maybe (NonEmpty TdscdmaObj)
$sel:tdscdma:CellTowers' :: CellTowers -> Maybe (NonEmpty TdscdmaObj)
tdscdma} -> Maybe (NonEmpty TdscdmaObj)
tdscdma) (\s :: CellTowers
s@CellTowers' {} Maybe (NonEmpty TdscdmaObj)
a -> CellTowers
s {$sel:tdscdma:CellTowers' :: Maybe (NonEmpty TdscdmaObj)
tdscdma = Maybe (NonEmpty TdscdmaObj)
a} :: CellTowers) 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

-- | WCDMA object information.
cellTowers_wcdma :: Lens.Lens' CellTowers (Prelude.Maybe (Prelude.NonEmpty WcdmaObj))
cellTowers_wcdma :: Lens' CellTowers (Maybe (NonEmpty WcdmaObj))
cellTowers_wcdma = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CellTowers' {Maybe (NonEmpty WcdmaObj)
wcdma :: Maybe (NonEmpty WcdmaObj)
$sel:wcdma:CellTowers' :: CellTowers -> Maybe (NonEmpty WcdmaObj)
wcdma} -> Maybe (NonEmpty WcdmaObj)
wcdma) (\s :: CellTowers
s@CellTowers' {} Maybe (NonEmpty WcdmaObj)
a -> CellTowers
s {$sel:wcdma:CellTowers' :: Maybe (NonEmpty WcdmaObj)
wcdma = Maybe (NonEmpty WcdmaObj)
a} :: CellTowers) 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

instance Prelude.Hashable CellTowers where
  hashWithSalt :: Int -> CellTowers -> Int
hashWithSalt Int
_salt CellTowers' {Maybe (NonEmpty CdmaObj)
Maybe (NonEmpty GsmObj)
Maybe (NonEmpty LteObj)
Maybe (NonEmpty TdscdmaObj)
Maybe (NonEmpty WcdmaObj)
wcdma :: Maybe (NonEmpty WcdmaObj)
tdscdma :: Maybe (NonEmpty TdscdmaObj)
lte :: Maybe (NonEmpty LteObj)
gsm :: Maybe (NonEmpty GsmObj)
cdma :: Maybe (NonEmpty CdmaObj)
$sel:wcdma:CellTowers' :: CellTowers -> Maybe (NonEmpty WcdmaObj)
$sel:tdscdma:CellTowers' :: CellTowers -> Maybe (NonEmpty TdscdmaObj)
$sel:lte:CellTowers' :: CellTowers -> Maybe (NonEmpty LteObj)
$sel:gsm:CellTowers' :: CellTowers -> Maybe (NonEmpty GsmObj)
$sel:cdma:CellTowers' :: CellTowers -> Maybe (NonEmpty CdmaObj)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty CdmaObj)
cdma
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty GsmObj)
gsm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty LteObj)
lte
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty TdscdmaObj)
tdscdma
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty WcdmaObj)
wcdma

instance Prelude.NFData CellTowers where
  rnf :: CellTowers -> ()
rnf CellTowers' {Maybe (NonEmpty CdmaObj)
Maybe (NonEmpty GsmObj)
Maybe (NonEmpty LteObj)
Maybe (NonEmpty TdscdmaObj)
Maybe (NonEmpty WcdmaObj)
wcdma :: Maybe (NonEmpty WcdmaObj)
tdscdma :: Maybe (NonEmpty TdscdmaObj)
lte :: Maybe (NonEmpty LteObj)
gsm :: Maybe (NonEmpty GsmObj)
cdma :: Maybe (NonEmpty CdmaObj)
$sel:wcdma:CellTowers' :: CellTowers -> Maybe (NonEmpty WcdmaObj)
$sel:tdscdma:CellTowers' :: CellTowers -> Maybe (NonEmpty TdscdmaObj)
$sel:lte:CellTowers' :: CellTowers -> Maybe (NonEmpty LteObj)
$sel:gsm:CellTowers' :: CellTowers -> Maybe (NonEmpty GsmObj)
$sel:cdma:CellTowers' :: CellTowers -> Maybe (NonEmpty CdmaObj)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty CdmaObj)
cdma
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty GsmObj)
gsm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty LteObj)
lte
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty TdscdmaObj)
tdscdma
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty WcdmaObj)
wcdma

instance Data.ToJSON CellTowers where
  toJSON :: CellTowers -> Value
toJSON CellTowers' {Maybe (NonEmpty CdmaObj)
Maybe (NonEmpty GsmObj)
Maybe (NonEmpty LteObj)
Maybe (NonEmpty TdscdmaObj)
Maybe (NonEmpty WcdmaObj)
wcdma :: Maybe (NonEmpty WcdmaObj)
tdscdma :: Maybe (NonEmpty TdscdmaObj)
lte :: Maybe (NonEmpty LteObj)
gsm :: Maybe (NonEmpty GsmObj)
cdma :: Maybe (NonEmpty CdmaObj)
$sel:wcdma:CellTowers' :: CellTowers -> Maybe (NonEmpty WcdmaObj)
$sel:tdscdma:CellTowers' :: CellTowers -> Maybe (NonEmpty TdscdmaObj)
$sel:lte:CellTowers' :: CellTowers -> Maybe (NonEmpty LteObj)
$sel:gsm:CellTowers' :: CellTowers -> Maybe (NonEmpty GsmObj)
$sel:cdma:CellTowers' :: CellTowers -> Maybe (NonEmpty CdmaObj)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Cdma" 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 (NonEmpty CdmaObj)
cdma,
            (Key
"Gsm" 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 (NonEmpty GsmObj)
gsm,
            (Key
"Lte" 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 (NonEmpty LteObj)
lte,
            (Key
"Tdscdma" 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 (NonEmpty TdscdmaObj)
tdscdma,
            (Key
"Wcdma" 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 (NonEmpty WcdmaObj)
wcdma
          ]
      )