{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Comprehend.DetectSentiment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Inspects text and returns an inference of the prevailing sentiment
-- (@POSITIVE@, @NEUTRAL@, @MIXED@, or @NEGATIVE@).
module Amazonka.Comprehend.DetectSentiment
  ( -- * Creating a Request
    DetectSentiment (..),
    newDetectSentiment,

    -- * Request Lenses
    detectSentiment_text,
    detectSentiment_languageCode,

    -- * Destructuring the Response
    DetectSentimentResponse (..),
    newDetectSentimentResponse,

    -- * Response Lenses
    detectSentimentResponse_sentiment,
    detectSentimentResponse_sentimentScore,
    detectSentimentResponse_httpStatus,
  )
where

import Amazonka.Comprehend.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDetectSentiment' smart constructor.
data DetectSentiment = DetectSentiment'
  { -- | A UTF-8 text string. The maximum string size is 5 KB.
    --
    -- Amazon Comprehend performs real-time sentiment analysis on the first 500
    -- characters of the input text and ignores any additional text in the
    -- input.
    DetectSentiment -> Sensitive Text
text :: Data.Sensitive Prelude.Text,
    -- | The language of the input documents. You can specify any of the primary
    -- languages supported by Amazon Comprehend. All documents must be in the
    -- same language.
    DetectSentiment -> LanguageCode
languageCode :: LanguageCode
  }
  deriving (DetectSentiment -> DetectSentiment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectSentiment -> DetectSentiment -> Bool
$c/= :: DetectSentiment -> DetectSentiment -> Bool
== :: DetectSentiment -> DetectSentiment -> Bool
$c== :: DetectSentiment -> DetectSentiment -> Bool
Prelude.Eq, Int -> DetectSentiment -> ShowS
[DetectSentiment] -> ShowS
DetectSentiment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectSentiment] -> ShowS
$cshowList :: [DetectSentiment] -> ShowS
show :: DetectSentiment -> String
$cshow :: DetectSentiment -> String
showsPrec :: Int -> DetectSentiment -> ShowS
$cshowsPrec :: Int -> DetectSentiment -> ShowS
Prelude.Show, forall x. Rep DetectSentiment x -> DetectSentiment
forall x. DetectSentiment -> Rep DetectSentiment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectSentiment x -> DetectSentiment
$cfrom :: forall x. DetectSentiment -> Rep DetectSentiment x
Prelude.Generic)

-- |
-- Create a value of 'DetectSentiment' 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:
--
-- 'text', 'detectSentiment_text' - A UTF-8 text string. The maximum string size is 5 KB.
--
-- Amazon Comprehend performs real-time sentiment analysis on the first 500
-- characters of the input text and ignores any additional text in the
-- input.
--
-- 'languageCode', 'detectSentiment_languageCode' - The language of the input documents. You can specify any of the primary
-- languages supported by Amazon Comprehend. All documents must be in the
-- same language.
newDetectSentiment ::
  -- | 'text'
  Prelude.Text ->
  -- | 'languageCode'
  LanguageCode ->
  DetectSentiment
newDetectSentiment :: Text -> LanguageCode -> DetectSentiment
newDetectSentiment Text
pText_ LanguageCode
pLanguageCode_ =
  DetectSentiment'
    { $sel:text:DetectSentiment' :: Sensitive Text
text =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pText_,
      $sel:languageCode:DetectSentiment' :: LanguageCode
languageCode = LanguageCode
pLanguageCode_
    }

-- | A UTF-8 text string. The maximum string size is 5 KB.
--
-- Amazon Comprehend performs real-time sentiment analysis on the first 500
-- characters of the input text and ignores any additional text in the
-- input.
detectSentiment_text :: Lens.Lens' DetectSentiment Prelude.Text
detectSentiment_text :: Lens' DetectSentiment Text
detectSentiment_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSentiment' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectSentiment' :: DetectSentiment -> Sensitive Text
text} -> Sensitive Text
text) (\s :: DetectSentiment
s@DetectSentiment' {} Sensitive Text
a -> DetectSentiment
s {$sel:text:DetectSentiment' :: Sensitive Text
text = Sensitive Text
a} :: DetectSentiment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The language of the input documents. You can specify any of the primary
-- languages supported by Amazon Comprehend. All documents must be in the
-- same language.
detectSentiment_languageCode :: Lens.Lens' DetectSentiment LanguageCode
detectSentiment_languageCode :: Lens' DetectSentiment LanguageCode
detectSentiment_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSentiment' {LanguageCode
languageCode :: LanguageCode
$sel:languageCode:DetectSentiment' :: DetectSentiment -> LanguageCode
languageCode} -> LanguageCode
languageCode) (\s :: DetectSentiment
s@DetectSentiment' {} LanguageCode
a -> DetectSentiment
s {$sel:languageCode:DetectSentiment' :: LanguageCode
languageCode = LanguageCode
a} :: DetectSentiment)

instance Core.AWSRequest DetectSentiment where
  type
    AWSResponse DetectSentiment =
      DetectSentimentResponse
  request :: (Service -> Service) -> DetectSentiment -> Request DetectSentiment
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DetectSentiment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetectSentiment)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe SentimentType
-> Maybe SentimentScore -> Int -> DetectSentimentResponse
DetectSentimentResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Sentiment")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SentimentScore")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DetectSentiment where
  hashWithSalt :: Int -> DetectSentiment -> Int
hashWithSalt Int
_salt DetectSentiment' {Sensitive Text
LanguageCode
languageCode :: LanguageCode
text :: Sensitive Text
$sel:languageCode:DetectSentiment' :: DetectSentiment -> LanguageCode
$sel:text:DetectSentiment' :: DetectSentiment -> Sensitive Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
text
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LanguageCode
languageCode

instance Prelude.NFData DetectSentiment where
  rnf :: DetectSentiment -> ()
rnf DetectSentiment' {Sensitive Text
LanguageCode
languageCode :: LanguageCode
text :: Sensitive Text
$sel:languageCode:DetectSentiment' :: DetectSentiment -> LanguageCode
$sel:text:DetectSentiment' :: DetectSentiment -> Sensitive Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
text
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LanguageCode
languageCode

instance Data.ToHeaders DetectSentiment where
  toHeaders :: DetectSentiment -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Comprehend_20171127.DetectSentiment" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DetectSentiment where
  toJSON :: DetectSentiment -> Value
toJSON DetectSentiment' {Sensitive Text
LanguageCode
languageCode :: LanguageCode
text :: Sensitive Text
$sel:languageCode:DetectSentiment' :: DetectSentiment -> LanguageCode
$sel:text:DetectSentiment' :: DetectSentiment -> Sensitive Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
text),
            forall a. a -> Maybe a
Prelude.Just (Key
"LanguageCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LanguageCode
languageCode)
          ]
      )

instance Data.ToPath DetectSentiment where
  toPath :: DetectSentiment -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery DetectSentiment where
  toQuery :: DetectSentiment -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDetectSentimentResponse' smart constructor.
data DetectSentimentResponse = DetectSentimentResponse'
  { -- | The inferred sentiment that Amazon Comprehend has the highest level of
    -- confidence in.
    DetectSentimentResponse -> Maybe SentimentType
sentiment :: Prelude.Maybe SentimentType,
    -- | An object that lists the sentiments, and their corresponding confidence
    -- levels.
    DetectSentimentResponse -> Maybe SentimentScore
sentimentScore :: Prelude.Maybe SentimentScore,
    -- | The response's http status code.
    DetectSentimentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectSentimentResponse -> DetectSentimentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectSentimentResponse -> DetectSentimentResponse -> Bool
$c/= :: DetectSentimentResponse -> DetectSentimentResponse -> Bool
== :: DetectSentimentResponse -> DetectSentimentResponse -> Bool
$c== :: DetectSentimentResponse -> DetectSentimentResponse -> Bool
Prelude.Eq, Int -> DetectSentimentResponse -> ShowS
[DetectSentimentResponse] -> ShowS
DetectSentimentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectSentimentResponse] -> ShowS
$cshowList :: [DetectSentimentResponse] -> ShowS
show :: DetectSentimentResponse -> String
$cshow :: DetectSentimentResponse -> String
showsPrec :: Int -> DetectSentimentResponse -> ShowS
$cshowsPrec :: Int -> DetectSentimentResponse -> ShowS
Prelude.Show, forall x. Rep DetectSentimentResponse x -> DetectSentimentResponse
forall x. DetectSentimentResponse -> Rep DetectSentimentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectSentimentResponse x -> DetectSentimentResponse
$cfrom :: forall x. DetectSentimentResponse -> Rep DetectSentimentResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectSentimentResponse' 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:
--
-- 'sentiment', 'detectSentimentResponse_sentiment' - The inferred sentiment that Amazon Comprehend has the highest level of
-- confidence in.
--
-- 'sentimentScore', 'detectSentimentResponse_sentimentScore' - An object that lists the sentiments, and their corresponding confidence
-- levels.
--
-- 'httpStatus', 'detectSentimentResponse_httpStatus' - The response's http status code.
newDetectSentimentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectSentimentResponse
newDetectSentimentResponse :: Int -> DetectSentimentResponse
newDetectSentimentResponse Int
pHttpStatus_ =
  DetectSentimentResponse'
    { $sel:sentiment:DetectSentimentResponse' :: Maybe SentimentType
sentiment =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sentimentScore:DetectSentimentResponse' :: Maybe SentimentScore
sentimentScore = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectSentimentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The inferred sentiment that Amazon Comprehend has the highest level of
-- confidence in.
detectSentimentResponse_sentiment :: Lens.Lens' DetectSentimentResponse (Prelude.Maybe SentimentType)
detectSentimentResponse_sentiment :: Lens' DetectSentimentResponse (Maybe SentimentType)
detectSentimentResponse_sentiment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSentimentResponse' {Maybe SentimentType
sentiment :: Maybe SentimentType
$sel:sentiment:DetectSentimentResponse' :: DetectSentimentResponse -> Maybe SentimentType
sentiment} -> Maybe SentimentType
sentiment) (\s :: DetectSentimentResponse
s@DetectSentimentResponse' {} Maybe SentimentType
a -> DetectSentimentResponse
s {$sel:sentiment:DetectSentimentResponse' :: Maybe SentimentType
sentiment = Maybe SentimentType
a} :: DetectSentimentResponse)

-- | An object that lists the sentiments, and their corresponding confidence
-- levels.
detectSentimentResponse_sentimentScore :: Lens.Lens' DetectSentimentResponse (Prelude.Maybe SentimentScore)
detectSentimentResponse_sentimentScore :: Lens' DetectSentimentResponse (Maybe SentimentScore)
detectSentimentResponse_sentimentScore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSentimentResponse' {Maybe SentimentScore
sentimentScore :: Maybe SentimentScore
$sel:sentimentScore:DetectSentimentResponse' :: DetectSentimentResponse -> Maybe SentimentScore
sentimentScore} -> Maybe SentimentScore
sentimentScore) (\s :: DetectSentimentResponse
s@DetectSentimentResponse' {} Maybe SentimentScore
a -> DetectSentimentResponse
s {$sel:sentimentScore:DetectSentimentResponse' :: Maybe SentimentScore
sentimentScore = Maybe SentimentScore
a} :: DetectSentimentResponse)

-- | The response's http status code.
detectSentimentResponse_httpStatus :: Lens.Lens' DetectSentimentResponse Prelude.Int
detectSentimentResponse_httpStatus :: Lens' DetectSentimentResponse Int
detectSentimentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSentimentResponse' {Int
httpStatus :: Int
$sel:httpStatus:DetectSentimentResponse' :: DetectSentimentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DetectSentimentResponse
s@DetectSentimentResponse' {} Int
a -> DetectSentimentResponse
s {$sel:httpStatus:DetectSentimentResponse' :: Int
httpStatus = Int
a} :: DetectSentimentResponse)

instance Prelude.NFData DetectSentimentResponse where
  rnf :: DetectSentimentResponse -> ()
rnf DetectSentimentResponse' {Int
Maybe SentimentScore
Maybe SentimentType
httpStatus :: Int
sentimentScore :: Maybe SentimentScore
sentiment :: Maybe SentimentType
$sel:httpStatus:DetectSentimentResponse' :: DetectSentimentResponse -> Int
$sel:sentimentScore:DetectSentimentResponse' :: DetectSentimentResponse -> Maybe SentimentScore
$sel:sentiment:DetectSentimentResponse' :: DetectSentimentResponse -> Maybe SentimentType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SentimentType
sentiment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SentimentScore
sentimentScore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus