{-# 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.Transcribe.Types.SentimentFilter
-- 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.Transcribe.Types.SentimentFilter where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Transcribe.Types.AbsoluteTimeRange
import Amazonka.Transcribe.Types.ParticipantRole
import Amazonka.Transcribe.Types.RelativeTimeRange
import Amazonka.Transcribe.Types.SentimentValue

-- | Flag the presence or absence of specific sentiments detected in your
-- Call Analytics transcription output.
--
-- Rules using @SentimentFilter@ are designed to match:
--
-- -   The presence or absence of a positive sentiment felt by the
--     customer, agent, or both at specified points in the call
--
-- -   The presence or absence of a negative sentiment felt by the
--     customer, agent, or both at specified points in the call
--
-- -   The presence or absence of a neutral sentiment felt by the customer,
--     agent, or both at specified points in the call
--
-- -   The presence or absence of a mixed sentiment felt by the customer,
--     the agent, or both at specified points in the call
--
-- See
-- <https://docs.aws.amazon.com/transcribe/latest/dg/tca-categories-batch.html#tca-rules-batch Rule criteria for batch categories>
-- for usage examples.
--
-- /See:/ 'newSentimentFilter' smart constructor.
data SentimentFilter = SentimentFilter'
  { -- | Makes it possible to specify a time range (in milliseconds) in your
    -- audio, during which you want to search for the specified sentiments. See
    -- for more detail.
    SentimentFilter -> Maybe AbsoluteTimeRange
absoluteTimeRange :: Prelude.Maybe AbsoluteTimeRange,
    -- | Set to @TRUE@ to flag the sentiments that you didn\'t include in your
    -- request. Set to @FALSE@ to flag the sentiments that you specified in
    -- your request.
    SentimentFilter -> Maybe Bool
negate :: Prelude.Maybe Prelude.Bool,
    -- | Specify the participant that you want to flag. Omitting this parameter
    -- is equivalent to specifying both participants.
    SentimentFilter -> Maybe ParticipantRole
participantRole :: Prelude.Maybe ParticipantRole,
    -- | Makes it possible to specify a time range (in percentage) in your media
    -- file, during which you want to search for the specified sentiments. See
    -- for more detail.
    SentimentFilter -> Maybe RelativeTimeRange
relativeTimeRange :: Prelude.Maybe RelativeTimeRange,
    -- | Specify the sentiments that you want to flag.
    SentimentFilter -> NonEmpty SentimentValue
sentiments :: Prelude.NonEmpty SentimentValue
  }
  deriving (SentimentFilter -> SentimentFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentimentFilter -> SentimentFilter -> Bool
$c/= :: SentimentFilter -> SentimentFilter -> Bool
== :: SentimentFilter -> SentimentFilter -> Bool
$c== :: SentimentFilter -> SentimentFilter -> Bool
Prelude.Eq, ReadPrec [SentimentFilter]
ReadPrec SentimentFilter
Int -> ReadS SentimentFilter
ReadS [SentimentFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SentimentFilter]
$creadListPrec :: ReadPrec [SentimentFilter]
readPrec :: ReadPrec SentimentFilter
$creadPrec :: ReadPrec SentimentFilter
readList :: ReadS [SentimentFilter]
$creadList :: ReadS [SentimentFilter]
readsPrec :: Int -> ReadS SentimentFilter
$creadsPrec :: Int -> ReadS SentimentFilter
Prelude.Read, Int -> SentimentFilter -> ShowS
[SentimentFilter] -> ShowS
SentimentFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentimentFilter] -> ShowS
$cshowList :: [SentimentFilter] -> ShowS
show :: SentimentFilter -> String
$cshow :: SentimentFilter -> String
showsPrec :: Int -> SentimentFilter -> ShowS
$cshowsPrec :: Int -> SentimentFilter -> ShowS
Prelude.Show, forall x. Rep SentimentFilter x -> SentimentFilter
forall x. SentimentFilter -> Rep SentimentFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SentimentFilter x -> SentimentFilter
$cfrom :: forall x. SentimentFilter -> Rep SentimentFilter x
Prelude.Generic)

-- |
-- Create a value of 'SentimentFilter' 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:
--
-- 'absoluteTimeRange', 'sentimentFilter_absoluteTimeRange' - Makes it possible to specify a time range (in milliseconds) in your
-- audio, during which you want to search for the specified sentiments. See
-- for more detail.
--
-- 'negate', 'sentimentFilter_negate' - Set to @TRUE@ to flag the sentiments that you didn\'t include in your
-- request. Set to @FALSE@ to flag the sentiments that you specified in
-- your request.
--
-- 'participantRole', 'sentimentFilter_participantRole' - Specify the participant that you want to flag. Omitting this parameter
-- is equivalent to specifying both participants.
--
-- 'relativeTimeRange', 'sentimentFilter_relativeTimeRange' - Makes it possible to specify a time range (in percentage) in your media
-- file, during which you want to search for the specified sentiments. See
-- for more detail.
--
-- 'sentiments', 'sentimentFilter_sentiments' - Specify the sentiments that you want to flag.
newSentimentFilter ::
  -- | 'sentiments'
  Prelude.NonEmpty SentimentValue ->
  SentimentFilter
newSentimentFilter :: NonEmpty SentimentValue -> SentimentFilter
newSentimentFilter NonEmpty SentimentValue
pSentiments_ =
  SentimentFilter'
    { $sel:absoluteTimeRange:SentimentFilter' :: Maybe AbsoluteTimeRange
absoluteTimeRange =
        forall a. Maybe a
Prelude.Nothing,
      $sel:negate:SentimentFilter' :: Maybe Bool
negate = forall a. Maybe a
Prelude.Nothing,
      $sel:participantRole:SentimentFilter' :: Maybe ParticipantRole
participantRole = forall a. Maybe a
Prelude.Nothing,
      $sel:relativeTimeRange:SentimentFilter' :: Maybe RelativeTimeRange
relativeTimeRange = forall a. Maybe a
Prelude.Nothing,
      $sel:sentiments:SentimentFilter' :: NonEmpty SentimentValue
sentiments = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty SentimentValue
pSentiments_
    }

-- | Makes it possible to specify a time range (in milliseconds) in your
-- audio, during which you want to search for the specified sentiments. See
-- for more detail.
sentimentFilter_absoluteTimeRange :: Lens.Lens' SentimentFilter (Prelude.Maybe AbsoluteTimeRange)
sentimentFilter_absoluteTimeRange :: Lens' SentimentFilter (Maybe AbsoluteTimeRange)
sentimentFilter_absoluteTimeRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SentimentFilter' {Maybe AbsoluteTimeRange
absoluteTimeRange :: Maybe AbsoluteTimeRange
$sel:absoluteTimeRange:SentimentFilter' :: SentimentFilter -> Maybe AbsoluteTimeRange
absoluteTimeRange} -> Maybe AbsoluteTimeRange
absoluteTimeRange) (\s :: SentimentFilter
s@SentimentFilter' {} Maybe AbsoluteTimeRange
a -> SentimentFilter
s {$sel:absoluteTimeRange:SentimentFilter' :: Maybe AbsoluteTimeRange
absoluteTimeRange = Maybe AbsoluteTimeRange
a} :: SentimentFilter)

-- | Set to @TRUE@ to flag the sentiments that you didn\'t include in your
-- request. Set to @FALSE@ to flag the sentiments that you specified in
-- your request.
sentimentFilter_negate :: Lens.Lens' SentimentFilter (Prelude.Maybe Prelude.Bool)
sentimentFilter_negate :: Lens' SentimentFilter (Maybe Bool)
sentimentFilter_negate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SentimentFilter' {Maybe Bool
negate :: Maybe Bool
$sel:negate:SentimentFilter' :: SentimentFilter -> Maybe Bool
negate} -> Maybe Bool
negate) (\s :: SentimentFilter
s@SentimentFilter' {} Maybe Bool
a -> SentimentFilter
s {$sel:negate:SentimentFilter' :: Maybe Bool
negate = Maybe Bool
a} :: SentimentFilter)

-- | Specify the participant that you want to flag. Omitting this parameter
-- is equivalent to specifying both participants.
sentimentFilter_participantRole :: Lens.Lens' SentimentFilter (Prelude.Maybe ParticipantRole)
sentimentFilter_participantRole :: Lens' SentimentFilter (Maybe ParticipantRole)
sentimentFilter_participantRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SentimentFilter' {Maybe ParticipantRole
participantRole :: Maybe ParticipantRole
$sel:participantRole:SentimentFilter' :: SentimentFilter -> Maybe ParticipantRole
participantRole} -> Maybe ParticipantRole
participantRole) (\s :: SentimentFilter
s@SentimentFilter' {} Maybe ParticipantRole
a -> SentimentFilter
s {$sel:participantRole:SentimentFilter' :: Maybe ParticipantRole
participantRole = Maybe ParticipantRole
a} :: SentimentFilter)

-- | Makes it possible to specify a time range (in percentage) in your media
-- file, during which you want to search for the specified sentiments. See
-- for more detail.
sentimentFilter_relativeTimeRange :: Lens.Lens' SentimentFilter (Prelude.Maybe RelativeTimeRange)
sentimentFilter_relativeTimeRange :: Lens' SentimentFilter (Maybe RelativeTimeRange)
sentimentFilter_relativeTimeRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SentimentFilter' {Maybe RelativeTimeRange
relativeTimeRange :: Maybe RelativeTimeRange
$sel:relativeTimeRange:SentimentFilter' :: SentimentFilter -> Maybe RelativeTimeRange
relativeTimeRange} -> Maybe RelativeTimeRange
relativeTimeRange) (\s :: SentimentFilter
s@SentimentFilter' {} Maybe RelativeTimeRange
a -> SentimentFilter
s {$sel:relativeTimeRange:SentimentFilter' :: Maybe RelativeTimeRange
relativeTimeRange = Maybe RelativeTimeRange
a} :: SentimentFilter)

-- | Specify the sentiments that you want to flag.
sentimentFilter_sentiments :: Lens.Lens' SentimentFilter (Prelude.NonEmpty SentimentValue)
sentimentFilter_sentiments :: Lens' SentimentFilter (NonEmpty SentimentValue)
sentimentFilter_sentiments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SentimentFilter' {NonEmpty SentimentValue
sentiments :: NonEmpty SentimentValue
$sel:sentiments:SentimentFilter' :: SentimentFilter -> NonEmpty SentimentValue
sentiments} -> NonEmpty SentimentValue
sentiments) (\s :: SentimentFilter
s@SentimentFilter' {} NonEmpty SentimentValue
a -> SentimentFilter
s {$sel:sentiments:SentimentFilter' :: NonEmpty SentimentValue
sentiments = NonEmpty SentimentValue
a} :: SentimentFilter) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON SentimentFilter where
  parseJSON :: Value -> Parser SentimentFilter
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SentimentFilter"
      ( \Object
x ->
          Maybe AbsoluteTimeRange
-> Maybe Bool
-> Maybe ParticipantRole
-> Maybe RelativeTimeRange
-> NonEmpty SentimentValue
-> SentimentFilter
SentimentFilter'
            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
"AbsoluteTimeRange")
            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
"Negate")
            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
"ParticipantRole")
            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
"RelativeTimeRange")
            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
"Sentiments")
      )

instance Prelude.Hashable SentimentFilter where
  hashWithSalt :: Int -> SentimentFilter -> Int
hashWithSalt Int
_salt SentimentFilter' {Maybe Bool
Maybe AbsoluteTimeRange
Maybe ParticipantRole
Maybe RelativeTimeRange
NonEmpty SentimentValue
sentiments :: NonEmpty SentimentValue
relativeTimeRange :: Maybe RelativeTimeRange
participantRole :: Maybe ParticipantRole
negate :: Maybe Bool
absoluteTimeRange :: Maybe AbsoluteTimeRange
$sel:sentiments:SentimentFilter' :: SentimentFilter -> NonEmpty SentimentValue
$sel:relativeTimeRange:SentimentFilter' :: SentimentFilter -> Maybe RelativeTimeRange
$sel:participantRole:SentimentFilter' :: SentimentFilter -> Maybe ParticipantRole
$sel:negate:SentimentFilter' :: SentimentFilter -> Maybe Bool
$sel:absoluteTimeRange:SentimentFilter' :: SentimentFilter -> Maybe AbsoluteTimeRange
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AbsoluteTimeRange
absoluteTimeRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
negate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ParticipantRole
participantRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RelativeTimeRange
relativeTimeRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty SentimentValue
sentiments

instance Prelude.NFData SentimentFilter where
  rnf :: SentimentFilter -> ()
rnf SentimentFilter' {Maybe Bool
Maybe AbsoluteTimeRange
Maybe ParticipantRole
Maybe RelativeTimeRange
NonEmpty SentimentValue
sentiments :: NonEmpty SentimentValue
relativeTimeRange :: Maybe RelativeTimeRange
participantRole :: Maybe ParticipantRole
negate :: Maybe Bool
absoluteTimeRange :: Maybe AbsoluteTimeRange
$sel:sentiments:SentimentFilter' :: SentimentFilter -> NonEmpty SentimentValue
$sel:relativeTimeRange:SentimentFilter' :: SentimentFilter -> Maybe RelativeTimeRange
$sel:participantRole:SentimentFilter' :: SentimentFilter -> Maybe ParticipantRole
$sel:negate:SentimentFilter' :: SentimentFilter -> Maybe Bool
$sel:absoluteTimeRange:SentimentFilter' :: SentimentFilter -> Maybe AbsoluteTimeRange
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AbsoluteTimeRange
absoluteTimeRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
negate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ParticipantRole
participantRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RelativeTimeRange
relativeTimeRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty SentimentValue
sentiments

instance Data.ToJSON SentimentFilter where
  toJSON :: SentimentFilter -> Value
toJSON SentimentFilter' {Maybe Bool
Maybe AbsoluteTimeRange
Maybe ParticipantRole
Maybe RelativeTimeRange
NonEmpty SentimentValue
sentiments :: NonEmpty SentimentValue
relativeTimeRange :: Maybe RelativeTimeRange
participantRole :: Maybe ParticipantRole
negate :: Maybe Bool
absoluteTimeRange :: Maybe AbsoluteTimeRange
$sel:sentiments:SentimentFilter' :: SentimentFilter -> NonEmpty SentimentValue
$sel:relativeTimeRange:SentimentFilter' :: SentimentFilter -> Maybe RelativeTimeRange
$sel:participantRole:SentimentFilter' :: SentimentFilter -> Maybe ParticipantRole
$sel:negate:SentimentFilter' :: SentimentFilter -> Maybe Bool
$sel:absoluteTimeRange:SentimentFilter' :: SentimentFilter -> Maybe AbsoluteTimeRange
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AbsoluteTimeRange" 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 AbsoluteTimeRange
absoluteTimeRange,
            (Key
"Negate" 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 Bool
negate,
            (Key
"ParticipantRole" 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 ParticipantRole
participantRole,
            (Key
"RelativeTimeRange" 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 RelativeTimeRange
relativeTimeRange,
            forall a. a -> Maybe a
Prelude.Just (Key
"Sentiments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty SentimentValue
sentiments)
          ]
      )