{-# 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.Translate.Types.ParallelDataProperties
-- 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.Translate.Types.ParallelDataProperties 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.Translate.Types.EncryptionKey
import Amazonka.Translate.Types.ParallelDataConfig
import Amazonka.Translate.Types.ParallelDataStatus

-- | The properties of a parallel data resource.
--
-- /See:/ 'newParallelDataProperties' smart constructor.
data ParallelDataProperties = ParallelDataProperties'
  { -- | The Amazon Resource Name (ARN) of the parallel data resource.
    ParallelDataProperties -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time at which the parallel data resource was created.
    ParallelDataProperties -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The description assigned to the parallel data resource.
    ParallelDataProperties -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    ParallelDataProperties -> Maybe EncryptionKey
encryptionKey :: Prelude.Maybe EncryptionKey,
    -- | The number of records unsuccessfully imported from the parallel data
    -- input file.
    ParallelDataProperties -> Maybe Integer
failedRecordCount :: Prelude.Maybe Prelude.Integer,
    -- | The number of UTF-8 characters that Amazon Translate imported from the
    -- parallel data input file. This number includes only the characters in
    -- your translation examples. It does not include characters that are used
    -- to format your file. For example, if you provided a Translation Memory
    -- Exchange (.tmx) file, this number does not include the tags.
    ParallelDataProperties -> Maybe Integer
importedDataSize :: Prelude.Maybe Prelude.Integer,
    -- | The number of records successfully imported from the parallel data input
    -- file.
    ParallelDataProperties -> Maybe Integer
importedRecordCount :: Prelude.Maybe Prelude.Integer,
    -- | The time at which the parallel data resource was last updated.
    ParallelDataProperties -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | The time that the most recent update was attempted.
    ParallelDataProperties -> Maybe POSIX
latestUpdateAttemptAt :: Prelude.Maybe Data.POSIX,
    -- | The status of the most recent update attempt for the parallel data
    -- resource.
    ParallelDataProperties -> Maybe ParallelDataStatus
latestUpdateAttemptStatus :: Prelude.Maybe ParallelDataStatus,
    -- | Additional information from Amazon Translate about the parallel data
    -- resource.
    ParallelDataProperties -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The custom name assigned to the parallel data resource.
    ParallelDataProperties -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Specifies the format and S3 location of the parallel data input file.
    ParallelDataProperties -> Maybe ParallelDataConfig
parallelDataConfig :: Prelude.Maybe ParallelDataConfig,
    -- | The number of items in the input file that Amazon Translate skipped when
    -- you created or updated the parallel data resource. For example, Amazon
    -- Translate skips empty records, empty target texts, and empty lines.
    ParallelDataProperties -> Maybe Integer
skippedRecordCount :: Prelude.Maybe Prelude.Integer,
    -- | The source language of the translations in the parallel data file.
    ParallelDataProperties -> Maybe Text
sourceLanguageCode :: Prelude.Maybe Prelude.Text,
    -- | The status of the parallel data resource. When the parallel data is
    -- ready for you to use, the status is @ACTIVE@.
    ParallelDataProperties -> Maybe ParallelDataStatus
status :: Prelude.Maybe ParallelDataStatus,
    -- | The language codes for the target languages available in the parallel
    -- data file. All possible target languages are returned as an array.
    ParallelDataProperties -> Maybe [Text]
targetLanguageCodes :: Prelude.Maybe [Prelude.Text]
  }
  deriving (ParallelDataProperties -> ParallelDataProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParallelDataProperties -> ParallelDataProperties -> Bool
$c/= :: ParallelDataProperties -> ParallelDataProperties -> Bool
== :: ParallelDataProperties -> ParallelDataProperties -> Bool
$c== :: ParallelDataProperties -> ParallelDataProperties -> Bool
Prelude.Eq, ReadPrec [ParallelDataProperties]
ReadPrec ParallelDataProperties
Int -> ReadS ParallelDataProperties
ReadS [ParallelDataProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParallelDataProperties]
$creadListPrec :: ReadPrec [ParallelDataProperties]
readPrec :: ReadPrec ParallelDataProperties
$creadPrec :: ReadPrec ParallelDataProperties
readList :: ReadS [ParallelDataProperties]
$creadList :: ReadS [ParallelDataProperties]
readsPrec :: Int -> ReadS ParallelDataProperties
$creadsPrec :: Int -> ReadS ParallelDataProperties
Prelude.Read, Int -> ParallelDataProperties -> ShowS
[ParallelDataProperties] -> ShowS
ParallelDataProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParallelDataProperties] -> ShowS
$cshowList :: [ParallelDataProperties] -> ShowS
show :: ParallelDataProperties -> String
$cshow :: ParallelDataProperties -> String
showsPrec :: Int -> ParallelDataProperties -> ShowS
$cshowsPrec :: Int -> ParallelDataProperties -> ShowS
Prelude.Show, forall x. Rep ParallelDataProperties x -> ParallelDataProperties
forall x. ParallelDataProperties -> Rep ParallelDataProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParallelDataProperties x -> ParallelDataProperties
$cfrom :: forall x. ParallelDataProperties -> Rep ParallelDataProperties x
Prelude.Generic)

-- |
-- Create a value of 'ParallelDataProperties' 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:
--
-- 'arn', 'parallelDataProperties_arn' - The Amazon Resource Name (ARN) of the parallel data resource.
--
-- 'createdAt', 'parallelDataProperties_createdAt' - The time at which the parallel data resource was created.
--
-- 'description', 'parallelDataProperties_description' - The description assigned to the parallel data resource.
--
-- 'encryptionKey', 'parallelDataProperties_encryptionKey' - Undocumented member.
--
-- 'failedRecordCount', 'parallelDataProperties_failedRecordCount' - The number of records unsuccessfully imported from the parallel data
-- input file.
--
-- 'importedDataSize', 'parallelDataProperties_importedDataSize' - The number of UTF-8 characters that Amazon Translate imported from the
-- parallel data input file. This number includes only the characters in
-- your translation examples. It does not include characters that are used
-- to format your file. For example, if you provided a Translation Memory
-- Exchange (.tmx) file, this number does not include the tags.
--
-- 'importedRecordCount', 'parallelDataProperties_importedRecordCount' - The number of records successfully imported from the parallel data input
-- file.
--
-- 'lastUpdatedAt', 'parallelDataProperties_lastUpdatedAt' - The time at which the parallel data resource was last updated.
--
-- 'latestUpdateAttemptAt', 'parallelDataProperties_latestUpdateAttemptAt' - The time that the most recent update was attempted.
--
-- 'latestUpdateAttemptStatus', 'parallelDataProperties_latestUpdateAttemptStatus' - The status of the most recent update attempt for the parallel data
-- resource.
--
-- 'message', 'parallelDataProperties_message' - Additional information from Amazon Translate about the parallel data
-- resource.
--
-- 'name', 'parallelDataProperties_name' - The custom name assigned to the parallel data resource.
--
-- 'parallelDataConfig', 'parallelDataProperties_parallelDataConfig' - Specifies the format and S3 location of the parallel data input file.
--
-- 'skippedRecordCount', 'parallelDataProperties_skippedRecordCount' - The number of items in the input file that Amazon Translate skipped when
-- you created or updated the parallel data resource. For example, Amazon
-- Translate skips empty records, empty target texts, and empty lines.
--
-- 'sourceLanguageCode', 'parallelDataProperties_sourceLanguageCode' - The source language of the translations in the parallel data file.
--
-- 'status', 'parallelDataProperties_status' - The status of the parallel data resource. When the parallel data is
-- ready for you to use, the status is @ACTIVE@.
--
-- 'targetLanguageCodes', 'parallelDataProperties_targetLanguageCodes' - The language codes for the target languages available in the parallel
-- data file. All possible target languages are returned as an array.
newParallelDataProperties ::
  ParallelDataProperties
newParallelDataProperties :: ParallelDataProperties
newParallelDataProperties =
  ParallelDataProperties'
    { $sel:arn:ParallelDataProperties' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:ParallelDataProperties' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ParallelDataProperties' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionKey:ParallelDataProperties' :: Maybe EncryptionKey
encryptionKey = forall a. Maybe a
Prelude.Nothing,
      $sel:failedRecordCount:ParallelDataProperties' :: Maybe Integer
failedRecordCount = forall a. Maybe a
Prelude.Nothing,
      $sel:importedDataSize:ParallelDataProperties' :: Maybe Integer
importedDataSize = forall a. Maybe a
Prelude.Nothing,
      $sel:importedRecordCount:ParallelDataProperties' :: Maybe Integer
importedRecordCount = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:ParallelDataProperties' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:latestUpdateAttemptAt:ParallelDataProperties' :: Maybe POSIX
latestUpdateAttemptAt = forall a. Maybe a
Prelude.Nothing,
      $sel:latestUpdateAttemptStatus:ParallelDataProperties' :: Maybe ParallelDataStatus
latestUpdateAttemptStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:message:ParallelDataProperties' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:ParallelDataProperties' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:parallelDataConfig:ParallelDataProperties' :: Maybe ParallelDataConfig
parallelDataConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:skippedRecordCount:ParallelDataProperties' :: Maybe Integer
skippedRecordCount = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceLanguageCode:ParallelDataProperties' :: Maybe Text
sourceLanguageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ParallelDataProperties' :: Maybe ParallelDataStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:targetLanguageCodes:ParallelDataProperties' :: Maybe [Text]
targetLanguageCodes = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the parallel data resource.
parallelDataProperties_arn :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Text)
parallelDataProperties_arn :: Lens' ParallelDataProperties (Maybe Text)
parallelDataProperties_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Text
arn :: Maybe Text
$sel:arn:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
arn} -> Maybe Text
arn) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Text
a -> ParallelDataProperties
s {$sel:arn:ParallelDataProperties' :: Maybe Text
arn = Maybe Text
a} :: ParallelDataProperties)

-- | The time at which the parallel data resource was created.
parallelDataProperties_createdAt :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.UTCTime)
parallelDataProperties_createdAt :: Lens' ParallelDataProperties (Maybe UTCTime)
parallelDataProperties_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe POSIX
a -> ParallelDataProperties
s {$sel:createdAt:ParallelDataProperties' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: ParallelDataProperties) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The description assigned to the parallel data resource.
parallelDataProperties_description :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Text)
parallelDataProperties_description :: Lens' ParallelDataProperties (Maybe Text)
parallelDataProperties_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Text
description :: Maybe Text
$sel:description:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
description} -> Maybe Text
description) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Text
a -> ParallelDataProperties
s {$sel:description:ParallelDataProperties' :: Maybe Text
description = Maybe Text
a} :: ParallelDataProperties)

-- | Undocumented member.
parallelDataProperties_encryptionKey :: Lens.Lens' ParallelDataProperties (Prelude.Maybe EncryptionKey)
parallelDataProperties_encryptionKey :: Lens' ParallelDataProperties (Maybe EncryptionKey)
parallelDataProperties_encryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe EncryptionKey
encryptionKey :: Maybe EncryptionKey
$sel:encryptionKey:ParallelDataProperties' :: ParallelDataProperties -> Maybe EncryptionKey
encryptionKey} -> Maybe EncryptionKey
encryptionKey) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe EncryptionKey
a -> ParallelDataProperties
s {$sel:encryptionKey:ParallelDataProperties' :: Maybe EncryptionKey
encryptionKey = Maybe EncryptionKey
a} :: ParallelDataProperties)

-- | The number of records unsuccessfully imported from the parallel data
-- input file.
parallelDataProperties_failedRecordCount :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Integer)
parallelDataProperties_failedRecordCount :: Lens' ParallelDataProperties (Maybe Integer)
parallelDataProperties_failedRecordCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Integer
failedRecordCount :: Maybe Integer
$sel:failedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
failedRecordCount} -> Maybe Integer
failedRecordCount) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Integer
a -> ParallelDataProperties
s {$sel:failedRecordCount:ParallelDataProperties' :: Maybe Integer
failedRecordCount = Maybe Integer
a} :: ParallelDataProperties)

-- | The number of UTF-8 characters that Amazon Translate imported from the
-- parallel data input file. This number includes only the characters in
-- your translation examples. It does not include characters that are used
-- to format your file. For example, if you provided a Translation Memory
-- Exchange (.tmx) file, this number does not include the tags.
parallelDataProperties_importedDataSize :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Integer)
parallelDataProperties_importedDataSize :: Lens' ParallelDataProperties (Maybe Integer)
parallelDataProperties_importedDataSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Integer
importedDataSize :: Maybe Integer
$sel:importedDataSize:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
importedDataSize} -> Maybe Integer
importedDataSize) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Integer
a -> ParallelDataProperties
s {$sel:importedDataSize:ParallelDataProperties' :: Maybe Integer
importedDataSize = Maybe Integer
a} :: ParallelDataProperties)

-- | The number of records successfully imported from the parallel data input
-- file.
parallelDataProperties_importedRecordCount :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Integer)
parallelDataProperties_importedRecordCount :: Lens' ParallelDataProperties (Maybe Integer)
parallelDataProperties_importedRecordCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Integer
importedRecordCount :: Maybe Integer
$sel:importedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
importedRecordCount} -> Maybe Integer
importedRecordCount) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Integer
a -> ParallelDataProperties
s {$sel:importedRecordCount:ParallelDataProperties' :: Maybe Integer
importedRecordCount = Maybe Integer
a} :: ParallelDataProperties)

-- | The time at which the parallel data resource was last updated.
parallelDataProperties_lastUpdatedAt :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.UTCTime)
parallelDataProperties_lastUpdatedAt :: Lens' ParallelDataProperties (Maybe UTCTime)
parallelDataProperties_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe POSIX
a -> ParallelDataProperties
s {$sel:lastUpdatedAt:ParallelDataProperties' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: ParallelDataProperties) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time that the most recent update was attempted.
parallelDataProperties_latestUpdateAttemptAt :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.UTCTime)
parallelDataProperties_latestUpdateAttemptAt :: Lens' ParallelDataProperties (Maybe UTCTime)
parallelDataProperties_latestUpdateAttemptAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe POSIX
latestUpdateAttemptAt :: Maybe POSIX
$sel:latestUpdateAttemptAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
latestUpdateAttemptAt} -> Maybe POSIX
latestUpdateAttemptAt) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe POSIX
a -> ParallelDataProperties
s {$sel:latestUpdateAttemptAt:ParallelDataProperties' :: Maybe POSIX
latestUpdateAttemptAt = Maybe POSIX
a} :: ParallelDataProperties) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the most recent update attempt for the parallel data
-- resource.
parallelDataProperties_latestUpdateAttemptStatus :: Lens.Lens' ParallelDataProperties (Prelude.Maybe ParallelDataStatus)
parallelDataProperties_latestUpdateAttemptStatus :: Lens' ParallelDataProperties (Maybe ParallelDataStatus)
parallelDataProperties_latestUpdateAttemptStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe ParallelDataStatus
latestUpdateAttemptStatus :: Maybe ParallelDataStatus
$sel:latestUpdateAttemptStatus:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataStatus
latestUpdateAttemptStatus} -> Maybe ParallelDataStatus
latestUpdateAttemptStatus) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe ParallelDataStatus
a -> ParallelDataProperties
s {$sel:latestUpdateAttemptStatus:ParallelDataProperties' :: Maybe ParallelDataStatus
latestUpdateAttemptStatus = Maybe ParallelDataStatus
a} :: ParallelDataProperties)

-- | Additional information from Amazon Translate about the parallel data
-- resource.
parallelDataProperties_message :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Text)
parallelDataProperties_message :: Lens' ParallelDataProperties (Maybe Text)
parallelDataProperties_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Text
message :: Maybe Text
$sel:message:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
message} -> Maybe Text
message) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Text
a -> ParallelDataProperties
s {$sel:message:ParallelDataProperties' :: Maybe Text
message = Maybe Text
a} :: ParallelDataProperties)

-- | The custom name assigned to the parallel data resource.
parallelDataProperties_name :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Text)
parallelDataProperties_name :: Lens' ParallelDataProperties (Maybe Text)
parallelDataProperties_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Text
name :: Maybe Text
$sel:name:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
name} -> Maybe Text
name) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Text
a -> ParallelDataProperties
s {$sel:name:ParallelDataProperties' :: Maybe Text
name = Maybe Text
a} :: ParallelDataProperties)

-- | Specifies the format and S3 location of the parallel data input file.
parallelDataProperties_parallelDataConfig :: Lens.Lens' ParallelDataProperties (Prelude.Maybe ParallelDataConfig)
parallelDataProperties_parallelDataConfig :: Lens' ParallelDataProperties (Maybe ParallelDataConfig)
parallelDataProperties_parallelDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe ParallelDataConfig
parallelDataConfig :: Maybe ParallelDataConfig
$sel:parallelDataConfig:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataConfig
parallelDataConfig} -> Maybe ParallelDataConfig
parallelDataConfig) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe ParallelDataConfig
a -> ParallelDataProperties
s {$sel:parallelDataConfig:ParallelDataProperties' :: Maybe ParallelDataConfig
parallelDataConfig = Maybe ParallelDataConfig
a} :: ParallelDataProperties)

-- | The number of items in the input file that Amazon Translate skipped when
-- you created or updated the parallel data resource. For example, Amazon
-- Translate skips empty records, empty target texts, and empty lines.
parallelDataProperties_skippedRecordCount :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Integer)
parallelDataProperties_skippedRecordCount :: Lens' ParallelDataProperties (Maybe Integer)
parallelDataProperties_skippedRecordCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Integer
skippedRecordCount :: Maybe Integer
$sel:skippedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
skippedRecordCount} -> Maybe Integer
skippedRecordCount) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Integer
a -> ParallelDataProperties
s {$sel:skippedRecordCount:ParallelDataProperties' :: Maybe Integer
skippedRecordCount = Maybe Integer
a} :: ParallelDataProperties)

-- | The source language of the translations in the parallel data file.
parallelDataProperties_sourceLanguageCode :: Lens.Lens' ParallelDataProperties (Prelude.Maybe Prelude.Text)
parallelDataProperties_sourceLanguageCode :: Lens' ParallelDataProperties (Maybe Text)
parallelDataProperties_sourceLanguageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe Text
sourceLanguageCode :: Maybe Text
$sel:sourceLanguageCode:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
sourceLanguageCode} -> Maybe Text
sourceLanguageCode) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe Text
a -> ParallelDataProperties
s {$sel:sourceLanguageCode:ParallelDataProperties' :: Maybe Text
sourceLanguageCode = Maybe Text
a} :: ParallelDataProperties)

-- | The status of the parallel data resource. When the parallel data is
-- ready for you to use, the status is @ACTIVE@.
parallelDataProperties_status :: Lens.Lens' ParallelDataProperties (Prelude.Maybe ParallelDataStatus)
parallelDataProperties_status :: Lens' ParallelDataProperties (Maybe ParallelDataStatus)
parallelDataProperties_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe ParallelDataStatus
status :: Maybe ParallelDataStatus
$sel:status:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataStatus
status} -> Maybe ParallelDataStatus
status) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe ParallelDataStatus
a -> ParallelDataProperties
s {$sel:status:ParallelDataProperties' :: Maybe ParallelDataStatus
status = Maybe ParallelDataStatus
a} :: ParallelDataProperties)

-- | The language codes for the target languages available in the parallel
-- data file. All possible target languages are returned as an array.
parallelDataProperties_targetLanguageCodes :: Lens.Lens' ParallelDataProperties (Prelude.Maybe [Prelude.Text])
parallelDataProperties_targetLanguageCodes :: Lens' ParallelDataProperties (Maybe [Text])
parallelDataProperties_targetLanguageCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ParallelDataProperties' {Maybe [Text]
targetLanguageCodes :: Maybe [Text]
$sel:targetLanguageCodes:ParallelDataProperties' :: ParallelDataProperties -> Maybe [Text]
targetLanguageCodes} -> Maybe [Text]
targetLanguageCodes) (\s :: ParallelDataProperties
s@ParallelDataProperties' {} Maybe [Text]
a -> ParallelDataProperties
s {$sel:targetLanguageCodes:ParallelDataProperties' :: Maybe [Text]
targetLanguageCodes = Maybe [Text]
a} :: ParallelDataProperties) 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

instance Data.FromJSON ParallelDataProperties where
  parseJSON :: Value -> Parser ParallelDataProperties
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ParallelDataProperties"
      ( \Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe EncryptionKey
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe POSIX
-> Maybe POSIX
-> Maybe ParallelDataStatus
-> Maybe Text
-> Maybe Text
-> Maybe ParallelDataConfig
-> Maybe Integer
-> Maybe Text
-> Maybe ParallelDataStatus
-> Maybe [Text]
-> ParallelDataProperties
ParallelDataProperties'
            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
"Arn")
            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
"CreatedAt")
            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
"Description")
            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
"EncryptionKey")
            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
"FailedRecordCount")
            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
"ImportedDataSize")
            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
"ImportedRecordCount")
            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
"LastUpdatedAt")
            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
"LatestUpdateAttemptAt")
            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
"LatestUpdateAttemptStatus")
            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
"Message")
            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
"Name")
            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
"ParallelDataConfig")
            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
"SkippedRecordCount")
            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
"SourceLanguageCode")
            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
"Status")
            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
"TargetLanguageCodes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ParallelDataProperties where
  hashWithSalt :: Int -> ParallelDataProperties -> Int
hashWithSalt Int
_salt ParallelDataProperties' {Maybe Integer
Maybe [Text]
Maybe Text
Maybe POSIX
Maybe EncryptionKey
Maybe ParallelDataConfig
Maybe ParallelDataStatus
targetLanguageCodes :: Maybe [Text]
status :: Maybe ParallelDataStatus
sourceLanguageCode :: Maybe Text
skippedRecordCount :: Maybe Integer
parallelDataConfig :: Maybe ParallelDataConfig
name :: Maybe Text
message :: Maybe Text
latestUpdateAttemptStatus :: Maybe ParallelDataStatus
latestUpdateAttemptAt :: Maybe POSIX
lastUpdatedAt :: Maybe POSIX
importedRecordCount :: Maybe Integer
importedDataSize :: Maybe Integer
failedRecordCount :: Maybe Integer
encryptionKey :: Maybe EncryptionKey
description :: Maybe Text
createdAt :: Maybe POSIX
arn :: Maybe Text
$sel:targetLanguageCodes:ParallelDataProperties' :: ParallelDataProperties -> Maybe [Text]
$sel:status:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataStatus
$sel:sourceLanguageCode:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:skippedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:parallelDataConfig:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataConfig
$sel:name:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:message:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:latestUpdateAttemptStatus:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataStatus
$sel:latestUpdateAttemptAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
$sel:lastUpdatedAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
$sel:importedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:importedDataSize:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:failedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:encryptionKey:ParallelDataProperties' :: ParallelDataProperties -> Maybe EncryptionKey
$sel:description:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:createdAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
$sel:arn:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionKey
encryptionKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
failedRecordCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
importedDataSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
importedRecordCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdatedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
latestUpdateAttemptAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ParallelDataStatus
latestUpdateAttemptStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
message
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ParallelDataConfig
parallelDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
skippedRecordCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceLanguageCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ParallelDataStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
targetLanguageCodes

instance Prelude.NFData ParallelDataProperties where
  rnf :: ParallelDataProperties -> ()
rnf ParallelDataProperties' {Maybe Integer
Maybe [Text]
Maybe Text
Maybe POSIX
Maybe EncryptionKey
Maybe ParallelDataConfig
Maybe ParallelDataStatus
targetLanguageCodes :: Maybe [Text]
status :: Maybe ParallelDataStatus
sourceLanguageCode :: Maybe Text
skippedRecordCount :: Maybe Integer
parallelDataConfig :: Maybe ParallelDataConfig
name :: Maybe Text
message :: Maybe Text
latestUpdateAttemptStatus :: Maybe ParallelDataStatus
latestUpdateAttemptAt :: Maybe POSIX
lastUpdatedAt :: Maybe POSIX
importedRecordCount :: Maybe Integer
importedDataSize :: Maybe Integer
failedRecordCount :: Maybe Integer
encryptionKey :: Maybe EncryptionKey
description :: Maybe Text
createdAt :: Maybe POSIX
arn :: Maybe Text
$sel:targetLanguageCodes:ParallelDataProperties' :: ParallelDataProperties -> Maybe [Text]
$sel:status:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataStatus
$sel:sourceLanguageCode:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:skippedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:parallelDataConfig:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataConfig
$sel:name:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:message:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:latestUpdateAttemptStatus:ParallelDataProperties' :: ParallelDataProperties -> Maybe ParallelDataStatus
$sel:latestUpdateAttemptAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
$sel:lastUpdatedAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
$sel:importedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:importedDataSize:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:failedRecordCount:ParallelDataProperties' :: ParallelDataProperties -> Maybe Integer
$sel:encryptionKey:ParallelDataProperties' :: ParallelDataProperties -> Maybe EncryptionKey
$sel:description:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
$sel:createdAt:ParallelDataProperties' :: ParallelDataProperties -> Maybe POSIX
$sel:arn:ParallelDataProperties' :: ParallelDataProperties -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionKey
encryptionKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
failedRecordCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
importedDataSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
importedRecordCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
latestUpdateAttemptAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ParallelDataStatus
latestUpdateAttemptStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ParallelDataConfig
parallelDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
skippedRecordCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceLanguageCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ParallelDataStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
targetLanguageCodes