{-# 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.DetectDominantLanguage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Determines the dominant language of the input text. For a list of
-- languages that Amazon Comprehend can detect, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-languages.html Amazon Comprehend Supported Languages>.
module Amazonka.Comprehend.DetectDominantLanguage
  ( -- * Creating a Request
    DetectDominantLanguage (..),
    newDetectDominantLanguage,

    -- * Request Lenses
    detectDominantLanguage_text,

    -- * Destructuring the Response
    DetectDominantLanguageResponse (..),
    newDetectDominantLanguageResponse,

    -- * Response Lenses
    detectDominantLanguageResponse_languages,
    detectDominantLanguageResponse_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:/ 'newDetectDominantLanguage' smart constructor.
data DetectDominantLanguage = DetectDominantLanguage'
  { -- | A UTF-8 text string. The string must contain at least 20 characters. The
    -- maximum string size is 100 KB.
    DetectDominantLanguage -> Sensitive Text
text :: Data.Sensitive Prelude.Text
  }
  deriving (DetectDominantLanguage -> DetectDominantLanguage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectDominantLanguage -> DetectDominantLanguage -> Bool
$c/= :: DetectDominantLanguage -> DetectDominantLanguage -> Bool
== :: DetectDominantLanguage -> DetectDominantLanguage -> Bool
$c== :: DetectDominantLanguage -> DetectDominantLanguage -> Bool
Prelude.Eq, Int -> DetectDominantLanguage -> ShowS
[DetectDominantLanguage] -> ShowS
DetectDominantLanguage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectDominantLanguage] -> ShowS
$cshowList :: [DetectDominantLanguage] -> ShowS
show :: DetectDominantLanguage -> String
$cshow :: DetectDominantLanguage -> String
showsPrec :: Int -> DetectDominantLanguage -> ShowS
$cshowsPrec :: Int -> DetectDominantLanguage -> ShowS
Prelude.Show, forall x. Rep DetectDominantLanguage x -> DetectDominantLanguage
forall x. DetectDominantLanguage -> Rep DetectDominantLanguage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectDominantLanguage x -> DetectDominantLanguage
$cfrom :: forall x. DetectDominantLanguage -> Rep DetectDominantLanguage x
Prelude.Generic)

-- |
-- Create a value of 'DetectDominantLanguage' 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', 'detectDominantLanguage_text' - A UTF-8 text string. The string must contain at least 20 characters. The
-- maximum string size is 100 KB.
newDetectDominantLanguage ::
  -- | 'text'
  Prelude.Text ->
  DetectDominantLanguage
newDetectDominantLanguage :: Text -> DetectDominantLanguage
newDetectDominantLanguage Text
pText_ =
  DetectDominantLanguage'
    { $sel:text:DetectDominantLanguage' :: Sensitive Text
text =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pText_
    }

-- | A UTF-8 text string. The string must contain at least 20 characters. The
-- maximum string size is 100 KB.
detectDominantLanguage_text :: Lens.Lens' DetectDominantLanguage Prelude.Text
detectDominantLanguage_text :: Lens' DetectDominantLanguage Text
detectDominantLanguage_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectDominantLanguage' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectDominantLanguage' :: DetectDominantLanguage -> Sensitive Text
text} -> Sensitive Text
text) (\s :: DetectDominantLanguage
s@DetectDominantLanguage' {} Sensitive Text
a -> DetectDominantLanguage
s {$sel:text:DetectDominantLanguage' :: Sensitive Text
text = Sensitive Text
a} :: DetectDominantLanguage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest DetectDominantLanguage where
  type
    AWSResponse DetectDominantLanguage =
      DetectDominantLanguageResponse
  request :: (Service -> Service)
-> DetectDominantLanguage -> Request DetectDominantLanguage
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 DetectDominantLanguage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DetectDominantLanguage)))
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 [DominantLanguage] -> Int -> DetectDominantLanguageResponse
DetectDominantLanguageResponse'
            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
"Languages" 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 DetectDominantLanguage where
  hashWithSalt :: Int -> DetectDominantLanguage -> Int
hashWithSalt Int
_salt DetectDominantLanguage' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectDominantLanguage' :: DetectDominantLanguage -> Sensitive Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
text

instance Prelude.NFData DetectDominantLanguage where
  rnf :: DetectDominantLanguage -> ()
rnf DetectDominantLanguage' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectDominantLanguage' :: DetectDominantLanguage -> Sensitive Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
text

instance Data.ToHeaders DetectDominantLanguage where
  toHeaders :: DetectDominantLanguage -> 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.DetectDominantLanguage" ::
                          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 DetectDominantLanguage where
  toJSON :: DetectDominantLanguage -> Value
toJSON DetectDominantLanguage' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectDominantLanguage' :: DetectDominantLanguage -> 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)]
      )

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

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

-- | /See:/ 'newDetectDominantLanguageResponse' smart constructor.
data DetectDominantLanguageResponse = DetectDominantLanguageResponse'
  { -- | The languages that Amazon Comprehend detected in the input text. For
    -- each language, the response returns the RFC 5646 language code and the
    -- level of confidence that Amazon Comprehend has in the accuracy of its
    -- inference. For more information about RFC 5646, see
    -- <https://tools.ietf.org/html/rfc5646 Tags for Identifying Languages> on
    -- the /IETF Tools/ web site.
    DetectDominantLanguageResponse -> Maybe [DominantLanguage]
languages :: Prelude.Maybe [DominantLanguage],
    -- | The response's http status code.
    DetectDominantLanguageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectDominantLanguageResponse
-> DetectDominantLanguageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectDominantLanguageResponse
-> DetectDominantLanguageResponse -> Bool
$c/= :: DetectDominantLanguageResponse
-> DetectDominantLanguageResponse -> Bool
== :: DetectDominantLanguageResponse
-> DetectDominantLanguageResponse -> Bool
$c== :: DetectDominantLanguageResponse
-> DetectDominantLanguageResponse -> Bool
Prelude.Eq, Int -> DetectDominantLanguageResponse -> ShowS
[DetectDominantLanguageResponse] -> ShowS
DetectDominantLanguageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectDominantLanguageResponse] -> ShowS
$cshowList :: [DetectDominantLanguageResponse] -> ShowS
show :: DetectDominantLanguageResponse -> String
$cshow :: DetectDominantLanguageResponse -> String
showsPrec :: Int -> DetectDominantLanguageResponse -> ShowS
$cshowsPrec :: Int -> DetectDominantLanguageResponse -> ShowS
Prelude.Show, forall x.
Rep DetectDominantLanguageResponse x
-> DetectDominantLanguageResponse
forall x.
DetectDominantLanguageResponse
-> Rep DetectDominantLanguageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DetectDominantLanguageResponse x
-> DetectDominantLanguageResponse
$cfrom :: forall x.
DetectDominantLanguageResponse
-> Rep DetectDominantLanguageResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectDominantLanguageResponse' 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:
--
-- 'languages', 'detectDominantLanguageResponse_languages' - The languages that Amazon Comprehend detected in the input text. For
-- each language, the response returns the RFC 5646 language code and the
-- level of confidence that Amazon Comprehend has in the accuracy of its
-- inference. For more information about RFC 5646, see
-- <https://tools.ietf.org/html/rfc5646 Tags for Identifying Languages> on
-- the /IETF Tools/ web site.
--
-- 'httpStatus', 'detectDominantLanguageResponse_httpStatus' - The response's http status code.
newDetectDominantLanguageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectDominantLanguageResponse
newDetectDominantLanguageResponse :: Int -> DetectDominantLanguageResponse
newDetectDominantLanguageResponse Int
pHttpStatus_ =
  DetectDominantLanguageResponse'
    { $sel:languages:DetectDominantLanguageResponse' :: Maybe [DominantLanguage]
languages =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectDominantLanguageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The languages that Amazon Comprehend detected in the input text. For
-- each language, the response returns the RFC 5646 language code and the
-- level of confidence that Amazon Comprehend has in the accuracy of its
-- inference. For more information about RFC 5646, see
-- <https://tools.ietf.org/html/rfc5646 Tags for Identifying Languages> on
-- the /IETF Tools/ web site.
detectDominantLanguageResponse_languages :: Lens.Lens' DetectDominantLanguageResponse (Prelude.Maybe [DominantLanguage])
detectDominantLanguageResponse_languages :: Lens' DetectDominantLanguageResponse (Maybe [DominantLanguage])
detectDominantLanguageResponse_languages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectDominantLanguageResponse' {Maybe [DominantLanguage]
languages :: Maybe [DominantLanguage]
$sel:languages:DetectDominantLanguageResponse' :: DetectDominantLanguageResponse -> Maybe [DominantLanguage]
languages} -> Maybe [DominantLanguage]
languages) (\s :: DetectDominantLanguageResponse
s@DetectDominantLanguageResponse' {} Maybe [DominantLanguage]
a -> DetectDominantLanguageResponse
s {$sel:languages:DetectDominantLanguageResponse' :: Maybe [DominantLanguage]
languages = Maybe [DominantLanguage]
a} :: DetectDominantLanguageResponse) 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.
detectDominantLanguageResponse_httpStatus :: Lens.Lens' DetectDominantLanguageResponse Prelude.Int
detectDominantLanguageResponse_httpStatus :: Lens' DetectDominantLanguageResponse Int
detectDominantLanguageResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectDominantLanguageResponse' {Int
httpStatus :: Int
$sel:httpStatus:DetectDominantLanguageResponse' :: DetectDominantLanguageResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DetectDominantLanguageResponse
s@DetectDominantLanguageResponse' {} Int
a -> DetectDominantLanguageResponse
s {$sel:httpStatus:DetectDominantLanguageResponse' :: Int
httpStatus = Int
a} :: DetectDominantLanguageResponse)

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