{-# 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.DataBrew.Types.Output
-- 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.DataBrew.Types.Output where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataBrew.Types.CompressionFormat
import Amazonka.DataBrew.Types.OutputFormat
import Amazonka.DataBrew.Types.OutputFormatOptions
import Amazonka.DataBrew.Types.S3Location
import qualified Amazonka.Prelude as Prelude

-- | Represents options that specify how and where in Amazon S3 DataBrew
-- writes the output generated by recipe jobs or profile jobs.
--
-- /See:/ 'newOutput' smart constructor.
data Output = Output'
  { -- | The compression algorithm used to compress the output text of the job.
    Output -> Maybe CompressionFormat
compressionFormat :: Prelude.Maybe CompressionFormat,
    -- | The data format of the output of the job.
    Output -> Maybe OutputFormat
format :: Prelude.Maybe OutputFormat,
    -- | Represents options that define how DataBrew formats job output files.
    Output -> Maybe OutputFormatOptions
formatOptions :: Prelude.Maybe OutputFormatOptions,
    -- | Maximum number of files to be generated by the job and written to the
    -- output folder. For output partitioned by column(s), the MaxOutputFiles
    -- value is the maximum number of files per partition.
    Output -> Maybe Natural
maxOutputFiles :: Prelude.Maybe Prelude.Natural,
    -- | A value that, if true, means that any data in the location specified for
    -- output is overwritten with new output.
    Output -> Maybe Bool
overwrite :: Prelude.Maybe Prelude.Bool,
    -- | The names of one or more partition columns for the output of the job.
    Output -> Maybe [Text]
partitionColumns :: Prelude.Maybe [Prelude.Text],
    -- | The location in Amazon S3 where the job writes its output.
    Output -> S3Location
location :: S3Location
  }
  deriving (Output -> Output -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c== :: Output -> Output -> Bool
Prelude.Eq, ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Output]
$creadListPrec :: ReadPrec [Output]
readPrec :: ReadPrec Output
$creadPrec :: ReadPrec Output
readList :: ReadS [Output]
$creadList :: ReadS [Output]
readsPrec :: Int -> ReadS Output
$creadsPrec :: Int -> ReadS Output
Prelude.Read, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Prelude.Show, forall x. Rep Output x -> Output
forall x. Output -> Rep Output x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Output x -> Output
$cfrom :: forall x. Output -> Rep Output x
Prelude.Generic)

-- |
-- Create a value of 'Output' 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:
--
-- 'compressionFormat', 'output_compressionFormat' - The compression algorithm used to compress the output text of the job.
--
-- 'format', 'output_format' - The data format of the output of the job.
--
-- 'formatOptions', 'output_formatOptions' - Represents options that define how DataBrew formats job output files.
--
-- 'maxOutputFiles', 'output_maxOutputFiles' - Maximum number of files to be generated by the job and written to the
-- output folder. For output partitioned by column(s), the MaxOutputFiles
-- value is the maximum number of files per partition.
--
-- 'overwrite', 'output_overwrite' - A value that, if true, means that any data in the location specified for
-- output is overwritten with new output.
--
-- 'partitionColumns', 'output_partitionColumns' - The names of one or more partition columns for the output of the job.
--
-- 'location', 'output_location' - The location in Amazon S3 where the job writes its output.
newOutput ::
  -- | 'location'
  S3Location ->
  Output
newOutput :: S3Location -> Output
newOutput S3Location
pLocation_ =
  Output'
    { $sel:compressionFormat:Output' :: Maybe CompressionFormat
compressionFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:format:Output' :: Maybe OutputFormat
format = forall a. Maybe a
Prelude.Nothing,
      $sel:formatOptions:Output' :: Maybe OutputFormatOptions
formatOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:maxOutputFiles:Output' :: Maybe Natural
maxOutputFiles = forall a. Maybe a
Prelude.Nothing,
      $sel:overwrite:Output' :: Maybe Bool
overwrite = forall a. Maybe a
Prelude.Nothing,
      $sel:partitionColumns:Output' :: Maybe [Text]
partitionColumns = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Output' :: S3Location
location = S3Location
pLocation_
    }

-- | The compression algorithm used to compress the output text of the job.
output_compressionFormat :: Lens.Lens' Output (Prelude.Maybe CompressionFormat)
output_compressionFormat :: Lens' Output (Maybe CompressionFormat)
output_compressionFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe CompressionFormat
compressionFormat :: Maybe CompressionFormat
$sel:compressionFormat:Output' :: Output -> Maybe CompressionFormat
compressionFormat} -> Maybe CompressionFormat
compressionFormat) (\s :: Output
s@Output' {} Maybe CompressionFormat
a -> Output
s {$sel:compressionFormat:Output' :: Maybe CompressionFormat
compressionFormat = Maybe CompressionFormat
a} :: Output)

-- | The data format of the output of the job.
output_format :: Lens.Lens' Output (Prelude.Maybe OutputFormat)
output_format :: Lens' Output (Maybe OutputFormat)
output_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe OutputFormat
format :: Maybe OutputFormat
$sel:format:Output' :: Output -> Maybe OutputFormat
format} -> Maybe OutputFormat
format) (\s :: Output
s@Output' {} Maybe OutputFormat
a -> Output
s {$sel:format:Output' :: Maybe OutputFormat
format = Maybe OutputFormat
a} :: Output)

-- | Represents options that define how DataBrew formats job output files.
output_formatOptions :: Lens.Lens' Output (Prelude.Maybe OutputFormatOptions)
output_formatOptions :: Lens' Output (Maybe OutputFormatOptions)
output_formatOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe OutputFormatOptions
formatOptions :: Maybe OutputFormatOptions
$sel:formatOptions:Output' :: Output -> Maybe OutputFormatOptions
formatOptions} -> Maybe OutputFormatOptions
formatOptions) (\s :: Output
s@Output' {} Maybe OutputFormatOptions
a -> Output
s {$sel:formatOptions:Output' :: Maybe OutputFormatOptions
formatOptions = Maybe OutputFormatOptions
a} :: Output)

-- | Maximum number of files to be generated by the job and written to the
-- output folder. For output partitioned by column(s), the MaxOutputFiles
-- value is the maximum number of files per partition.
output_maxOutputFiles :: Lens.Lens' Output (Prelude.Maybe Prelude.Natural)
output_maxOutputFiles :: Lens' Output (Maybe Natural)
output_maxOutputFiles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe Natural
maxOutputFiles :: Maybe Natural
$sel:maxOutputFiles:Output' :: Output -> Maybe Natural
maxOutputFiles} -> Maybe Natural
maxOutputFiles) (\s :: Output
s@Output' {} Maybe Natural
a -> Output
s {$sel:maxOutputFiles:Output' :: Maybe Natural
maxOutputFiles = Maybe Natural
a} :: Output)

-- | A value that, if true, means that any data in the location specified for
-- output is overwritten with new output.
output_overwrite :: Lens.Lens' Output (Prelude.Maybe Prelude.Bool)
output_overwrite :: Lens' Output (Maybe Bool)
output_overwrite = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe Bool
overwrite :: Maybe Bool
$sel:overwrite:Output' :: Output -> Maybe Bool
overwrite} -> Maybe Bool
overwrite) (\s :: Output
s@Output' {} Maybe Bool
a -> Output
s {$sel:overwrite:Output' :: Maybe Bool
overwrite = Maybe Bool
a} :: Output)

-- | The names of one or more partition columns for the output of the job.
output_partitionColumns :: Lens.Lens' Output (Prelude.Maybe [Prelude.Text])
output_partitionColumns :: Lens' Output (Maybe [Text])
output_partitionColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe [Text]
partitionColumns :: Maybe [Text]
$sel:partitionColumns:Output' :: Output -> Maybe [Text]
partitionColumns} -> Maybe [Text]
partitionColumns) (\s :: Output
s@Output' {} Maybe [Text]
a -> Output
s {$sel:partitionColumns:Output' :: Maybe [Text]
partitionColumns = Maybe [Text]
a} :: Output) 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 location in Amazon S3 where the job writes its output.
output_location :: Lens.Lens' Output S3Location
output_location :: Lens' Output S3Location
output_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {S3Location
location :: S3Location
$sel:location:Output' :: Output -> S3Location
location} -> S3Location
location) (\s :: Output
s@Output' {} S3Location
a -> Output
s {$sel:location:Output' :: S3Location
location = S3Location
a} :: Output)

instance Data.FromJSON Output where
  parseJSON :: Value -> Parser Output
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Output"
      ( \Object
x ->
          Maybe CompressionFormat
-> Maybe OutputFormat
-> Maybe OutputFormatOptions
-> Maybe Natural
-> Maybe Bool
-> Maybe [Text]
-> S3Location
-> Output
Output'
            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
"CompressionFormat")
            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
"Format")
            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
"FormatOptions")
            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
"MaxOutputFiles")
            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
"Overwrite")
            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
"PartitionColumns"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Location")
      )

instance Prelude.Hashable Output where
  hashWithSalt :: Int -> Output -> Int
hashWithSalt Int
_salt Output' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe CompressionFormat
Maybe OutputFormat
Maybe OutputFormatOptions
S3Location
location :: S3Location
partitionColumns :: Maybe [Text]
overwrite :: Maybe Bool
maxOutputFiles :: Maybe Natural
formatOptions :: Maybe OutputFormatOptions
format :: Maybe OutputFormat
compressionFormat :: Maybe CompressionFormat
$sel:location:Output' :: Output -> S3Location
$sel:partitionColumns:Output' :: Output -> Maybe [Text]
$sel:overwrite:Output' :: Output -> Maybe Bool
$sel:maxOutputFiles:Output' :: Output -> Maybe Natural
$sel:formatOptions:Output' :: Output -> Maybe OutputFormatOptions
$sel:format:Output' :: Output -> Maybe OutputFormat
$sel:compressionFormat:Output' :: Output -> Maybe CompressionFormat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CompressionFormat
compressionFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputFormat
format
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputFormatOptions
formatOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxOutputFiles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
overwrite
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
partitionColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Location
location

instance Prelude.NFData Output where
  rnf :: Output -> ()
rnf Output' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe CompressionFormat
Maybe OutputFormat
Maybe OutputFormatOptions
S3Location
location :: S3Location
partitionColumns :: Maybe [Text]
overwrite :: Maybe Bool
maxOutputFiles :: Maybe Natural
formatOptions :: Maybe OutputFormatOptions
format :: Maybe OutputFormat
compressionFormat :: Maybe CompressionFormat
$sel:location:Output' :: Output -> S3Location
$sel:partitionColumns:Output' :: Output -> Maybe [Text]
$sel:overwrite:Output' :: Output -> Maybe Bool
$sel:maxOutputFiles:Output' :: Output -> Maybe Natural
$sel:formatOptions:Output' :: Output -> Maybe OutputFormatOptions
$sel:format:Output' :: Output -> Maybe OutputFormat
$sel:compressionFormat:Output' :: Output -> Maybe CompressionFormat
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CompressionFormat
compressionFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputFormat
format
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputFormatOptions
formatOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxOutputFiles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
overwrite
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
partitionColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Location
location

instance Data.ToJSON Output where
  toJSON :: Output -> Value
toJSON Output' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe CompressionFormat
Maybe OutputFormat
Maybe OutputFormatOptions
S3Location
location :: S3Location
partitionColumns :: Maybe [Text]
overwrite :: Maybe Bool
maxOutputFiles :: Maybe Natural
formatOptions :: Maybe OutputFormatOptions
format :: Maybe OutputFormat
compressionFormat :: Maybe CompressionFormat
$sel:location:Output' :: Output -> S3Location
$sel:partitionColumns:Output' :: Output -> Maybe [Text]
$sel:overwrite:Output' :: Output -> Maybe Bool
$sel:maxOutputFiles:Output' :: Output -> Maybe Natural
$sel:formatOptions:Output' :: Output -> Maybe OutputFormatOptions
$sel:format:Output' :: Output -> Maybe OutputFormat
$sel:compressionFormat:Output' :: Output -> Maybe CompressionFormat
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CompressionFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CompressionFormat
compressionFormat,
            (Key
"Format" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OutputFormat
format,
            (Key
"FormatOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OutputFormatOptions
formatOptions,
            (Key
"MaxOutputFiles" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxOutputFiles,
            (Key
"Overwrite" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
overwrite,
            (Key
"PartitionColumns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
partitionColumns,
            forall a. a -> Maybe a
Prelude.Just (Key
"Location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Location
location)
          ]
      )