{-# 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.DescribeDominantLanguageDetectionJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the properties associated with a dominant language detection job.
-- Use this operation to get the status of a detection job.
module Amazonka.Comprehend.DescribeDominantLanguageDetectionJob
  ( -- * Creating a Request
    DescribeDominantLanguageDetectionJob (..),
    newDescribeDominantLanguageDetectionJob,

    -- * Request Lenses
    describeDominantLanguageDetectionJob_jobId,

    -- * Destructuring the Response
    DescribeDominantLanguageDetectionJobResponse (..),
    newDescribeDominantLanguageDetectionJobResponse,

    -- * Response Lenses
    describeDominantLanguageDetectionJobResponse_dominantLanguageDetectionJobProperties,
    describeDominantLanguageDetectionJobResponse_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:/ 'newDescribeDominantLanguageDetectionJob' smart constructor.
data DescribeDominantLanguageDetectionJob = DescribeDominantLanguageDetectionJob'
  { -- | The identifier that Amazon Comprehend generated for the job. The
    -- operation returns this identifier in its response.
    DescribeDominantLanguageDetectionJob -> Text
jobId :: Prelude.Text
  }
  deriving (DescribeDominantLanguageDetectionJob
-> DescribeDominantLanguageDetectionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDominantLanguageDetectionJob
-> DescribeDominantLanguageDetectionJob -> Bool
$c/= :: DescribeDominantLanguageDetectionJob
-> DescribeDominantLanguageDetectionJob -> Bool
== :: DescribeDominantLanguageDetectionJob
-> DescribeDominantLanguageDetectionJob -> Bool
$c== :: DescribeDominantLanguageDetectionJob
-> DescribeDominantLanguageDetectionJob -> Bool
Prelude.Eq, ReadPrec [DescribeDominantLanguageDetectionJob]
ReadPrec DescribeDominantLanguageDetectionJob
Int -> ReadS DescribeDominantLanguageDetectionJob
ReadS [DescribeDominantLanguageDetectionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDominantLanguageDetectionJob]
$creadListPrec :: ReadPrec [DescribeDominantLanguageDetectionJob]
readPrec :: ReadPrec DescribeDominantLanguageDetectionJob
$creadPrec :: ReadPrec DescribeDominantLanguageDetectionJob
readList :: ReadS [DescribeDominantLanguageDetectionJob]
$creadList :: ReadS [DescribeDominantLanguageDetectionJob]
readsPrec :: Int -> ReadS DescribeDominantLanguageDetectionJob
$creadsPrec :: Int -> ReadS DescribeDominantLanguageDetectionJob
Prelude.Read, Int -> DescribeDominantLanguageDetectionJob -> ShowS
[DescribeDominantLanguageDetectionJob] -> ShowS
DescribeDominantLanguageDetectionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDominantLanguageDetectionJob] -> ShowS
$cshowList :: [DescribeDominantLanguageDetectionJob] -> ShowS
show :: DescribeDominantLanguageDetectionJob -> String
$cshow :: DescribeDominantLanguageDetectionJob -> String
showsPrec :: Int -> DescribeDominantLanguageDetectionJob -> ShowS
$cshowsPrec :: Int -> DescribeDominantLanguageDetectionJob -> ShowS
Prelude.Show, forall x.
Rep DescribeDominantLanguageDetectionJob x
-> DescribeDominantLanguageDetectionJob
forall x.
DescribeDominantLanguageDetectionJob
-> Rep DescribeDominantLanguageDetectionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDominantLanguageDetectionJob x
-> DescribeDominantLanguageDetectionJob
$cfrom :: forall x.
DescribeDominantLanguageDetectionJob
-> Rep DescribeDominantLanguageDetectionJob x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDominantLanguageDetectionJob' 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:
--
-- 'jobId', 'describeDominantLanguageDetectionJob_jobId' - The identifier that Amazon Comprehend generated for the job. The
-- operation returns this identifier in its response.
newDescribeDominantLanguageDetectionJob ::
  -- | 'jobId'
  Prelude.Text ->
  DescribeDominantLanguageDetectionJob
newDescribeDominantLanguageDetectionJob :: Text -> DescribeDominantLanguageDetectionJob
newDescribeDominantLanguageDetectionJob Text
pJobId_ =
  DescribeDominantLanguageDetectionJob'
    { $sel:jobId:DescribeDominantLanguageDetectionJob' :: Text
jobId =
        Text
pJobId_
    }

-- | The identifier that Amazon Comprehend generated for the job. The
-- operation returns this identifier in its response.
describeDominantLanguageDetectionJob_jobId :: Lens.Lens' DescribeDominantLanguageDetectionJob Prelude.Text
describeDominantLanguageDetectionJob_jobId :: Lens' DescribeDominantLanguageDetectionJob Text
describeDominantLanguageDetectionJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDominantLanguageDetectionJob' {Text
jobId :: Text
$sel:jobId:DescribeDominantLanguageDetectionJob' :: DescribeDominantLanguageDetectionJob -> Text
jobId} -> Text
jobId) (\s :: DescribeDominantLanguageDetectionJob
s@DescribeDominantLanguageDetectionJob' {} Text
a -> DescribeDominantLanguageDetectionJob
s {$sel:jobId:DescribeDominantLanguageDetectionJob' :: Text
jobId = Text
a} :: DescribeDominantLanguageDetectionJob)

instance
  Core.AWSRequest
    DescribeDominantLanguageDetectionJob
  where
  type
    AWSResponse DescribeDominantLanguageDetectionJob =
      DescribeDominantLanguageDetectionJobResponse
  request :: (Service -> Service)
-> DescribeDominantLanguageDetectionJob
-> Request DescribeDominantLanguageDetectionJob
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 DescribeDominantLanguageDetectionJob
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DescribeDominantLanguageDetectionJob)))
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 DominantLanguageDetectionJobProperties
-> Int -> DescribeDominantLanguageDetectionJobResponse
DescribeDominantLanguageDetectionJobResponse'
            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
"DominantLanguageDetectionJobProperties")
            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
    DescribeDominantLanguageDetectionJob
  where
  hashWithSalt :: Int -> DescribeDominantLanguageDetectionJob -> Int
hashWithSalt
    Int
_salt
    DescribeDominantLanguageDetectionJob' {Text
jobId :: Text
$sel:jobId:DescribeDominantLanguageDetectionJob' :: DescribeDominantLanguageDetectionJob -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

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

instance
  Data.ToHeaders
    DescribeDominantLanguageDetectionJob
  where
  toHeaders :: DescribeDominantLanguageDetectionJob -> 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.DescribeDominantLanguageDetectionJob" ::
                          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
    DescribeDominantLanguageDetectionJob
  where
  toJSON :: DescribeDominantLanguageDetectionJob -> Value
toJSON DescribeDominantLanguageDetectionJob' {Text
jobId :: Text
$sel:jobId:DescribeDominantLanguageDetectionJob' :: DescribeDominantLanguageDetectionJob -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"JobId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobId)]
      )

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

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

-- | /See:/ 'newDescribeDominantLanguageDetectionJobResponse' smart constructor.
data DescribeDominantLanguageDetectionJobResponse = DescribeDominantLanguageDetectionJobResponse'
  { -- | An object that contains the properties associated with a dominant
    -- language detection job.
    DescribeDominantLanguageDetectionJobResponse
-> Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties :: Prelude.Maybe DominantLanguageDetectionJobProperties,
    -- | The response's http status code.
    DescribeDominantLanguageDetectionJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDominantLanguageDetectionJobResponse
-> DescribeDominantLanguageDetectionJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDominantLanguageDetectionJobResponse
-> DescribeDominantLanguageDetectionJobResponse -> Bool
$c/= :: DescribeDominantLanguageDetectionJobResponse
-> DescribeDominantLanguageDetectionJobResponse -> Bool
== :: DescribeDominantLanguageDetectionJobResponse
-> DescribeDominantLanguageDetectionJobResponse -> Bool
$c== :: DescribeDominantLanguageDetectionJobResponse
-> DescribeDominantLanguageDetectionJobResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDominantLanguageDetectionJobResponse]
ReadPrec DescribeDominantLanguageDetectionJobResponse
Int -> ReadS DescribeDominantLanguageDetectionJobResponse
ReadS [DescribeDominantLanguageDetectionJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDominantLanguageDetectionJobResponse]
$creadListPrec :: ReadPrec [DescribeDominantLanguageDetectionJobResponse]
readPrec :: ReadPrec DescribeDominantLanguageDetectionJobResponse
$creadPrec :: ReadPrec DescribeDominantLanguageDetectionJobResponse
readList :: ReadS [DescribeDominantLanguageDetectionJobResponse]
$creadList :: ReadS [DescribeDominantLanguageDetectionJobResponse]
readsPrec :: Int -> ReadS DescribeDominantLanguageDetectionJobResponse
$creadsPrec :: Int -> ReadS DescribeDominantLanguageDetectionJobResponse
Prelude.Read, Int -> DescribeDominantLanguageDetectionJobResponse -> ShowS
[DescribeDominantLanguageDetectionJobResponse] -> ShowS
DescribeDominantLanguageDetectionJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDominantLanguageDetectionJobResponse] -> ShowS
$cshowList :: [DescribeDominantLanguageDetectionJobResponse] -> ShowS
show :: DescribeDominantLanguageDetectionJobResponse -> String
$cshow :: DescribeDominantLanguageDetectionJobResponse -> String
showsPrec :: Int -> DescribeDominantLanguageDetectionJobResponse -> ShowS
$cshowsPrec :: Int -> DescribeDominantLanguageDetectionJobResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDominantLanguageDetectionJobResponse x
-> DescribeDominantLanguageDetectionJobResponse
forall x.
DescribeDominantLanguageDetectionJobResponse
-> Rep DescribeDominantLanguageDetectionJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDominantLanguageDetectionJobResponse x
-> DescribeDominantLanguageDetectionJobResponse
$cfrom :: forall x.
DescribeDominantLanguageDetectionJobResponse
-> Rep DescribeDominantLanguageDetectionJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDominantLanguageDetectionJobResponse' 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:
--
-- 'dominantLanguageDetectionJobProperties', 'describeDominantLanguageDetectionJobResponse_dominantLanguageDetectionJobProperties' - An object that contains the properties associated with a dominant
-- language detection job.
--
-- 'httpStatus', 'describeDominantLanguageDetectionJobResponse_httpStatus' - The response's http status code.
newDescribeDominantLanguageDetectionJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDominantLanguageDetectionJobResponse
newDescribeDominantLanguageDetectionJobResponse :: Int -> DescribeDominantLanguageDetectionJobResponse
newDescribeDominantLanguageDetectionJobResponse
  Int
pHttpStatus_ =
    DescribeDominantLanguageDetectionJobResponse'
      { $sel:dominantLanguageDetectionJobProperties:DescribeDominantLanguageDetectionJobResponse' :: Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeDominantLanguageDetectionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | An object that contains the properties associated with a dominant
-- language detection job.
describeDominantLanguageDetectionJobResponse_dominantLanguageDetectionJobProperties :: Lens.Lens' DescribeDominantLanguageDetectionJobResponse (Prelude.Maybe DominantLanguageDetectionJobProperties)
describeDominantLanguageDetectionJobResponse_dominantLanguageDetectionJobProperties :: Lens'
  DescribeDominantLanguageDetectionJobResponse
  (Maybe DominantLanguageDetectionJobProperties)
describeDominantLanguageDetectionJobResponse_dominantLanguageDetectionJobProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDominantLanguageDetectionJobResponse' {Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties :: Maybe DominantLanguageDetectionJobProperties
$sel:dominantLanguageDetectionJobProperties:DescribeDominantLanguageDetectionJobResponse' :: DescribeDominantLanguageDetectionJobResponse
-> Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties} -> Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties) (\s :: DescribeDominantLanguageDetectionJobResponse
s@DescribeDominantLanguageDetectionJobResponse' {} Maybe DominantLanguageDetectionJobProperties
a -> DescribeDominantLanguageDetectionJobResponse
s {$sel:dominantLanguageDetectionJobProperties:DescribeDominantLanguageDetectionJobResponse' :: Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties = Maybe DominantLanguageDetectionJobProperties
a} :: DescribeDominantLanguageDetectionJobResponse)

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

instance
  Prelude.NFData
    DescribeDominantLanguageDetectionJobResponse
  where
  rnf :: DescribeDominantLanguageDetectionJobResponse -> ()
rnf DescribeDominantLanguageDetectionJobResponse' {Int
Maybe DominantLanguageDetectionJobProperties
httpStatus :: Int
dominantLanguageDetectionJobProperties :: Maybe DominantLanguageDetectionJobProperties
$sel:httpStatus:DescribeDominantLanguageDetectionJobResponse' :: DescribeDominantLanguageDetectionJobResponse -> Int
$sel:dominantLanguageDetectionJobProperties:DescribeDominantLanguageDetectionJobResponse' :: DescribeDominantLanguageDetectionJobResponse
-> Maybe DominantLanguageDetectionJobProperties
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DominantLanguageDetectionJobProperties
dominantLanguageDetectionJobProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus