{-# 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.DetectKeyPhrases
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detects the key noun phrases found in the text.
module Amazonka.Comprehend.DetectKeyPhrases
  ( -- * Creating a Request
    DetectKeyPhrases (..),
    newDetectKeyPhrases,

    -- * Request Lenses
    detectKeyPhrases_text,
    detectKeyPhrases_languageCode,

    -- * Destructuring the Response
    DetectKeyPhrasesResponse (..),
    newDetectKeyPhrasesResponse,

    -- * Response Lenses
    detectKeyPhrasesResponse_keyPhrases,
    detectKeyPhrasesResponse_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:/ 'newDetectKeyPhrases' smart constructor.
data DetectKeyPhrases = DetectKeyPhrases'
  { -- | A UTF-8 text string. The string must contain less than 100 KB of UTF-8
    -- encoded characters.
    DetectKeyPhrases -> 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.
    DetectKeyPhrases -> LanguageCode
languageCode :: LanguageCode
  }
  deriving (DetectKeyPhrases -> DetectKeyPhrases -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectKeyPhrases -> DetectKeyPhrases -> Bool
$c/= :: DetectKeyPhrases -> DetectKeyPhrases -> Bool
== :: DetectKeyPhrases -> DetectKeyPhrases -> Bool
$c== :: DetectKeyPhrases -> DetectKeyPhrases -> Bool
Prelude.Eq, Int -> DetectKeyPhrases -> ShowS
[DetectKeyPhrases] -> ShowS
DetectKeyPhrases -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectKeyPhrases] -> ShowS
$cshowList :: [DetectKeyPhrases] -> ShowS
show :: DetectKeyPhrases -> String
$cshow :: DetectKeyPhrases -> String
showsPrec :: Int -> DetectKeyPhrases -> ShowS
$cshowsPrec :: Int -> DetectKeyPhrases -> ShowS
Prelude.Show, forall x. Rep DetectKeyPhrases x -> DetectKeyPhrases
forall x. DetectKeyPhrases -> Rep DetectKeyPhrases x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectKeyPhrases x -> DetectKeyPhrases
$cfrom :: forall x. DetectKeyPhrases -> Rep DetectKeyPhrases x
Prelude.Generic)

-- |
-- Create a value of 'DetectKeyPhrases' 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', 'detectKeyPhrases_text' - A UTF-8 text string. The string must contain less than 100 KB of UTF-8
-- encoded characters.
--
-- 'languageCode', 'detectKeyPhrases_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.
newDetectKeyPhrases ::
  -- | 'text'
  Prelude.Text ->
  -- | 'languageCode'
  LanguageCode ->
  DetectKeyPhrases
newDetectKeyPhrases :: Text -> LanguageCode -> DetectKeyPhrases
newDetectKeyPhrases Text
pText_ LanguageCode
pLanguageCode_ =
  DetectKeyPhrases'
    { $sel:text:DetectKeyPhrases' :: Sensitive Text
text =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pText_,
      $sel:languageCode:DetectKeyPhrases' :: LanguageCode
languageCode = LanguageCode
pLanguageCode_
    }

-- | A UTF-8 text string. The string must contain less than 100 KB of UTF-8
-- encoded characters.
detectKeyPhrases_text :: Lens.Lens' DetectKeyPhrases Prelude.Text
detectKeyPhrases_text :: Lens' DetectKeyPhrases Text
detectKeyPhrases_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectKeyPhrases' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectKeyPhrases' :: DetectKeyPhrases -> Sensitive Text
text} -> Sensitive Text
text) (\s :: DetectKeyPhrases
s@DetectKeyPhrases' {} Sensitive Text
a -> DetectKeyPhrases
s {$sel:text:DetectKeyPhrases' :: Sensitive Text
text = Sensitive Text
a} :: DetectKeyPhrases) 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.
detectKeyPhrases_languageCode :: Lens.Lens' DetectKeyPhrases LanguageCode
detectKeyPhrases_languageCode :: Lens' DetectKeyPhrases LanguageCode
detectKeyPhrases_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectKeyPhrases' {LanguageCode
languageCode :: LanguageCode
$sel:languageCode:DetectKeyPhrases' :: DetectKeyPhrases -> LanguageCode
languageCode} -> LanguageCode
languageCode) (\s :: DetectKeyPhrases
s@DetectKeyPhrases' {} LanguageCode
a -> DetectKeyPhrases
s {$sel:languageCode:DetectKeyPhrases' :: LanguageCode
languageCode = LanguageCode
a} :: DetectKeyPhrases)

instance Core.AWSRequest DetectKeyPhrases where
  type
    AWSResponse DetectKeyPhrases =
      DetectKeyPhrasesResponse
  request :: (Service -> Service)
-> DetectKeyPhrases -> Request DetectKeyPhrases
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 DetectKeyPhrases
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetectKeyPhrases)))
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 [KeyPhrase] -> Int -> DetectKeyPhrasesResponse
DetectKeyPhrasesResponse'
            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
"KeyPhrases" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 DetectKeyPhrases where
  hashWithSalt :: Int -> DetectKeyPhrases -> Int
hashWithSalt Int
_salt DetectKeyPhrases' {Sensitive Text
LanguageCode
languageCode :: LanguageCode
text :: Sensitive Text
$sel:languageCode:DetectKeyPhrases' :: DetectKeyPhrases -> LanguageCode
$sel:text:DetectKeyPhrases' :: DetectKeyPhrases -> 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 DetectKeyPhrases where
  rnf :: DetectKeyPhrases -> ()
rnf DetectKeyPhrases' {Sensitive Text
LanguageCode
languageCode :: LanguageCode
text :: Sensitive Text
$sel:languageCode:DetectKeyPhrases' :: DetectKeyPhrases -> LanguageCode
$sel:text:DetectKeyPhrases' :: DetectKeyPhrases -> 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 DetectKeyPhrases where
  toHeaders :: DetectKeyPhrases -> 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.DetectKeyPhrases" ::
                          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 DetectKeyPhrases where
  toJSON :: DetectKeyPhrases -> Value
toJSON DetectKeyPhrases' {Sensitive Text
LanguageCode
languageCode :: LanguageCode
text :: Sensitive Text
$sel:languageCode:DetectKeyPhrases' :: DetectKeyPhrases -> LanguageCode
$sel:text:DetectKeyPhrases' :: DetectKeyPhrases -> 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 DetectKeyPhrases where
  toPath :: DetectKeyPhrases -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDetectKeyPhrasesResponse' smart constructor.
data DetectKeyPhrasesResponse = DetectKeyPhrasesResponse'
  { -- | A collection of key phrases that Amazon Comprehend identified in the
    -- input text. For each key phrase, the response provides the text of the
    -- key phrase, where the key phrase begins and ends, and the level of
    -- confidence that Amazon Comprehend has in the accuracy of the detection.
    DetectKeyPhrasesResponse -> Maybe [KeyPhrase]
keyPhrases :: Prelude.Maybe [KeyPhrase],
    -- | The response's http status code.
    DetectKeyPhrasesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectKeyPhrasesResponse -> DetectKeyPhrasesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectKeyPhrasesResponse -> DetectKeyPhrasesResponse -> Bool
$c/= :: DetectKeyPhrasesResponse -> DetectKeyPhrasesResponse -> Bool
== :: DetectKeyPhrasesResponse -> DetectKeyPhrasesResponse -> Bool
$c== :: DetectKeyPhrasesResponse -> DetectKeyPhrasesResponse -> Bool
Prelude.Eq, Int -> DetectKeyPhrasesResponse -> ShowS
[DetectKeyPhrasesResponse] -> ShowS
DetectKeyPhrasesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectKeyPhrasesResponse] -> ShowS
$cshowList :: [DetectKeyPhrasesResponse] -> ShowS
show :: DetectKeyPhrasesResponse -> String
$cshow :: DetectKeyPhrasesResponse -> String
showsPrec :: Int -> DetectKeyPhrasesResponse -> ShowS
$cshowsPrec :: Int -> DetectKeyPhrasesResponse -> ShowS
Prelude.Show, forall x.
Rep DetectKeyPhrasesResponse x -> DetectKeyPhrasesResponse
forall x.
DetectKeyPhrasesResponse -> Rep DetectKeyPhrasesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DetectKeyPhrasesResponse x -> DetectKeyPhrasesResponse
$cfrom :: forall x.
DetectKeyPhrasesResponse -> Rep DetectKeyPhrasesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectKeyPhrasesResponse' 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:
--
-- 'keyPhrases', 'detectKeyPhrasesResponse_keyPhrases' - A collection of key phrases that Amazon Comprehend identified in the
-- input text. For each key phrase, the response provides the text of the
-- key phrase, where the key phrase begins and ends, and the level of
-- confidence that Amazon Comprehend has in the accuracy of the detection.
--
-- 'httpStatus', 'detectKeyPhrasesResponse_httpStatus' - The response's http status code.
newDetectKeyPhrasesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectKeyPhrasesResponse
newDetectKeyPhrasesResponse :: Int -> DetectKeyPhrasesResponse
newDetectKeyPhrasesResponse Int
pHttpStatus_ =
  DetectKeyPhrasesResponse'
    { $sel:keyPhrases:DetectKeyPhrasesResponse' :: Maybe [KeyPhrase]
keyPhrases =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectKeyPhrasesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A collection of key phrases that Amazon Comprehend identified in the
-- input text. For each key phrase, the response provides the text of the
-- key phrase, where the key phrase begins and ends, and the level of
-- confidence that Amazon Comprehend has in the accuracy of the detection.
detectKeyPhrasesResponse_keyPhrases :: Lens.Lens' DetectKeyPhrasesResponse (Prelude.Maybe [KeyPhrase])
detectKeyPhrasesResponse_keyPhrases :: Lens' DetectKeyPhrasesResponse (Maybe [KeyPhrase])
detectKeyPhrasesResponse_keyPhrases = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectKeyPhrasesResponse' {Maybe [KeyPhrase]
keyPhrases :: Maybe [KeyPhrase]
$sel:keyPhrases:DetectKeyPhrasesResponse' :: DetectKeyPhrasesResponse -> Maybe [KeyPhrase]
keyPhrases} -> Maybe [KeyPhrase]
keyPhrases) (\s :: DetectKeyPhrasesResponse
s@DetectKeyPhrasesResponse' {} Maybe [KeyPhrase]
a -> DetectKeyPhrasesResponse
s {$sel:keyPhrases:DetectKeyPhrasesResponse' :: Maybe [KeyPhrase]
keyPhrases = Maybe [KeyPhrase]
a} :: DetectKeyPhrasesResponse) 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

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

instance Prelude.NFData DetectKeyPhrasesResponse where
  rnf :: DetectKeyPhrasesResponse -> ()
rnf DetectKeyPhrasesResponse' {Int
Maybe [KeyPhrase]
httpStatus :: Int
keyPhrases :: Maybe [KeyPhrase]
$sel:httpStatus:DetectKeyPhrasesResponse' :: DetectKeyPhrasesResponse -> Int
$sel:keyPhrases:DetectKeyPhrasesResponse' :: DetectKeyPhrasesResponse -> Maybe [KeyPhrase]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [KeyPhrase]
keyPhrases
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus